mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-03 15:50:26 +02:00
* Allow Find to work with user-sorted stringlists.
git-svn-id: trunk@33328 -
This commit is contained in:
michael
parent
2b077f6af3
commit
10bbfce412
@ -726,6 +726,9 @@ type
|
||||
PStringItemList = ^TStringItemList;
|
||||
TStringItemList = array[0..MaxListSize] of TStringItem;
|
||||
|
||||
TStringsSortStyle = (sslNone,sslUser,sslAuto);
|
||||
TStringsSortStyles = Set of TStringsSortStyle;
|
||||
|
||||
TStringList = class(TStrings)
|
||||
private
|
||||
FList: PStringItemList;
|
||||
@ -735,15 +738,17 @@ type
|
||||
FOnChanging: TNotifyEvent;
|
||||
FDuplicates: TDuplicates;
|
||||
FCaseSensitive : Boolean;
|
||||
FSorted: Boolean;
|
||||
FForceSort : Boolean;
|
||||
FOwnsObjects : Boolean;
|
||||
FSortStyle: TStringsSortStyle;
|
||||
procedure ExchangeItemsInt(Index1, Index2: Integer); inline;
|
||||
function GetSorted: Boolean;
|
||||
procedure Grow;
|
||||
procedure InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
|
||||
procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
|
||||
procedure SetSorted(Value: Boolean);
|
||||
procedure SetCaseSensitive(b : boolean);
|
||||
procedure SetSortStyle(AValue: TStringsSortStyle);
|
||||
protected
|
||||
procedure ExchangeItems(Index1, Index2: Integer); virtual;
|
||||
procedure Changed; virtual;
|
||||
@ -773,11 +778,12 @@ type
|
||||
procedure Sort; virtual;
|
||||
procedure CustomSort(CompareFn: TStringListSortCompare); virtual;
|
||||
property Duplicates: TDuplicates read FDuplicates write FDuplicates;
|
||||
property Sorted: Boolean read FSorted write SetSorted;
|
||||
property Sorted: Boolean read GetSorted write SetSorted;
|
||||
property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
|
||||
property OnChange: TNotifyEvent read FOnChange write FOnChange;
|
||||
property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
|
||||
property OwnsObjects : boolean read FOwnsObjects write FOwnsObjects;
|
||||
Property SortStyle : TStringsSortStyle Read FSortStyle Write SetSortStyle;
|
||||
end;
|
||||
|
||||
{$else}
|
||||
|
||||
@ -1043,7 +1043,7 @@ end;
|
||||
|
||||
{$if not defined(FPC_TESTGENERICS)}
|
||||
|
||||
Procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer);
|
||||
procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer);
|
||||
|
||||
Var P1,P2 : Pointer;
|
||||
|
||||
@ -1056,14 +1056,19 @@ begin
|
||||
Pointer(Flist^[Index2].FObject):=P2;
|
||||
end;
|
||||
|
||||
function TStringList.GetSorted: Boolean;
|
||||
begin
|
||||
Result:=FSortStyle in [sslUser,sslAuto];
|
||||
end;
|
||||
|
||||
Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
|
||||
|
||||
procedure TStringList.ExchangeItems(Index1, Index2: Integer);
|
||||
begin
|
||||
ExchangeItemsInt(Index1, Index2);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStringList.Grow;
|
||||
procedure TStringList.Grow;
|
||||
|
||||
Var
|
||||
NC : Integer;
|
||||
@ -1079,7 +1084,7 @@ begin
|
||||
SetCapacity(NC);
|
||||
end;
|
||||
|
||||
Procedure TStringList.InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
|
||||
procedure TStringList.InternalClear(FromIndex: Integer; ClearOnly: Boolean);
|
||||
|
||||
Var
|
||||
I: Integer;
|
||||
@ -1106,7 +1111,8 @@ begin
|
||||
SetCapacity(0);
|
||||
end;
|
||||
|
||||
Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
|
||||
procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare
|
||||
);
|
||||
var
|
||||
Pivot, vL, vR: Integer;
|
||||
ExchangeProc: procedure(Left, Right: Integer) of object;
|
||||
@ -1152,13 +1158,13 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStringList.InsertItem(Index: Integer; const S: string);
|
||||
procedure TStringList.InsertItem(Index: Integer; const S: string);
|
||||
begin
|
||||
InsertItem(Index, S, nil);
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
|
||||
procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
|
||||
begin
|
||||
Changing;
|
||||
If FCount=Fcapacity then Grow;
|
||||
@ -1173,19 +1179,18 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStringList.SetSorted(Value: Boolean);
|
||||
procedure TStringList.SetSorted(Value: Boolean);
|
||||
|
||||
begin
|
||||
If FSorted<>Value then
|
||||
begin
|
||||
If Value then sort;
|
||||
FSorted:=VAlue
|
||||
end;
|
||||
If Value then
|
||||
SortStyle:=sslAuto
|
||||
else
|
||||
SortStyle:=sslNone
|
||||
end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.Changed;
|
||||
procedure TStringList.Changed;
|
||||
|
||||
begin
|
||||
If (FUpdateCount=0) Then
|
||||
@ -1198,7 +1203,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.Changing;
|
||||
procedure TStringList.Changing;
|
||||
|
||||
begin
|
||||
If FUpdateCount=0 then
|
||||
@ -1208,7 +1213,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Function TStringList.Get(Index: Integer): string;
|
||||
function TStringList.Get(Index: Integer): string;
|
||||
|
||||
begin
|
||||
If (Index<0) or (INdex>=Fcount) then
|
||||
@ -1218,7 +1223,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Function TStringList.GetCapacity: Integer;
|
||||
function TStringList.GetCapacity: Integer;
|
||||
|
||||
begin
|
||||
Result:=FCapacity;
|
||||
@ -1226,7 +1231,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Function TStringList.GetCount: Integer;
|
||||
function TStringList.GetCount: Integer;
|
||||
|
||||
begin
|
||||
Result:=FCount;
|
||||
@ -1234,7 +1239,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Function TStringList.GetObject(Index: Integer): TObject;
|
||||
function TStringList.GetObject(Index: Integer): TObject;
|
||||
|
||||
begin
|
||||
If (Index<0) or (INdex>=Fcount) then
|
||||
@ -1244,7 +1249,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.Put(Index: Integer; const S: string);
|
||||
procedure TStringList.Put(Index: Integer; const S: string);
|
||||
|
||||
begin
|
||||
If Sorted then
|
||||
@ -1258,7 +1263,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
|
||||
procedure TStringList.PutObject(Index: Integer; AObject: TObject);
|
||||
|
||||
begin
|
||||
If (Index<0) or (INdex>=Fcount) then
|
||||
@ -1270,7 +1275,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.SetCapacity(NewCapacity: Integer);
|
||||
procedure TStringList.SetCapacity(NewCapacity: Integer);
|
||||
|
||||
Var NewList : Pointer;
|
||||
MSize : Longint;
|
||||
@ -1315,7 +1320,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.SetUpdateState(Updating: Boolean);
|
||||
procedure TStringList.SetUpdateState(Updating: Boolean);
|
||||
|
||||
begin
|
||||
If Updating then
|
||||
@ -1335,10 +1340,10 @@ end;
|
||||
|
||||
|
||||
|
||||
Function TStringList.Add(const S: string): Integer;
|
||||
function TStringList.Add(const S: string): Integer;
|
||||
|
||||
begin
|
||||
If Not Sorted then
|
||||
If Not (SortStyle=sslAuto) then
|
||||
Result:=FCount
|
||||
else
|
||||
If Find (S,Result) then
|
||||
@ -1349,7 +1354,7 @@ begin
|
||||
InsertItem (Result,S);
|
||||
end;
|
||||
|
||||
Procedure TStringList.Clear;
|
||||
procedure TStringList.Clear;
|
||||
|
||||
begin
|
||||
if FCount = 0 then Exit;
|
||||
@ -1358,7 +1363,7 @@ begin
|
||||
Changed;
|
||||
end;
|
||||
|
||||
Procedure TStringList.Delete(Index: Integer);
|
||||
procedure TStringList.Delete(Index: Integer);
|
||||
|
||||
begin
|
||||
If (Index<0) or (Index>=FCount) then
|
||||
@ -1377,7 +1382,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.Exchange(Index1, Index2: Integer);
|
||||
procedure TStringList.Exchange(Index1, Index2: Integer);
|
||||
|
||||
begin
|
||||
If (Index1<0) or (Index1>=FCount) then
|
||||
@ -1395,22 +1400,33 @@ begin
|
||||
if b=FCaseSensitive then
|
||||
Exit;
|
||||
FCaseSensitive:=b;
|
||||
if FSorted then
|
||||
if FSortStyle=sslAuto then
|
||||
begin
|
||||
FForceSort:=True;
|
||||
sort;
|
||||
FForceSort:=False;
|
||||
try
|
||||
Sort;
|
||||
finally
|
||||
FForceSort:=False;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TStringList.SetSortStyle(AValue: TStringsSortStyle);
|
||||
begin
|
||||
if FSortStyle=AValue then Exit;
|
||||
if (AValue=sslAuto) then
|
||||
Sort;
|
||||
FSortStyle:=AValue;
|
||||
end;
|
||||
|
||||
Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt;
|
||||
begin
|
||||
if FCaseSensitive then
|
||||
result:=AnsiCompareStr(s1,s2)
|
||||
else
|
||||
result:=AnsiCompareText(s1,s2);
|
||||
end;
|
||||
|
||||
function TStringList.DoCompareText(const s1, s2: string): PtrInt;
|
||||
begin
|
||||
if FCaseSensitive then
|
||||
result:=AnsiCompareStr(s1,s2)
|
||||
else
|
||||
result:=AnsiCompareText(s1,s2);
|
||||
end;
|
||||
|
||||
|
||||
function TStringList.CompareStrings(const s1,s2 : string) : Integer;
|
||||
@ -1419,15 +1435,16 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Function TStringList.Find(const S: string; Out Index: Integer): Boolean;
|
||||
function TStringList.Find(const S: string; out Index: Integer): Boolean;
|
||||
|
||||
var
|
||||
L, R, I: Integer;
|
||||
CompareRes: PtrInt;
|
||||
begin
|
||||
Result := false;
|
||||
if Not Sorted then
|
||||
exit;
|
||||
Index:=-1;
|
||||
if Not Sorted then
|
||||
Raise EListError.Create(SErrFindNeedsSortedList);
|
||||
// Use binary search.
|
||||
L := 0;
|
||||
R := Count - 1;
|
||||
@ -1451,7 +1468,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Function TStringList.IndexOf(const S: string): Integer;
|
||||
function TStringList.IndexOf(const S: string): Integer;
|
||||
|
||||
begin
|
||||
If Not Sorted then
|
||||
@ -1464,10 +1481,10 @@ end;
|
||||
|
||||
|
||||
|
||||
Procedure TStringList.Insert(Index: Integer; const S: string);
|
||||
procedure TStringList.Insert(Index: Integer; const S: string);
|
||||
|
||||
begin
|
||||
If Sorted then
|
||||
If SortStyle=sslAuto then
|
||||
Error (SSortedListError,0)
|
||||
else
|
||||
If (Index<0) or (Index>FCount) then
|
||||
@ -1477,10 +1494,10 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
|
||||
procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
|
||||
|
||||
begin
|
||||
If (FForceSort or (Not Sorted)) and (FCount>1) then
|
||||
If (FForceSort or (Not (FSortStyle=sslAuto))) and (FCount>1) then
|
||||
begin
|
||||
Changing;
|
||||
QuickSort(0,FCount-1, CompareFn);
|
||||
@ -1495,7 +1512,7 @@ begin
|
||||
List.FList^[Index].FString);
|
||||
end;
|
||||
|
||||
Procedure TStringList.Sort;
|
||||
procedure TStringList.Sort;
|
||||
|
||||
begin
|
||||
CustomSort(@StringListAnsiCompare);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user