Próbuję posortować TList metodą TList.Sort(), jednak wywala to Access Violation zawsze wtedy, gdy funkcja porównująca 2 itemy, zwraca co innego, niż 0.
function CompareItems(Item1 : Pointer; Item2 : Pointer):Integer;
begin
Result:=-1;
end;
ContactList.Sort(CompareItems);
Co znowu jest źle?
Musisz porównać dwa Itemy.
Ja to robię tak:
// TFile to klasa odpowiadająca za obsługę plików w moim programie -
// wiec to nieistotne
function SortProc(Item1, Item2: Pointer): Integer;
begin
Result := AnsiCompareStr(AnsiLowerCase(TFile(Item1).FileName),
AnsiLowerCase(TFile(Item2).FileName)
);
end;
List.Sort(@SortProc);
Sortowanie malejące juz chyba sam zrobisz.
Wiem, że muszę zrobić porównywanie. Po prostu uprościłem kod, aby znaleźć błąd. Powinien on źle sortować, ale jednak POWINIEN. A wywala Access Violation, gdy funkcja zwraca coś innego, niż 0.
// Dopisane
Bez sensu, jeśli zwracam wartość AnsiCompareStr, to program się nie wywala i coś się sortuje (choć daleki jestem od nazwania tego kolejnością alfabetyczną), a jak sam daję warunki, to jest źle (choć zwracam to samo, co AnsiCompareStr).
// Dopisane2
Doszedłem w końcu do rozwiązania, debilnego, ale jednak. Nie można wszystkiego porównywać za pomocą ifów (nawet w innej funkcji), niektóre rzeczy trzeba uzyskać za pomocą np. odejmowania (tak zrobiłem porównywanie dwóch liczb). Nie mam pojęcia, dlaczego czasami if przechodzi, a czasmi nie oraz dlaczego czasem -1<>-1... :-|. Problem rozwiązany, ale może ktoś potrafi to wytłumaczyć?
{
When you are working with a TList object and want to
sort the (list) items based on a custom criteria, you
can use the next code...
The following example code sorts the items in a list
in alphabetical order based on their names. It assumes
that the list contains only references to variables of
type TMyListItem, where TMyListItem is defined as:
type
TMyListItem = record
Points : Integer;
Name: string[255];
end;
The CompareNames function performs the comparisons between
objects in the list. The list is sorted when the user
clicks a button.
}
function CompareNames(Item1, Item2: Pointer): Integer;
begin
Result := CompareText((Item1 as TMyListItem).Name,
(Item2 as TMyListItem).Name);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
List1.Sort(@CompareNames);
end;
{
Note: the Sort method needs a pointer to
a custom function (with the signature below)
that indicates how the items are to be ordered.
type
TListSortCompare = function (Item1,
Item2: Pointer): Integer;
Your sorting / comparison function should return
a positive value if Item1 is less than Item2,
0 if they are equal, and a negative value
if Item1 is greater than Item2.
}
to powinno wyjaśnic:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls;
type
PRec =^TRec;
TRec = packed record
Points: Byte;
Name: String[255];
end;
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
UpDown1: TUpDown;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
Bevel1: TBevel;
Button2: TButton;
Button3: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
List: TList;
Procedure DiplayList;
end;
function ComparePoints(Item1, Item2: Pointer):Integer;
function CompareNames(Item1, Item2: Pointer):Integer;
var
Form1: TForm1;
implementation
{$R *.dfm}
function ComparePoints(Item1, Item2: Pointer):Integer;
begin
if PRec(Item1)^.Points=PRec(Item2)^.Points then
Result:=0
else
case PRec(Item1)^.Points>PRec(Item2)^.Points of
True: Result:=(0-1);
False: Result:=1
end;
end;
function CompareNames(Item1, Item2: Pointer):Integer;
var
I:Integer;
begin
if Ord(PRec(Item1)^.Name[0])=Ord(PRec(Item2)^.Name[0]) then
begin
for I:=1 to 255 do
begin
case Ord(PRec(Item1)^.Name[I])>Ord(PRec(Item2)^.Name[I]) of
True:
begin
Result:=(0-1);
Exit;
end;
False:
begin
Result:=1;
end;
end;
end;
Result:=0
end
else
case Ord(PRec(Item1)^.Name[0])>Ord(PRec(Item2)^.Name[0]) of
True: Result:=(0-1);
False: Result:=1;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Rec: PRec;
Name: String[255];
begin
New(Rec);
Rec^.Points:=UpDown1.Position;
Name:=Edit2.Text;
Rec^.Name:=Name;
List.Add(Rec);
end;
procedure TForm1.DiplayList;
var
I:Integer;
S: String;
begin
Memo1.Clear;
Memo1.Lines.BeginUpdate;
for I:=0 to List.Count-1 do
begin
S:=pRec(List.Items[I])^.Name+': '+IntToStr(pRec(List.Items[I])^.Points);
Memo1.Lines.Add(S);
end;
Memo1.Lines.EndUpdate;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
List:=TList.Create;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
List.Sort(@ComparePoints);
DiplayList;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
List.Sort(@CompareNames);
DiplayList;
end;
end.
Działa, ale dość dziwnie. Jeszcze musze popatrzeć jak odbywa się sortowanie...
hmm sortowanie to odbywa się przez QuickSort, a wiec nie powinno być problemów, choć... nic nie wiadomo, a oto jak wygląda sortowanie:
procedure QuickSort(SortList: PPointerList; L, R: Integer;
SCompare: TListSortCompare);
var
I, J: Integer;
P, T: Pointer;
begin
repeat
I := L;
J := R;
P := SortList^[(L + R) shr 1];
repeat
while SCompare(SortList^[I], P) < 0 do
Inc(I);
while SCompare(SortList^[J], P) > 0 do
Dec(J);
if I <= J then
begin
T := SortList^[I];
SortList^[I] := SortList^[J];
SortList^[J] := T;
Inc(I);
Dec(J);
end;
until I > J;
if L < J then
QuickSort(SortList, L, J, SCompare);
L := I;
until I >= R;
end;
procedure TList.Sort(Compare: TListSortCompare);
begin
if (FList <> nil) and (Count > 0) then
QuickSort(FList, 0, Count - 1, Compare);
end;