paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-10 03:28:40 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Applied patch by Markus Kaemmerer (merged):

Browse Source 
- Added support for TStringList.CustomSort
This commit is contained in:
sg 2000-12-03 22:35:09 +00:00
parent ec796cc40b
commit 9dc9cdeafc
2 changed files with 35 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
fcl/inc/classesh.inc
View File

@ -401,6 +401,7 @@ type
{ TStringList class }
TDuplicates = (dupIgnore, dupAccept, dupError);
TStringList = class;
PStringItem = ^TStringItem;
TStringItem = record
@ -410,6 +411,7 @@ type
PStringItemList = ^TStringItemList;
TStringItemList = array[0..MaxListSize] of TStringItem;
TStringListSortCompare = function(List: TStringList; Index1, Index2: Integer): Integer;
TStringList = class(TStrings)
private
@ -422,7 +424,7 @@ type
FOnChanging: TNotifyEvent;
procedure ExchangeItems(Index1, Index2: Integer);
procedure Grow;
procedure QuickSort(L, R: Integer);
procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
procedure InsertItem(Index: Integer; const S: string);
procedure SetSorted(Value: Boolean);
protected
@ -446,6 +448,7 @@ type
function IndexOf(const S: string): Integer; override;
procedure Insert(Index: Integer; const S: string); override;
procedure Sort; virtual;
procedure CustomSort(CompareFn: TStringListSortCompare);
property Duplicates: TDuplicates read FDuplicates write FDuplicates;
property Sorted: Boolean read FSorted write SetSorted;
property OnChange: TNotifyEvent read FOnChange write FOnChange;
@ -1236,7 +1239,11 @@ function LineStart(Buffer, BufPos: PChar): PChar;
{
$Log$
Revision 1.5 2000-11-13 15:46:55 marco
Revision 1.6 2000-12-03 22:35:09 sg
* Applied patch by Markus Kaemmerer (merged):
- Added support for TStringList.CustomSort
Revision 1.5 2000/11/13 15:46:55 marco
* Unix renamefest for defines.
Revision 1.4 2000/10/15 10:04:39 peter

36
fcl/inc/stringl.inc
View File

@ -641,19 +641,18 @@ end;
Procedure TStringList.QuickSort(L, R: Integer);
Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
Var I,J : Longint;
Pivot : String;
Var I,J, Pivot : Longint;
begin
Repeat;
I:=L;
J:=R;
Pivot:=Flist^[(L+R) div 2].FString;
Pivot:=(L+R) div 2;
Repeat
While AnsiCompareText(Flist^[I].Fstring,Pivot)<0 do Inc(I);
While AnsiCompareText(Flist^[J].Fstring,Pivot)>0 do Dec(J);
While CompareFn(Self, I, Pivot)<0 do Inc(I);
While CompareFn(Self, J, Pivot)>0 do Dec(J);
If I<=J then
begin
ExchangeItems(I,J); // No check, indices are correct.
@ -661,7 +660,7 @@ begin
Dec(j);
end;
until I>J;
If L<J then QuickSort(L,J);
If L<J then QuickSort(L,J, CompareFn);
L:=I;
Until I>=R;
end;
@ -955,20 +954,37 @@ begin
end;
Procedure TStringList.Sort;
Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
begin
If Not Sorted and (FCount>1) then
begin
Changing;
QuickSOrt(0,FCount-1);
QuickSort(0,FCount-1, CompareFn);
Changed;
end;
end;
function StringListAnsiCompare(List: TStringList; Index1, Index: Integer): Integer;
begin
Result := AnsiCompareText(List.FList^[Index1].FString,
List.FList^[Index1].FString);
end;
Procedure TStringList.Sort;
begin
CustomSort(@StringListAnsiCompare);
end;
{
$Log$
Revision 1.5 2000-11-22 22:44:39 peter
Revision 1.6 2000-12-03 22:35:09 sg
* Applied patch by Markus Kaemmerer (merged):
- Added support for TStringList.CustomSort
Revision 1.5 2000/11/22 22:44:39 peter
* fixed commatext (merged)
Revision 1.4 2000/11/17 13:39:49 sg