unit Sort;
interface
uses StrUtils, SysUtils;
type
rPosData =
record
StartPos : Word;
NextPos : Word;
// SubString : String;
end;
arPosData =
Array of rPosData;
type
tSortStringList =
class(TStringList)
private
fSortColumn : Integer;
fPosData : arPosData;
protected
function GetStartPos(s :
String; Delimiter : Char; SortColumn : Integer) : Integer;
function GetNextPos(s :
String; Delimiter : Char; iStartPos : Integer) : Integer;
public
procedure Compare;
published
property SortColumn : Integer
Read FSortColumn
Write fSortColumn
Default 0;
end;
implementation
// Stelle im String ermitteln, ab der sortiert werden soll.
Function TSortStringList.GetStartPos(s :
String; Delimiter : Char; SortColumn : Integer) : Integer;
Var
iCount : Integer;
begin
Result := 0;
for iCount := 1
to SortColumn
Do Result := PosEx(Delimiter,s,Result + 1);
end;
// Länge des zu sortierenden Strings ermitteln.
Function TSortStringList.GetNextPos(s :
String; Delimiter : Char; iStartPos : Integer) : Integer;
begin
Result := PosEx(Delimiter,s,iStartPos);
end;
function MyCompare(List: TStringList; Index1, Index2: Integer): Integer;
Var
iPos : Integer;
// sSubString : String;
begin
Result := 0;
with List
As TSortStringList
do begin
if List.CaseSensitive
then begin
Result := AnsiCompareStr(Copy(List[Index1],
fPosData[Index1].StartPos,
fPosData[Index1].NextPos),
Copy(List[Index2],
fPosData[Index2].StartPos,
fPosData[Index2].NextPos)
);
// Das funktioniert nicht, hat aus irgendeinem Grund keine Auswirkung
// auf die Sortierung, schade, müssen wir beim Copy bleiben.
// Result := AnsiCompareStr(fPosData[Index1].SubString,fPosData[Index2].SubString);
end else begin
Result := AnsiCompareText(Copy(List[Index1],
fPosData[Index1].StartPos,
fPosData[Index1].NextPos),
Copy(List[Index2],
fPosData[Index2].StartPos,
fPosData[Index2].NextPos)
);
// Result := AnsiCompareText(fPosData[Index1].SubString,fPosData[Index2].SubString);
end;
case Result
of
0 : ;
// hier brauchen wir nichts tuten, beide Strings sind gleich
else
iPos := fPosData[Index1].StartPos;
fPosData[Index1].StartPos := fPosData[Index2].StartPos;
fPosData[Index2].StartPos := iPos;
iPos := fPosData[Index1].NextPos;
fPosData[Index1].NextPos := fPosData[Index2].NextPos;
fPosData[Index2].NextPos := iPos;
// sSubString := fPosData[Index1].SubString;
// fPosData[Index1].SubString := fPosData[Index2].SubString;
// fPosData[Index2].SubString := sSubString;
end;
end;
end;
procedure TSortStringList.Compare;
Var
i : Integer;
iPos : Integer;
iPosLast : Integer;
begin
SetLength(fPosData,Self.Count);
for i := 0
To Self.Count - 1
Do begin
iPos := GetStartPos(Self[i],Self.Delimiter,fSortColumn);
if iPos > 0
Then begin
iPosLast := GetNextPos(Self[i],Self.Delimiter,iPos);
fPosData[i].StartPos := iPos;
fPosData[i].NextPos := iPosLast;
// fPosData[i].SubString := Copy(Self[i],iPos, iPosLast - iPos);
end else begin
fPosData[i].StartPos := Length(Self[i]);
fPosData[i].NextPos := Length(Self[i]);
// fPosData[i].SubString := '';
end;
end;
Self.CustomSort(MyCompare);
end;
end.