procedure TMainForm.Button9Click(Sender: TObject);
var
firsttime:longword;
q,w:integer;
curarray:tdoublearray;
begin

firsttime:=GetTickCount;

for q:=0 to 800 do begin

curarray:=tdoublearray.Create;
curarray.Capacity:=10000;
for w:=0 to 9999 do curarray.Add(random);

curarray.QSort1Old;

curarray.Free;
end;//next q

caption:=inttostr(GetTickCount-firsttime);
end;

procedure TDoubleArray.QSort1Old;
var
q:integer;
sumval, midval, tmpval: double;
tmparray1, tmparray2: tdoublearray;
tmp:double;
begin
if count<=1 then exit;
if count=2 then begin
if fitems[1]<fitems[0] then begin tmp:=fitems[1]; fitems[1]:=fitems[0]; fitems[0]:=tmp; end;
exit;
end;
sumval:=0;
for q:=0 to count-1 do sumval:=sumval+fitems[q];
midval:=sumval/count;
tmparray1:=tdoublearray.create;
tmparray1.capacity:=count;
tmparray2:=tdoublearray.create;
tmparray2.capacity:=count;
for q:=0 to count-1 do if fitems[q]>midval then tmparray2.add(fitems[q]) else tmparray1.add(fitems[q]);
tmparray1.QSort1Old;
tmparray2.QSort1Old;
for q:=0 to tmparray1.count-1 do fitems[q]:=tmparray1.fitems[q];
for q:=0 to tmparray2.count-1 do fitems[tmparray1.count+q]:=tmparray2.fitems[q];
tmparray1.free;
tmparray2.free;
end;

procedure TDoubleArray.QSort2GPT;
var
arr:array of double;
q:integer;
procedure QSort(low,high:integer);
var
  i, j: Integer;
  pivot, temp: double;
begin
  i := low;
  j := high;
  pivot := arr[(low + high) div 2];

  repeat
    while arr[i] < pivot do
      Inc(i);
    while arr[j] > pivot do
      Dec(j);

    if i <= j then
    begin
      temp := arr[i];
      arr[i] := arr[j];
      arr[j] := temp;
      Inc(i);
      Dec(j);
    end;
  until i > j;

  if low < j then
    QSort(low, j);
  if i < high then
    QSort(i, high);
end;
begin
setlength(arr,count);
for q:=0 to count-1 do arr[q]:=fitems[q];
qsort(0,count-1);
for q:=0 to count-1 do fitems[q]:=arr[q];
setlength(arr,0);

end;

procedure TDoubleArray.QSort3My;
var
arr1,arr2:array of double;
boolarr:array of boolean;
i:integer;

  procedure DoQSort(intervalbeg,intervallast:integer);
    var
    curcount:integer;
    sumval:double;
    aveval:double;
    ii:integer;
    curvalscount:integer;
    lowvalscount:integer;
    tmpval:double;
  begin
    curcount:=intervallast-intervalbeg+1;
    if curcount<=1 then exit;//Всего один элемент, сортировать не надо
    if curcount=2 then
      begin
      if (arr1[intervalbeg]<arr1[intervallast])<>true then
        begin
        tmpval:=arr1[intervalbeg];
        arr1[intervalbeg]:=arr1[intervallast];
        arr1[intervallast]:=tmpval
        end;
      exit;
      end;

    //Находим среднее значение в нашем интервале:
    sumval:=0;
    for ii:=intervalbeg to intervallast do sumval:=sumval+arr1[ii];
    aveval:=sumval/curcount;


    for ii:=intervalbeg to intervallast do boolarr[ii]:=(arr1[ii]<aveval);

    //Помещаем элементы, меньшие aveval, в первую часть arr2:
    curvalscount:=0;
    for ii:=intervalbeg to intervallast do if boolarr[ii]=true then
      begin
        inc(curvalscount);
        arr2[intervalbeg+curvalscount-1]:=arr1[ii];
      end;

    lowvalscount:=curvalscount;

    if (lowvalscount=0) or (lowvalscount=curcount) then
      exit;//Все элементы в интервале равны, сортировать нельзя


    //Помещаем элементы, большие или равные aveval, в первую часть arr2:
    for ii:=intervalbeg to intervallast do if boolarr[ii]=not true then
      begin
        inc(curvalscount);
        arr2[intervalbeg+curvalscount-1]:=arr1[ii];
      end;

    //Перемещаем arr2 в arr1:
    for ii:=intervalbeg to intervallast do arr1[ii]:=arr2[ii];


    doqsort(intervalbeg,intervalbeg+lowvalscount-1);
    doqsort(intervalbeg+lowvalscount,intervallast);

  end;

begin

  setlength(arr1,fcount);
  setlength(arr2,fcount);
  setlength(boolarr,fcount);

  for i:=0 to fcount-1 do arr1[i]:=fitems^[i];

  doqsort(0,fcount-1);

  for i:=0 to fcount-1 do fitems^[i]:=arr1[i];

  setlength(arr1,0);
  setlength(arr2,0);
  setlength(boolarr,0);

end;