1
0

Add Set Demo example

This commit is contained in:
Timothy Warren 2021-10-13 15:50:09 -04:00
parent c280226e4d
commit 39728691b3
6 changed files with 482 additions and 0 deletions

View File

@ -0,0 +1,95 @@
unit dualdigitsset;
{$mode objfpc}{$H+}
interface
uses
SysUtils;
type
TDigits = 0..9;
TDigitSet = set of TDigits;
{ TDualAZSet }
TDualAZSet = class
private
FsetA, FsetZ: TDigitSet;
function GetDiffAZAsText: string;
function GetDiffZAAsText: string;
function GetIntersectionAsText: string;
function GetSetAasText: string;
function GetSetZasText: string;
function GetSymDiffAsText: string;
function GetUnionAsText: string;
function SetAsString(s: TDigitSet): string;
public
property DiffAZAsText: string read GetDiffAZAsText;
property DiffZAAsText: string read GetDiffZAAsText;
property IntersectionAsText: string read GetIntersectionAsText;
property SetA: TDigitSet read FsetA write FsetA;
property SetAasText: string read GetSetAasText;
property SetZ: TDigitSet read FsetZ write FsetZ;
property SetZasText: string read GetSetZasText;
property SymDiffAsText: string read GetSymDiffAsText;
property UnionAsText: string read GetUnionAsText;
end;
implementation
{ TDualAZSet }
function TDualAZSet.GetDiffAZAsText: string;
begin
Result := SetAsString(FsetA - FsetZ);
end;
function TDualAZSet.GetDiffZAAsText: string;
begin
Result := SetAsString(FsetZ - FsetA);
end;
function TDualAZSet.GetIntersectionAsText: string;
begin
Result := SetAsString(FsetA * FsetZ);
end;
function TDualAZSet.GetSetAasText: string;
begin
Result := SetAsString(FsetA);
end;
function TDualAZSet.GetSetZasText: string;
begin
Result := SetAsString(FsetZ);
end;
function TDualAZSet.GetSymDiffAsText: string;
begin
Result := SetAsString(FsetA + FsetZ - FsetA * FsetZ);
end;
function TDualAZSet.GetUnionAsText: string;
begin
Result := SetAsString(FsetA + FsetZ);
end;
function TDualAZSet.SetAsString(s: TDigitSet): string;
var d: TDigits;
begin
Result := EmptyStr;
for d in TDigitSet do
if (d in s) then
begin
if Length(Result) > 0
then AppendStr(Result, ',');
AppendStr(Result, IntToStr(d));
end;
Result := Format('[%s]', [Result]);
end;
end.

BIN
set_demo/setdemo.ico Normal file

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

83
set_demo/setdemo.lpi Normal file
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="Integer set demo"/>
<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="setdemo.lpr"/>
<IsPartOfProject Value="True"/>
</Unit0>
<Unit1>
<Filename Value="setdemo_main.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="MainForm"/>
<ResourceBaseClass Value="Form"/>
</Unit1>
<Unit2>
<Filename Value="dualdigitsset.pas"/>
<IsPartOfProject Value="True"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<Target>
<Filename Value="setdemo"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Debugging>
<DebugInfoType Value="dsDwarf2"/>
</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>

23
set_demo/setdemo.lpr Normal file
View File

@ -0,0 +1,23 @@
program setdemo;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, setdemo_main, dualdigitsset
{ you can add units after this };
{$R *.res}
begin
RequireDerivedFormResource:=True;
Application.Title:='Integer set demo';
// Application.Scaled:=True;
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

159
set_demo/setdemo_main.lfm Normal file
View File

@ -0,0 +1,159 @@
object MainForm: TMainForm
Left = 668
Height = 380
Top = 250
Width = 400
Caption = 'Visualising two sets of digits.'
ClientHeight = 380
ClientWidth = 400
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '2.0.12.0'
object pnlA: TPanel
Left = 0
Height = 80
Top = 0
Width = 400
Align = alTop
ClientHeight = 80
ClientWidth = 400
Color = clGradientActiveCaption
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
TabOrder = 0
object editSetA: TLabeledEdit
Left = 235
Height = 22
Top = 40
Width = 150
EditLabel.Height = 16
EditLabel.Width = 34
EditLabel.Caption = 'Set A'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 0
TabStop = False
end
end
object pnlZ: TPanel
Left = 0
Height = 80
Top = 80
Width = 400
Align = alTop
ClientHeight = 80
ClientWidth = 400
Color = clGradientInactiveCaption
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
TabOrder = 1
object editSetZ: TLabeledEdit
Left = 235
Height = 22
Top = 40
Width = 150
EditLabel.Height = 16
EditLabel.Width = 34
EditLabel.Caption = 'Set Z'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 0
TabStop = False
end
end
object pnlResultSets: TPanel
Left = 0
Height = 220
Top = 160
Width = 400
Align = alClient
ClientHeight = 220
ClientWidth = 400
Color = clScrollBar
Font.Style = [fsBold]
ParentColor = False
ParentFont = False
TabOrder = 2
object editUnion: TLabeledEdit
Left = 235
Height = 22
Top = 10
Width = 150
EditLabel.Height = 16
EditLabel.Width = 139
EditLabel.Caption = 'Union of A && Z (A + Z)'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 4
TabStop = False
end
object editIntersection: TLabeledEdit
Left = 235
Height = 22
Top = 50
Width = 150
EditLabel.Height = 16
EditLabel.Width = 177
EditLabel.Caption = 'Intersection of A && Z (A * Z)'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 0
TabStop = False
end
object editSymmetricDiff: TLabeledEdit
Left = 235
Height = 22
Top = 90
Width = 150
EditLabel.Height = 16
EditLabel.Width = 155
EditLabel.Caption = 'Symmetric Diff. of A && Z'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 3
TabStop = False
end
object editDiffAZ: TLabeledEdit
Left = 235
Height = 22
Top = 130
Width = 150
EditLabel.Height = 16
EditLabel.Width = 167
EditLabel.Caption = 'Difference of A && Z (A - Z)'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 2
TabStop = False
end
object editDiffZA: TLabeledEdit
Left = 235
Height = 22
Top = 170
Width = 150
EditLabel.Height = 16
EditLabel.Width = 167
EditLabel.Caption = 'Difference of Z && A (Z - A)'
EditLabel.ParentColor = False
LabelPosition = lpLeft
LabelSpacing = 5
ReadOnly = True
TabOrder = 1
TabStop = False
end
end
end

122
set_demo/setdemo_main.pas Normal file
View File

@ -0,0 +1,122 @@
unit setdemo_main;
{$mode objfpc}{$H+}
interface
uses
Buttons, Forms, Controls, Graphics, Dialogs, ExtCtrls,
dualdigitsset, SysUtils, Classes, strutils;
type
TButtonArr = array[TDigits] of TSpeedButton;
{ TMainForm }
TMainForm = class(TForm)
editSetA: TLabeledEdit;
editSetZ: TLabeledEdit;
editUnion: TLabeledEdit;
editIntersection: TLabeledEdit;
editSymmetricDiff: TLabeledEdit;
editDiffAZ: TLabeledEdit;
editDiffZA: TLabeledEdit;
pnlA: TPanel;
pnlResultSets: TPanel;
pnlZ: TPanel;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
ds: TDualAZSet;
function CreateButtons(setID: Char): TButtonArr;
procedure ButtonClick(Sender: TObject);
procedure UpdateSetExpressions;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.lfm}
{ TMainForm }
procedure TMainForm.FormCreate(Sender: TObject);
begin
ds := TDualAZSet.Create;
CreateButtons('A');
CreateButtons('Z');
end;
procedure TMainForm.FormDestroy(Sender: TObject);
begin
ds.Free;
end;
function TMainForm.CreateButtons(setID: Char): TButtonArr;
const
spacing = 10;
aLeft = 40;
var
i: integer;
b: TSpeedButton;
begin
for i := Low(TDigits) to High(TDigits) do
begin
b := TSpeedButton.Create(Self);
b.Top := spacing;
b.Left := aLeft + i * (b.Width + spacing);
b.Caption := IntToStr(i);
b.Tag := i;
b.Name := Format('%s%d', [setID, i]);
case setId of
'A': b.Parent := pnlA;
'Z': b.Parent := pnlZ;
end;
b.OnClick := @ButtonClick;
Result[i] := b;
end;
end;
procedure TMainForm.ButtonClick(Sender: TObject);
var b: TSpeedButton;
begin
// We only care about SpeedButtons. Just return for others.
if not (Sender is TSpeedButton) then Exit;
b := TSpeedButton(Sender);
case b.Name[1] of
'A': begin
if (b.Tag in ds.SetA)
then ds.SetA := ds.SetA - [b.Tag]
else ds.SetA := ds.SetA + [b.Tag];
editSetA.Caption := ds.SetAasText;
end;
'Z': begin
if (b.Tag in ds.SetZ)
then ds.SetZ := ds.SetZ - [b.Tag]
else ds.SetZ := ds.SetZ + [b.Tag];
editSetZ.Caption := ds.SetZasText;
end;
end;
UpdateSetExpressions;
end;
procedure TMainForm.UpdateSetExpressions;
begin
editUnion.Caption := ds.UnionAsText;
editSymmetricDiff.Caption := ds.SymDiffAsText;
editIntersection.Caption := ds.IntersectionAsText;
editDiffAZ.Caption := ds.DiffAZasText;
editDiffZA.Caption := ds.DiffZAasText;
end;
end.