type
  TSortArray = array of Integer;



procedure QuickSortWithOrderList(var vSortArray: TSortArray; var vOrderArray:TSortArray);
var
  i: Integer;

  procedure DoQuickSort(vSortArray:TSortArray; vSortOrderArray:TSortArray; start,last:integer);
  var
    tmpCompareIndex,
    tmpSwapIndex,
    tmpCompareValue: integer;

    procedure swapValue(aIndexA, aIndexB: Integer);
    var
      tmpDummyValue: Integer;
    begin
      tmpDummyValue := vSortArray[aIndexA];
      vSortArray[aIndexA] := vSortArray[aIndexB];
      vSortArray[aIndexB] := tmpDummyValue;

      tmpDummyValue := vSortOrderArray[aIndexA];
      vSortOrderArray[aIndexA] := vSortOrderArray[aIndexB];
      vSortOrderArray[aIndexB] := tmpDummyValue;
    end;

  begin
    tmpSwapIndex := (start + last) div 2;

    swapValue(start, tmpSwapIndex);

    tmpCompareValue := vSortArray[start];
    tmpSwapIndex    := start + 1;
    tmpCompareIndex := start + 1;
    while tmpCompareIndex <= last do
    begin
      if vSortArray[tmpCompareIndex] < tmpCompareValue then   	// 降順
      begin
        swapValue(tmpCompareIndex, tmpSwapIndex);
        Inc(tmpSwapIndex);
      end;
      Inc(tmpCompareIndex);
    end;
    Dec(tmpSwapIndex);

    swapValue(start, tmpSwapIndex);

    if tmpSwapIndex-start > 1 then
      DoQuickSort(vSortArray,vSortOrderArray,start,tmpSwapIndex);
    if last-tmpSwapIndex > 1 then
      DoQuickSort(vSortArray,vSortOrderArray,tmpSwapIndex+1,last);
  end;

begin
  SetLength(vOrderArray, Length(vSortArray));
  for i :=0 to Length(vOrderArray) - 1 do
    vOrderArray[i] := i;

  DoQuickSort(vSortArray, vOrderArray, LOW(vSortArray), HIGH(vSortArray));
end;