Mega Code Archive
QuickSort Source Code
<![CDATA[
Title: QuickSort Source Code
Question: How can i sorting my values?
Answer:
Delphi QSort Source Code
type
{ callback routine types - make sure you declare them as FAR }
{ expected result: 0 if elem[e1] = elem[e2];
0 if elem[e1] elem[e2] }
TCompNdxFunc = function(e1, e2: word): integer;
TSwapNdxFunc = procedure(e1, e2: word);
{ This is the main sorting routine. It is passed the number of elements and the
two callback routines. The first routine is the function that will perform
the comparison between two elements. The second routine is the procedure that
will swap two elements if necessary }
procedure QSort(uNElem: word; FCmp: TCompNdxFunc; FSwap: TSwapNdxFunc);
{ uNElem - number of elements to sort }
procedure qSortHelp(pivotP: word; nElem: word);
label
TailRecursion,
qBreak;
var
leftP, rightP, pivotEnd, pivotTemp, leftTemp: word;
lNum: word;
retval: integer;
begin
TailRecursion:
if (nElem begin
if (nElem = 2) then
begin
rightP := pivotP +1;
if (Fcmp(pivotP, rightP) 0) then Fswap(pivotP, rightP);
end;
exit;
end;
rightP := (nElem -1) + pivotP;
leftP := (nElem shr 1) + pivotP;
{ sort pivot, left, and right elements for "median of 3" }
if (Fcmp(leftP, rightP) 0) then Fswap(leftP, rightP);
if (Fcmp(leftP, pivotP) 0) then Fswap(leftP, pivotP)
else if (Fcmp(pivotP, rightP) 0) then Fswap(pivotP, rightP);
if (nElem = 3) then
begin
Fswap(pivotP, leftP);
exit;
end;
{ now for the classic Horae algorithm }
pivotEnd := pivotP + 1;
leftP := pivotEnd;
repeat
retval := Fcmp(leftP, pivotP);
while (retval begin
if (retval = 0) then
begin
Fswap(leftP, pivotEnd);
Inc(pivotEnd);
end;
if (leftP Inc(leftP)
else
goto qBreak;
retval := Fcmp(leftP, pivotP);
end; {while}
while (leftP begin
retval := Fcmp(pivotP, rightP);
if (retval Dec(rightP)
else
begin
FSwap(leftP, rightP);
if (retval 0) then
begin
Inc(leftP);
Dec(rightP);
end;
break;
end;
end; {while}
until (leftP = rightP);
qBreak:
if (Fcmp(leftP, pivotP) leftTemp := leftP -1;
pivotTemp := pivotP;
while ((pivotTemp = pivotEnd)) do
begin
Fswap(pivotTemp, leftTemp);
Inc(pivotTemp);
Dec(leftTemp);
end; {while}
lNum := (leftP - pivotEnd);
nElem := ((nElem + pivotP) -leftP);
if (nElem begin
qSortHelp(leftP, nElem);
nElem := lNum;
end
else
begin
qSortHelp(pivotP, lNum);
pivotP := leftP;
end;
goto TailRecursion;
end; {qSortHelp }
begin
if (uNElem qSortHelp(1, uNElem);
end; { QSort }
======================================================================
Delphi QSort Example
{This is the user-defined function that will be used to compare the elements}
function SortCompare(e1, e2: word): integer; far;
begin
with MyForm.StringGrid1 do
begin
if (Cells[1, e1] Result := -1
else if (Cells[1, e1] Cells[1, e2]) then
Result := 1
else
Result := 0;
end; {with}
end;
{This is the user-defined function that will be used to swap 2 elements}
procedure SortSwap(e1, e2: word); far;
var
s: string[63]; { must be large enough to contain the longest string in the grid }
i: integer;
begin
with MyForm.StringGrid1 do
for i := 0 to ColCount -1 do
begin
s := Cells[i, e1];
Cells[i, e1] := Cells[i, e2];
Cells[i, e2] := s;
end; {for}
end;
procedure TMyForm.Button1Click(Sender: TObject);
begin
QSort(StringGrid1.RowCount-1, SortCompare, SortSwap);
end;
]]>