From 55b523ce84c5695492c9595681898231d27b0b7f Mon Sep 17 00:00:00 2001 From: mattias Date: Sun, 21 Apr 2013 21:49:09 +0000 Subject: [PATCH] lazutils: added example for TDictionaryStringList git-svn-id: trunk@40868 - --- .gitattributes | 5 + .../examples/DictionaryStringList/ReadMe.txt | 3 + .../TDictionaryStringListDemo.lpi | 90 ++++++++++++++ .../TDictionaryStringListDemo.lpr | 20 +++ .../examples/DictionaryStringList/main.lfm | 67 ++++++++++ .../examples/DictionaryStringList/main.pas | 117 ++++++++++++++++++ 6 files changed, 302 insertions(+) create mode 100644 components/lazutils/examples/DictionaryStringList/ReadMe.txt create mode 100644 components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi create mode 100644 components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr create mode 100644 components/lazutils/examples/DictionaryStringList/main.lfm create mode 100644 components/lazutils/examples/DictionaryStringList/main.pas diff --git a/.gitattributes b/.gitattributes index d6e59d05a7..433ac8e2fc 100644 --- a/.gitattributes +++ b/.gitattributes @@ -2130,6 +2130,11 @@ components/lazutils/asiancodepages.inc svneol=native#text/pascal components/lazutils/avglvltree.pas svneol=native#text/pascal components/lazutils/dictionarystringlist.pas svneol=native#text/plain 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.pas svneol=native#text/pascal components/lazutils/fpmake.pp svneol=native#text/plain diff --git a/components/lazutils/examples/DictionaryStringList/ReadMe.txt b/components/lazutils/examples/DictionaryStringList/ReadMe.txt new file mode 100644 index 0000000000..2dd2e599ef --- /dev/null +++ b/components/lazutils/examples/DictionaryStringList/ReadMe.txt @@ -0,0 +1,3 @@ +Demonstrate how TDictionaryStringList can quicly remove duplicates from a list. + +Author: Antônio Galvão diff --git a/components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi b/components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi new file mode 100644 index 0000000000..b60ee01253 --- /dev/null +++ b/components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi @@ -0,0 +1,90 @@ + + + + + + + + + + <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> diff --git a/components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr b/components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr new file mode 100644 index 0000000000..b9fc467a19 --- /dev/null +++ b/components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr @@ -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. + diff --git a/components/lazutils/examples/DictionaryStringList/main.lfm b/components/lazutils/examples/DictionaryStringList/main.lfm new file mode 100644 index 0000000000..9cfeeb9e9e --- /dev/null +++ b/components/lazutils/examples/DictionaryStringList/main.lfm @@ -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 \ No newline at end of file diff --git a/components/lazutils/examples/DictionaryStringList/main.pas b/components/lazutils/examples/DictionaryStringList/main.pas new file mode 100644 index 0000000000..d4b9391eb9 --- /dev/null +++ b/components/lazutils/examples/DictionaryStringList/main.pas @@ -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.