Add stream visualize example
This commit is contained in:
Timothy Warren
parent
ac33c8c399
commit
1afcf37978
|
|
@ -0,0 +1,71 @@
|
|||
unit demo_stream;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils;
|
||||
|
||||
type
|
||||
Ts20 = string[20];
|
||||
|
||||
TdemoRec = record
|
||||
aChar: Char;
|
||||
anInt: integer;
|
||||
aString: Ts20;
|
||||
aDate: TDateTime;
|
||||
end;
|
||||
|
||||
{ TdemoStream }
|
||||
|
||||
TdemoStream = class(TMemoryStream)
|
||||
private
|
||||
function GenerateRandomRec(num: integer): TdemoRec;
|
||||
public
|
||||
rec: TdemoRec;
|
||||
constructor Create(numRecords: integer);
|
||||
function RecAsString: string;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses math;
|
||||
|
||||
{ TdemoStream }
|
||||
|
||||
function TdemoStream.GenerateRandomRec(num: integer): TdemoRec;
|
||||
begin
|
||||
Result.aChar := Chr(65 + Random(26));
|
||||
Result.aDate := TDateTime(RandomRange(100, trunc(Now)) + Random/10000);
|
||||
Result.anInt := num;
|
||||
Result.aString := Format('example string %d', [num]);
|
||||
end;
|
||||
|
||||
constructor TdemoStream.Create(numRecords: integer);
|
||||
var i: integer;
|
||||
begin
|
||||
// Initialize random number generator
|
||||
Randomize;
|
||||
|
||||
// Call the inherited constructor
|
||||
inherited Create;
|
||||
|
||||
|
||||
Position := 0;
|
||||
|
||||
for i := 0 to numRecords-1 do
|
||||
Write(GenerateRandomRec(i), SizeOf(TdemoRec));
|
||||
end;
|
||||
|
||||
function TdemoStream.RecAsString: string;
|
||||
begin
|
||||
Read(rec, SizeOf(rec));
|
||||
Result := Format(
|
||||
'%5d %s %17s %s',
|
||||
[rec.anInt, rec.aChar, rec.aString, FormatDateTime('dd-mm-yyyy:mm:ss', rec.aDate)]
|
||||
);
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
|
|
@ -0,0 +1,198 @@
|
|||
object Form1: TForm1
|
||||
Left = 533
|
||||
Height = 670
|
||||
Top = 272
|
||||
Width = 700
|
||||
Caption = 'Visualizing a stream of records '
|
||||
ClientHeight = 670
|
||||
ClientWidth = 700
|
||||
OnDestroy = FormDestroy
|
||||
LCLVersion = '2.0.12.0'
|
||||
object tbPosition: TTrackBar
|
||||
Left = 0
|
||||
Height = 25
|
||||
Top = 0
|
||||
Width = 700
|
||||
Position = 0
|
||||
TabStop = False
|
||||
Align = alTop
|
||||
TabOrder = 0
|
||||
end
|
||||
object lblOrigin: TLabel
|
||||
AnchorSideTop.Control = tbPosition
|
||||
AnchorSideTop.Side = asrBottom
|
||||
Left = 31
|
||||
Height = 16
|
||||
Top = 25
|
||||
Width = 8
|
||||
Caption = '0'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblPositionDesc: TLabel
|
||||
Left = 80
|
||||
Height = 16
|
||||
Top = 24
|
||||
Width = 525
|
||||
Caption = '< the trackbar pointer above illustrates the stream''s Position between origin and Size >'
|
||||
ParentColor = False
|
||||
end
|
||||
object lblStreamSize: TLabel
|
||||
AnchorSideTop.Control = tbPosition
|
||||
AnchorSideTop.Side = asrBottom
|
||||
AnchorSideBottom.Control = tbPosition
|
||||
Left = 667
|
||||
Height = 1
|
||||
Top = 25
|
||||
Width = 1
|
||||
Alignment = taRightJustify
|
||||
Anchors = [akTop]
|
||||
ParentColor = False
|
||||
end
|
||||
object edtRecord: TEdit
|
||||
Left = 0
|
||||
Height = 22
|
||||
Top = 56
|
||||
Width = 700
|
||||
Alignment = taCenter
|
||||
AutoSize = False
|
||||
TabOrder = 1
|
||||
end
|
||||
object memoDisplay: TMemo
|
||||
Left = 14
|
||||
Height = 300
|
||||
Top = 101
|
||||
Width = 450
|
||||
Font.CharSet = ANSI_CHARSET
|
||||
Font.Height = -13
|
||||
Font.Name = 'Courier'
|
||||
HideSelection = False
|
||||
Lines.Strings = ( )
|
||||
ParentFont = False
|
||||
ScrollBars = ssAutoBoth
|
||||
TabOrder = 2
|
||||
end
|
||||
object lblAdjustPosition: TLabel
|
||||
Left = 480
|
||||
Height = 16
|
||||
Top = 101
|
||||
Width = 161
|
||||
Caption = 'Show previous/next record'
|
||||
ParentColor = False
|
||||
end
|
||||
object udMover: TUpDown
|
||||
Left = 656
|
||||
Height = 31
|
||||
Top = 96
|
||||
Width = 34
|
||||
Min = 0
|
||||
OnClick = udMoverClick
|
||||
Orientation = udHorizontal
|
||||
Position = 0
|
||||
TabOrder = 3
|
||||
end
|
||||
object lblRecordNo: TLabel
|
||||
Left = 504
|
||||
Height = 16
|
||||
Top = 133
|
||||
Width = 126
|
||||
Caption = 'View record number:'
|
||||
ParentColor = False
|
||||
end
|
||||
object seCurrentRecNo: TSpinEdit
|
||||
Left = 640
|
||||
Height = 21
|
||||
Top = 128
|
||||
Width = 50
|
||||
OnChange = seCurrentRecNoChange
|
||||
TabOrder = 4
|
||||
Value = 30
|
||||
end
|
||||
object lblNumRecords: TLabel
|
||||
Left = 472
|
||||
Height = 16
|
||||
Top = 208
|
||||
Width = 163
|
||||
Caption = 'No. of records to generate:'
|
||||
ParentColor = False
|
||||
end
|
||||
object seNoOfRecords: TSpinEdit
|
||||
Left = 640
|
||||
Height = 21
|
||||
Top = 203
|
||||
Width = 50
|
||||
MaxValue = 10000
|
||||
MinValue = 1
|
||||
TabOrder = 5
|
||||
Value = 40
|
||||
end
|
||||
object btnGenerateStream: TButton
|
||||
Left = 532
|
||||
Height = 25
|
||||
Top = 232
|
||||
Width = 158
|
||||
Caption = 'Generate new Stream.'
|
||||
OnClick = btnGenerateStreamClick
|
||||
TabOrder = 6
|
||||
end
|
||||
object btnSaveStream: TButton
|
||||
Left = 472
|
||||
Height = 25
|
||||
Top = 312
|
||||
Width = 218
|
||||
Caption = 'Save stream to file, then discard'
|
||||
Enabled = False
|
||||
OnClick = btnSaveStreamClick
|
||||
TabOrder = 7
|
||||
end
|
||||
object btnLoadStream: TButton
|
||||
Left = 532
|
||||
Height = 25
|
||||
Top = 344
|
||||
Width = 158
|
||||
Caption = 'Load stream from file'
|
||||
Enabled = False
|
||||
OnClick = btnLoadStreamClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object lblSavedFileSize: TLabel
|
||||
Left = 488
|
||||
Height = 1
|
||||
Top = 388
|
||||
Width = 1
|
||||
ParentColor = False
|
||||
end
|
||||
object memoEncrypted: TMemo
|
||||
Left = 14
|
||||
Height = 218
|
||||
Top = 440
|
||||
Width = 338
|
||||
Lines.Strings = ( )
|
||||
TabOrder = 9
|
||||
end
|
||||
object memoDecrypted: TMemo
|
||||
Left = 360
|
||||
Height = 218
|
||||
Top = 440
|
||||
Width = 326
|
||||
Lines.Strings = ( )
|
||||
TabOrder = 10
|
||||
end
|
||||
object btnEncrypt: TButton
|
||||
Left = 136
|
||||
Height = 25
|
||||
Top = 408
|
||||
Width = 75
|
||||
Caption = 'Encrypt'
|
||||
OnClick = btnEncryptClick
|
||||
TabOrder = 11
|
||||
end
|
||||
object btnDecrypt: TButton
|
||||
Left = 480
|
||||
Height = 25
|
||||
Top = 408
|
||||
Width = 75
|
||||
Caption = 'Decrypt'
|
||||
OnClick = btnDecryptClick
|
||||
TabOrder = 12
|
||||
end
|
||||
end
|
||||
|
|
@ -0,0 +1,202 @@
|
|||
unit main_stream;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls, StdCtrls,
|
||||
Spin, Blowfish, demo_stream;
|
||||
|
||||
const savedFileName: TFileName = 'stream.dat';
|
||||
|
||||
type
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
TForm1 = class(TForm)
|
||||
btnDecrypt: TButton;
|
||||
btnEncrypt: TButton;
|
||||
btnGenerateStream: TButton;
|
||||
btnLoadStream: TButton;
|
||||
btnSaveStream: TButton;
|
||||
edtRecord: TEdit;
|
||||
lblAdjustPosition: TLabel;
|
||||
lblNumRecords: TLabel;
|
||||
lblPositionDesc: TLabel;
|
||||
lblOrigin: TLabel;
|
||||
lblRecordNo: TLabel;
|
||||
lblSavedFileSize: TLabel;
|
||||
lblStreamSize: TLabel;
|
||||
memoDecrypted: TMemo;
|
||||
memoDisplay: TMemo;
|
||||
memoEncrypted: TMemo;
|
||||
seCurrentRecNo: TSpinEdit;
|
||||
seNoOfRecords: TSpinEdit;
|
||||
tbPosition: TTrackBar;
|
||||
udMover: TUpDown;
|
||||
procedure btnDecryptClick(Sender: TObject);
|
||||
procedure btnEncryptClick(Sender: TObject);
|
||||
procedure btnGenerateStreamClick(Sender: TObject);
|
||||
procedure btnLoadStreamClick(Sender: TObject);
|
||||
procedure btnSaveStreamClick(Sender: TObject);
|
||||
procedure FormDestroy(Sender: TObject);
|
||||
procedure seCurrentRecNoChange(Sender: TObject);
|
||||
procedure udMoverClick(Sender: TObject; Button: TUDBtnType);
|
||||
private
|
||||
ds: TdemoStream;
|
||||
sOriginal, sEncrypted: TStringStream;
|
||||
key: string;
|
||||
public
|
||||
procedure DisplayStream;
|
||||
end;
|
||||
|
||||
var
|
||||
Form1: TForm1;
|
||||
|
||||
implementation
|
||||
|
||||
{$R *.lfm}
|
||||
|
||||
{ TForm1 }
|
||||
|
||||
procedure TForm1.udMoverClick(Sender: TObject; Button: TUDBtnType);
|
||||
begin
|
||||
if not Assigned(ds) then Exit;
|
||||
|
||||
case Button of
|
||||
btPrev: if (ds.Position >= SizeOf(ds.rec)) then
|
||||
begin
|
||||
ds.Seek(- 2*SizeOf(ds.rec), sofromCurrent);
|
||||
|
||||
if (ds.Position < 0) then ds.Position := 0;
|
||||
|
||||
edtRecord.Text := ds.RecAsString;
|
||||
seCurrentRecNo.Value := seCurrentRecNo.Value-1;
|
||||
end;
|
||||
|
||||
btNext: if (ds.Position < ds.Size) then
|
||||
begin
|
||||
edtRecord.Text := ds.RecAsString;
|
||||
seCurrentRecNo.Value := seCurrentRecNo.Value+1;
|
||||
end;
|
||||
end;
|
||||
|
||||
seCurrentRecNoChange(nil);
|
||||
end;
|
||||
|
||||
procedure TForm1.btnEncryptClick(Sender: TObject);
|
||||
var be: TBlowFishEncryptStream;
|
||||
begin
|
||||
if memoDisplay.Lines.Count = 0 then Exit;
|
||||
|
||||
key := 'example cipher key for Blowfish';
|
||||
sOriginal := TStringStream.Create(EmptyStr);
|
||||
be := TBlowFishEncryptStream.Create(key, sOriginal);
|
||||
be.WriteAnsiString(memoDisplay.Text);
|
||||
be.Free;
|
||||
memoEncrypted.Text := sOriginal.DataString;
|
||||
end;
|
||||
|
||||
procedure TForm1.btnGenerateStreamClick(Sender: TObject);
|
||||
begin
|
||||
ds.Free;
|
||||
ds := TdemoStream.Create(seNoOfRecords.Value);
|
||||
|
||||
seCurrentRecNo.MaxValue := seNoOfRecords.Value -1;
|
||||
|
||||
DisplayStream;
|
||||
seCurrentRecNoChange(nil);
|
||||
btnSaveStream.Enabled := True;
|
||||
lblSavedfileSize.Caption := EmptyStr;
|
||||
|
||||
memoEncrypted.Lines.Clear;
|
||||
memoDecrypted.Lines.Clear;
|
||||
end;
|
||||
|
||||
procedure TForm1.btnLoadStreamClick(Sender: TObject);
|
||||
begin
|
||||
FreeAndNil(ds);
|
||||
|
||||
ds := TdemoStream.Create(0);
|
||||
ds.LoadFromFile(savedFileName);
|
||||
seNoOfRecords.Value := ds.Size div SizeOf(ds.rec);
|
||||
seCurrentRecNo.MaxValue := seNoOfRecords.Value -1;
|
||||
|
||||
DisplayStream;
|
||||
btnLoadStream.Enabled := False;
|
||||
seCurrentRecNoChange(nil);
|
||||
|
||||
memoEncrypted.Lines.Clear;
|
||||
memoDecrypted.Lines.Clear;
|
||||
end;
|
||||
|
||||
procedure TForm1.btnSaveStreamClick(Sender: TObject);
|
||||
begin
|
||||
if Assigned(ds) then
|
||||
begin
|
||||
memoDisplay.Lines.Clear;
|
||||
edtRecord.Text := EmptyStr;
|
||||
|
||||
ds.SaveToFile(savedFileName);
|
||||
// lblSavedFileSize.Caption := Format('Saved file size is: %d bytes', [FileSize(savedFileName)]);
|
||||
|
||||
btnLoadStream.Enabled := True;
|
||||
btnSaveStream.Enabled := False;
|
||||
FreeAndNil(ds);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TForm1.FormDestroy(Sender: TObject);
|
||||
begin
|
||||
ds.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.seCurrentRecNoChange(Sender: TObject);
|
||||
var L: integer;
|
||||
begin
|
||||
if not Assigned(ds) then Exit;
|
||||
|
||||
ds.Seek(seCurrentRecNo.Value * SizeOf(ds.rec), soFromBeginning);
|
||||
edtRecord.Text := ds.RecAsString;
|
||||
L := Length(edtRecord.Text) + Length(LineEnding);
|
||||
tbPosition.Position := tbPosition.Max * ds.Position div ds.Size;
|
||||
|
||||
memoDisplay.SelStart := (tbPosition.Position) * L;
|
||||
memoDisplay.SelLength := L;
|
||||
end;
|
||||
|
||||
procedure TForm1.btnDecryptClick(Sender: TObject);
|
||||
var bd: TBlowFishDeCryptStream;
|
||||
begin
|
||||
sEncrypted := TStringStream.Create(sOriginal.DataString);
|
||||
bd := TBlowFishDeCryptStream.Create(key, sEncrypted);
|
||||
memoDecrypted.Text := bd.ReadAnsiString;
|
||||
bd.Free;
|
||||
sEncrypted.Free;
|
||||
sOriginal.Free;
|
||||
end;
|
||||
|
||||
procedure TForm1.DisplayStream;
|
||||
begin
|
||||
lblStreamSize.Caption := Format('%d ', [ds.Size]);
|
||||
tbPosition.Max := ds.Size div SizeOf(ds.rec) -1;
|
||||
|
||||
memoDisplay.Lines.BeginUpdate;
|
||||
memoDisplay.Clear;
|
||||
ds.Position := 0;
|
||||
while (ds.Position < ds.Size) do
|
||||
begin
|
||||
memoDisplay.Lines.Add(ds.RecAsString);
|
||||
tbPosition.Position := (ds.Size * tbPosition.Max) div ds.Position;
|
||||
end;
|
||||
memoDisplay.Lines.EndUpdate;
|
||||
|
||||
seCurrentRecNo.MaxValue := seNoOfRecords.Value;
|
||||
ds.Seek(seCurrentRecNo.Value * SizeOf(ds.rec), soFromBeginning);
|
||||
edtRecord.Text := ds.RecAsString;
|
||||
tbPosition.Position := (ds.Size * tbPosition.Max) div ds.Position;
|
||||
end;
|
||||
|
||||
end.
|
||||
|
||||
Binary file not shown.
|
After Width: | Height: | Size: 134 KiB |
|
|
@ -0,0 +1,83 @@
|
|||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="stream_visualize"/>
|
||||
<Scaled Value="True"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<XPManifest>
|
||||
<DpiAware Value="True"/>
|
||||
</XPManifest>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
<UseFileFilters Value="True"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<RequiredPackages Count="1">
|
||||
<Item1>
|
||||
<PackageName Value="LCL"/>
|
||||
</Item1>
|
||||
</RequiredPackages>
|
||||
<Units Count="3">
|
||||
<Unit0>
|
||||
<Filename Value="stream_visualize.lpr"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="main_stream.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
<ComponentName Value="Form1"/>
|
||||
<ResourceBaseClass Value="Form"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="demo_stream.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="stream_visualize"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<DebugInfoType Value="dsDwarf2Set"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
program stream_visualize;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||
cthreads,
|
||||
{$ENDIF}{$ENDIF}
|
||||
Interfaces, // this includes the LCL widgetset
|
||||
Forms, main_stream, demo_stream
|
||||
{ you can add units after this };
|
||||
|
||||
{$R *.res}
|
||||
|
||||
begin
|
||||
RequireDerivedFormResource:=True;
|
||||
Application.Scaled:=True;
|
||||
Application.Initialize;
|
||||
Application.CreateForm(TForm1, Form1);
|
||||
Application.Run;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue