LazUtils: Fix and improve TLookupStringList and its example project.

git-svn-id: trunk@64460 -
This commit is contained in:
juha 2021-02-05 11:27:59 +00:00
parent 40268610ae
commit de413141bf
5 changed files with 46 additions and 38 deletions

View File

@ -1,11 +1,13 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<Version Value="12"/>
<PathDelim Value="\"/>
<General>
<Flags>
<CompatibilityMode Value="True"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="TDedupeDemo"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
@ -13,21 +15,17 @@
<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>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default"/>
</Modes>
</RunParams>
<RequiredPackages Count="1">
<Item1>

View File

@ -11,7 +11,7 @@ object Form1: TForm1
OnDestroy = FormDestroy
OnShow = FormShow
Position = poScreenCenter
LCLVersion = '1.5'
LCLVersion = '2.1.0.0'
object btnDedupeMemo: TButton
Left = 346
Height = 25
@ -32,23 +32,23 @@ object Form1: TForm1
end
object lblTime: TLabel
Left = 16
Height = 17
Height = 18
Top = 48
Width = 32
Width = 34
Caption = 'Time:'
ParentColor = False
end
object lblLines: TLabel
Left = 130
Height = 17
Height = 18
Top = 48
Width = 98
Width = 105
Caption = 'Duplicated Lines:'
ParentColor = False
end
object SpinEdit1: TSpinEdit
Left = 8
Height = 23
Height = 32
Top = 8
Width = 94
Increment = 1000
@ -78,12 +78,17 @@ object Form1: TForm1
TabOrder = 4
end
object Label1: TLabel
AnchorSideLeft.Control = btnDedupeFile
AnchorSideRight.Control = btnDedupeFile
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = btnDedupeFile
Left = 346
Height = 64
Top = 168
Width = 182
Height = 96
Top = 136
Width = 183
Anchors = [akLeft, akRight, akBottom]
AutoSize = False
Caption = 'Deduplicating from a file is very much faster than using a GUI control. Use the button below to see the whole process.'
Caption = 'Deduplicating from a file is much faster than using a GUI control. Use the button below to see the whole process.'
ParentColor = False
WordWrap = True
end

View File

@ -5,8 +5,7 @@ unit Main;
interface
uses
Classes, SysUtils, Math, Forms, Controls, Dialogs, StdCtrls, Spin,
LookupStringList;
Classes, SysUtils, Math, Forms, Controls, Dialogs, StdCtrls, Spin, LookupStringList;
type
@ -113,13 +112,12 @@ begin
if Trim(Memo.Text) = '' then
begin
ShowMessage('Generating data. Please wait.');
btnGenerateClick(nil);
ShowMessage('Generated data.');
end;
ShowMessage('Saving memo to a file. Please wait.');
Memo.Lines.SaveToFile('temp.txt');
ShowMessage('Dedupping the file.');
ShowMessage('Saved memo to a file.');
T := Now;
N := Memo.Lines.Count;
DSL := TLookupStringList.Create;
@ -128,7 +126,7 @@ begin
lblLines.Caption := 'Duplicated Lines: ' + IntToStr(N - DSL.Count);
DSL.SaveToFile('temp.txt');
lblTime.Caption := 'Time: ' + TimeToStr(Now - T);
ShowMessage('Deleting the file.');
ShowMessage('Dedupping the file. Will delete it.');
DeleteFile('temp.txt');
finally
DSL.Free;

View File

@ -6,7 +6,7 @@
for details about the license.
*****************************************************************************
}
unit lazfglhash;
unit LazFglHash;
{$mode objfpc}{$H+}

View File

@ -41,6 +41,7 @@ type
protected
procedure InsertItem(Index: Integer; const S: string); override;
public
constructor Create(aCaseSensitive: Boolean);
constructor Create;
destructor Destroy; override;
procedure Assign(Source: TPersistent); override;
@ -53,24 +54,24 @@ type
function IndexOf(const S: string): Integer; override;
end;
function Deduplicate(AStrings: TStrings): Boolean;
function Deduplicate(AStrings: TStrings): Integer;
implementation
{
Removes duplicate strings (case sensitive) from AStrings.
When the AStrings owns and contains objects, the function will return false.
}
function Deduplicate(AStrings: TStrings): Boolean;
function Deduplicate(AStrings: TStrings): Integer;
// Removes duplicate strings (case sensitive) from AStrings.
// Returns the number of duplicates removed.
var
DSL: TLookupStringList;
InCnt: Integer;
begin
Result := False;
DSL := TLookupStringList.Create;
InCnt := AStrings.Count;
DSL := TLookupStringList.Create(True);
try
DSL.Assign(AStrings);
AStrings.Assign(DSL);
Result := True;
Result := InCnt - AStrings.Count;
finally
DSL.Free;
end;
@ -78,10 +79,16 @@ end;
{ TLookupStringList }
constructor TLookupStringList.Create;
constructor TLookupStringList.Create(aCaseSensitive: Boolean);
begin
inherited Create;
FMap := TStringMap.Create(True);
CaseSensitive := aCaseSensitive;
FMap := TStringMap.Create(aCaseSensitive);
end;
constructor TLookupStringList.Create;
begin
Create(False); // Case-insensitive by default
end;
destructor TLookupStringList.Destroy;