paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-10-16 18:16:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

lazutils: added example for TDictionaryStringList

Browse Source 
git-svn-id: trunk@40868 -
This commit is contained in:
mattias 2013-04-21 21:49:09 +00:00
parent 2c855977d2
commit 55b523ce84
6 changed files with 302 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

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

3
components/lazutils/examples/DictionaryStringList/ReadMe.txt Normal file
View File

@ -0,0 +1,3 @@
Demonstrate how TDictionaryStringList can quicly remove duplicates from a list.
Author: Antônio Galvão

90
components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpi Normal file
View File

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

20
components/lazutils/examples/DictionaryStringList/TDictionaryStringListDemo.lpr Normal file
View File

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