mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-10-20 17:31:48 +02:00
lazutils: added example for TDictionaryStringList
git-svn-id: trunk@40868 -
This commit is contained in:
parent
2c855977d2
commit
55b523ce84
5
.gitattributes
vendored
5
.gitattributes
vendored
@ -2130,6 +2130,11 @@ components/lazutils/asiancodepages.inc svneol=native#text/pascal
|
|||||||
components/lazutils/avglvltree.pas svneol=native#text/pascal
|
components/lazutils/avglvltree.pas svneol=native#text/pascal
|
||||||
components/lazutils/dictionarystringlist.pas svneol=native#text/plain
|
components/lazutils/dictionarystringlist.pas svneol=native#text/plain
|
||||||
components/lazutils/easylazfreetype.pas svneol=native#text/pascal
|
components/lazutils/easylazfreetype.pas svneol=native#text/pascal
|
||||||
|
components/lazutils/examples/DictionaryStringList/ReadMe.txt svneol=native#text/plain
|
||||||
|
components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi svneol=native#text/plain
|
||||||
|
components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr svneol=native#text/plain
|
||||||
|
components/lazutils/examples/DictionaryStringList/main.lfm svneol=native#text/plain
|
||||||
|
components/lazutils/examples/DictionaryStringList/main.pas svneol=native#text/plain
|
||||||
components/lazutils/fileutil.inc svneol=native#text/pascal
|
components/lazutils/fileutil.inc svneol=native#text/pascal
|
||||||
components/lazutils/fileutil.pas svneol=native#text/pascal
|
components/lazutils/fileutil.pas svneol=native#text/pascal
|
||||||
components/lazutils/fpmake.pp svneol=native#text/plain
|
components/lazutils/fpmake.pp svneol=native#text/plain
|
||||||
|
@ -0,0 +1,3 @@
|
|||||||
|
Demonstrate how TDictionaryStringList can quicly remove duplicates from a list.
|
||||||
|
|
||||||
|
Author: Antônio Galvão
|
@ -0,0 +1,90 @@
|
|||||||
|
<?xml version="1.0"?>
|
||||||
|
<CONFIG>
|
||||||
|
<ProjectOptions>
|
||||||
|
<Version Value="9"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<General>
|
||||||
|
<SessionStorage Value="InProjectDir"/>
|
||||||
|
<MainUnit Value="0"/>
|
||||||
|
<Title Value="TDictionaryStringListDemo"/>
|
||||||
|
<ResourceType Value="res"/>
|
||||||
|
<UseXPManifest Value="True"/>
|
||||||
|
</General>
|
||||||
|
<i18n>
|
||||||
|
<EnableI18N LFM="False"/>
|
||||||
|
</i18n>
|
||||||
|
<VersionInfo>
|
||||||
|
<StringTable ProductVersion=""/>
|
||||||
|
</VersionInfo>
|
||||||
|
<BuildModes Count="1">
|
||||||
|
<Item1 Name="Default" Default="True"/>
|
||||||
|
</BuildModes>
|
||||||
|
<PublishOptions>
|
||||||
|
<Version Value="2"/>
|
||||||
|
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
|
||||||
|
<ExcludeFileFilter Value="*.(bak|ppu|o|so);*~;backup"/>
|
||||||
|
</PublishOptions>
|
||||||
|
<RunParams>
|
||||||
|
<local>
|
||||||
|
<FormatVersion Value="1"/>
|
||||||
|
</local>
|
||||||
|
</RunParams>
|
||||||
|
<RequiredPackages Count="1">
|
||||||
|
<Item1>
|
||||||
|
<PackageName Value="LCL"/>
|
||||||
|
</Item1>
|
||||||
|
</RequiredPackages>
|
||||||
|
<Units Count="2">
|
||||||
|
<Unit0>
|
||||||
|
<Filename Value="TDictionaryStringListDemo.lpr"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<UnitName Value="TDictionaryStringListDemo"/>
|
||||||
|
</Unit0>
|
||||||
|
<Unit1>
|
||||||
|
<Filename Value="main.pas"/>
|
||||||
|
<IsPartOfProject Value="True"/>
|
||||||
|
<ComponentName Value="Form1"/>
|
||||||
|
<HasResources Value="True"/>
|
||||||
|
<ResourceBaseClass Value="Form"/>
|
||||||
|
<UnitName Value="Main"/>
|
||||||
|
</Unit1>
|
||||||
|
</Units>
|
||||||
|
</ProjectOptions>
|
||||||
|
<CompilerOptions>
|
||||||
|
<Version Value="11"/>
|
||||||
|
<PathDelim Value="\"/>
|
||||||
|
<Target>
|
||||||
|
<Filename Value="TDictionaryStringListDemo"/>
|
||||||
|
</Target>
|
||||||
|
<SearchPaths>
|
||||||
|
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||||
|
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
|
||||||
|
</SearchPaths>
|
||||||
|
<Linking>
|
||||||
|
<Options>
|
||||||
|
<Win32>
|
||||||
|
<GraphicApplication Value="True"/>
|
||||||
|
</Win32>
|
||||||
|
</Options>
|
||||||
|
</Linking>
|
||||||
|
<Other>
|
||||||
|
<CompilerMessages>
|
||||||
|
<MsgFileName Value=""/>
|
||||||
|
</CompilerMessages>
|
||||||
|
<CompilerPath Value="$(CompPath)"/>
|
||||||
|
</Other>
|
||||||
|
</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,20 @@
|
|||||||
|
program TDictionaryStringListDemo;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF UNIX}{$IFDEF UseCThreads}
|
||||||
|
cthreads,
|
||||||
|
{$ENDIF}{$ENDIF}
|
||||||
|
Interfaces, // this includes the LCL widgetset
|
||||||
|
Forms, Main;
|
||||||
|
|
||||||
|
{$R *.res}
|
||||||
|
|
||||||
|
begin
|
||||||
|
RequireDerivedFormResource := True;
|
||||||
|
Application.Initialize;
|
||||||
|
Application.CreateForm(TForm1, Form1);
|
||||||
|
Application.Run;
|
||||||
|
end.
|
||||||
|
|
67
components/lazutils/examples/DictionaryStringList/main.lfm
Normal file
67
components/lazutils/examples/DictionaryStringList/main.lfm
Normal file
@ -0,0 +1,67 @@
|
|||||||
|
object Form1: TForm1
|
||||||
|
Left = 291
|
||||||
|
Height = 353
|
||||||
|
Top = 215
|
||||||
|
Width = 514
|
||||||
|
BorderStyle = bsSingle
|
||||||
|
Caption = 'TDictionaryStringList Demo'
|
||||||
|
ClientHeight = 353
|
||||||
|
ClientWidth = 514
|
||||||
|
OnCreate = FormCreate
|
||||||
|
OnDestroy = FormDestroy
|
||||||
|
OnShow = FormShow
|
||||||
|
Position = poScreenCenter
|
||||||
|
LCLVersion = '1.1'
|
||||||
|
object btnDedupeMemo: TButton
|
||||||
|
Left = 384
|
||||||
|
Height = 25
|
||||||
|
Top = 8
|
||||||
|
Width = 123
|
||||||
|
Caption = 'Dedupe Memo'
|
||||||
|
OnClick = btnDedupeMemoClick
|
||||||
|
TabOrder = 0
|
||||||
|
end
|
||||||
|
object Memo: TMemo
|
||||||
|
Left = 0
|
||||||
|
Height = 281
|
||||||
|
Top = 72
|
||||||
|
Width = 514
|
||||||
|
Align = alBottom
|
||||||
|
ScrollBars = ssAutoBoth
|
||||||
|
TabOrder = 1
|
||||||
|
end
|
||||||
|
object lblTime: TLabel
|
||||||
|
Left = 16
|
||||||
|
Height = 15
|
||||||
|
Top = 48
|
||||||
|
Width = 33
|
||||||
|
Caption = 'Time:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object lblLines: TLabel
|
||||||
|
Left = 130
|
||||||
|
Height = 15
|
||||||
|
Top = 48
|
||||||
|
Width = 107
|
||||||
|
Caption = 'Duplicated Lines:'
|
||||||
|
ParentColor = False
|
||||||
|
end
|
||||||
|
object SpinEdit1: TSpinEdit
|
||||||
|
Left = 8
|
||||||
|
Height = 23
|
||||||
|
Top = 8
|
||||||
|
Width = 94
|
||||||
|
Increment = 1000
|
||||||
|
MaxValue = 1000000000
|
||||||
|
TabOrder = 2
|
||||||
|
end
|
||||||
|
object btnGenerate: TButton
|
||||||
|
Left = 112
|
||||||
|
Height = 25
|
||||||
|
Top = 8
|
||||||
|
Width = 107
|
||||||
|
Caption = 'Generate Data'
|
||||||
|
OnClick = btnGenerateClick
|
||||||
|
TabOrder = 3
|
||||||
|
end
|
||||||
|
end
|
117
components/lazutils/examples/DictionaryStringList/main.pas
Normal file
117
components/lazutils/examples/DictionaryStringList/main.pas
Normal file
@ -0,0 +1,117 @@
|
|||||||
|
unit Main;
|
||||||
|
|
||||||
|
{$mode objfpc}{$H+}
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses
|
||||||
|
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
|
||||||
|
Spin, DictionaryStringList, Math;
|
||||||
|
|
||||||
|
type
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
TForm1 = class(TForm)
|
||||||
|
btnDedupeMemo: TButton;
|
||||||
|
btnGenerate: TButton;
|
||||||
|
lblLines: TLabel;
|
||||||
|
lblTime: TLabel;
|
||||||
|
Memo: TMemo;
|
||||||
|
SpinEdit1: TSpinEdit;
|
||||||
|
procedure btnGenerateClick(Sender: TObject);
|
||||||
|
procedure btnDedupeMemoClick(Sender: TObject);
|
||||||
|
procedure FormCreate(Sender: TObject);
|
||||||
|
procedure FormDestroy(Sender: TObject);
|
||||||
|
procedure FormShow(Sender: TObject);
|
||||||
|
private
|
||||||
|
inList :TStringList;
|
||||||
|
procedure UpdateDuplicates(aDuplicateCount: string);
|
||||||
|
procedure UpdateTime(aTime: TDateTime);
|
||||||
|
public
|
||||||
|
|
||||||
|
end;
|
||||||
|
|
||||||
|
var
|
||||||
|
Form1: TForm1;
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
{$R *.lfm}
|
||||||
|
|
||||||
|
{ TForm1 }
|
||||||
|
|
||||||
|
procedure TForm1.UpdateDuplicates(aDuplicateCount: string);
|
||||||
|
begin
|
||||||
|
lblLines.Caption := 'Duplicated Lines: ' + aDuplicateCount;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.UpdateTime(aTime: TDateTime);
|
||||||
|
begin
|
||||||
|
lblTime.Caption := 'Time: ' + TimeToStr(aTime);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.btnGenerateClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
i, j: Integer;
|
||||||
|
s :string;
|
||||||
|
begin
|
||||||
|
UpdateDuplicates('?');
|
||||||
|
UpdateTime(0);
|
||||||
|
Memo.Clear;
|
||||||
|
Application.ProcessMessages;
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
try
|
||||||
|
InList.Clear;
|
||||||
|
for i := 0 to SpinEdit1.Value - 1 do
|
||||||
|
begin
|
||||||
|
s := '';
|
||||||
|
for j := 0 to 5 do
|
||||||
|
s := s + chr(randomrange(97, 123));
|
||||||
|
InList.Add(s);
|
||||||
|
end;
|
||||||
|
Memo.Lines.Assign(inList);
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.btnDedupeMemoClick(Sender: TObject);
|
||||||
|
var
|
||||||
|
DSL :TDictionaryStringList;
|
||||||
|
T :TDateTime;
|
||||||
|
begin
|
||||||
|
Screen.Cursor := crHourGlass;
|
||||||
|
try
|
||||||
|
T := Now;
|
||||||
|
DSL := TDictionaryStringList.Create;
|
||||||
|
try
|
||||||
|
DSL.Assign(Memo.Lines);
|
||||||
|
UpdateDuplicates(IntToStr(Memo.Lines.Count - DSL.Count));
|
||||||
|
Memo.Lines.Assign(DSL);
|
||||||
|
finally
|
||||||
|
DSL.Free;
|
||||||
|
end;
|
||||||
|
UpdateTime(Now - T);
|
||||||
|
finally
|
||||||
|
Screen.Cursor := crDefault;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormCreate(Sender: TObject);
|
||||||
|
begin
|
||||||
|
inList := TStringList.Create;
|
||||||
|
Randomize;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormDestroy(Sender: TObject);
|
||||||
|
begin
|
||||||
|
inList.Free;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure TForm1.FormShow(Sender: TObject);
|
||||||
|
begin
|
||||||
|
spinedit1.Value := 1000000;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end.
|
Loading…
Reference in New Issue
Block a user