program Sort_Test;
{ demo for using of the qsort function from gpc } { sven@rufus.central.de }
uses grx20;
type TestType = Integer; { works with Real, ShortInt, Integer, LongInt } { crashs with Byte } StrType = String(8); FuncType = ^Function: TestType;
function CompNum(var e1, e2: TestType):Integer; Var r : Real; begin r := e1 - e2; CompNum := Round(r); end;
function CompString(var e1, e2: StrType):Integer; begin if e1 = e2 then CompString := 0 else if e1 > e2 then CompString := 1 else CompString := -1; end;
procedure qsort(var base; numelem, size : Integer; cmp: FuncType); C;
var i : Integer; ta : Array[1..5] of TestType; tb : Array[1..5] of StrType;
begin ta[1] := 4; ta[2] := 2; ta[3] := 1; ta[4] := 3;
for i := 1 to 5 do Writeln(ta[i]);
qsort(ta, 5, Sizeof(ta[1]), @CompNum); Writeln;
for i := 1 to 5 do Writeln(ta[i]); Writeln;
tb[1] := 'Peter'; tb[2] := 'Paul'; tb[3] := 'Mary'; tb[4] := 'Sven'; tb[5] := 'Adam';
qsort(tb, 5, Sizeof(tb[1]), @CompString);
for i := 1 to 5 do Writeln(tb[i]); Writeln; end.