program FPListHelpEx;
{$mode objfpc}{$H+}
{$modeswitch typehelpers}
uses
classes,sysutils,dateutils;
type
TFPListCustomSortDirection=(sdAscending,sdDescending);
TFPListCustomSortCompareFunc=function(item1,item2:pointer;FieldName:string):integer;
TFPListHelper=class helper for TFPList
procedure CustomSort(Compare:TFPListCustomSortCompareFunc; FieldName:string; SortDirection:TFPListCustomSortDirection = sdAscending);
procedure CustomQuickSort(FList:PPointerList;L,R:Longint;Compare:TFPListCustomSortCompareFunc;FieldName:string;SortDirection:TFPListCustomSortDirection);
end;
procedure TFPListHelper.CustomQuickSort(FList:PPointerList;L,R:Longint;Compare:TFPListCustomSortCompareFunc;FieldName:string;SortDirection:TFPListCustomSortDirection);
var
I,J,P:Longint;
PItem,Q:Pointer;
begin
repeat
I:=L;
J:=R;
P:=(L+R)div 2;
repeat
PItem:=FList^[P];
case SortDirection of
sdAscending:
begin
while Compare(PItem,FList^[i],FieldName)>0 do I:=I+1;
while Compare(PItem,FList^[J],FieldName)<0 do J:=J-1;
end;
sdDescending:
begin
while Compare(PItem,FList^[i],FieldName)<0 do I:=I+1;
while Compare(PItem,FList^[J],FieldName)>0 do J:=J-1;
end;
end;
if I<=J then
begin
Q:=FList^[I];
Flist^[I]:=FList^[J];
FList^[J]:=Q;
if P=I then
P:=J
else if P=J then
P:=I;
I:=I+1;
J:=J-1;
end;
until I>J;
if L<J then
CustomQuickSort(FList,L,J,Compare,FieldName,SortDirection);
L:=I;
until I>=R;
end;
procedure TFPListHelper.CustomSort(Compare:TFPListCustomSortCompareFunc; FieldName:string; SortDirection:TFPListCustomSortDirection = sdAscending);
begin
if not assigned(Self.List)or(Count<2) then exit;
CustomQuickSort(Self.List,0,Count-1,Compare,FieldName,SortDirection);
end;
const
tab=#09;
type
TDataClass=class
drInteger:integer;
drFloat:double;
drCharArray:array[0..400] of Char;
drDateTime:TDateTime;
drString:string[100];
end;
var
DataList:TFPList;
DataClass:TDataClass;
procedure CreateDataList(linecnt:integer);
var
i:integer;
begin
random;
for i:=1 to linecnt do
begin
DataClass:=TDataClass.Create;
DataClass.drInteger := i;
DataClass.drFloat := random(10000)*random();
// 1...5...10...15...20...25...30...35...40...45...50
DataClass.drCharArray := 'àààààààààààà '+i.ToString+' àààààààààààààbbbbb' +
'éééééééééééé '+i.ToString+' éééééééééééééfffff';
DataClass.drDateTime := IncMinute(Now+Random(60));
DataClass.drString := 'We don''t use '+IntToStr(i)+' Tééést';
DataList.Add(DataClass);
end;
end;
procedure ShowClassList(sTitle:string='');
var
i:integer;
sline:string;
begin
if sTitle<>'' then writeLn(sTitle+' : ');
for i:=0 to Pred(DataList.Count) do
begin
DataClass:=TDataClass(DataList[i]);
writestr(sline,'');
writestr(sline,sline,DataClass.drInteger.ToString,tab);
writestr(sline,sline,FormatFloat('0.00',DataClass.drFloat),tab);
writestr(sline,sline,DataClass.drCharArray,tab);
writestr(sline,sline,FormatDateTime('dd.mm.yyyy hh:nn:ss',DataClass.drDateTime),tab);
writestr(sline,sline,DataClass.drString);
writeln(sLine);
end;
writeLn('-----------------------------------------------------------');
end;
function DataListSortCompare(item1,item2:pointer;FieldName:string):integer;
begin
result:=0;
case FieldName of
'drInteger': result:=TDataClass(Item1).drInteger-TDataClass(Item2).drInteger;
'drDateTime':result:=CompareDateTime(TDataClass(item1).drDateTime,TDataClass(item2).drDateTime);
end;
end;
begin
DataList:=TFPList.Create;
CreatedataList(4);
DataList.CustomSort(@DataListSortCompare,'drInteger',sdDescending);
ShowClassList('drInteger descend');
DataList.CustomSort(@DataListSortCompare,'drDateTime',sdAscending);
ShowClassList('drDateTime ascend');
DataList.CustomSort(@DataListSortCompare,'drInteger');
ShowClassList('drInteger ascend');
DataList.Free;
end.