1
0

Add stream visualize example

This commit is contained in:
Timothy Warren 2021-11-11 15:15:54 -05:00
parent ac33c8c399
commit 1afcf37978
6 changed files with 576 additions and 0 deletions

View File

@ -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.

View File

@ -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

View File

@ -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

View File

@ -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>

View File

@ -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.