Janilabo

sortingLib Plugin (Example) [Simba]

May 17th, 2013
67
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 72.87 KB | None | 0 0
  1. type
  2.   TSortOrder = (so_LowToHigh, so_HighToLow);
  3.  
  4. type
  5.   TSortAlgorithm = (sa_BubbleSort, sa_HeapSort, sa_InsertionSort,
  6.                     sa_MergeSort, sa_MergeSortBU, sa_SelectionSort,
  7.                     sa_ShellSort, sa_QuickSort, sa_QuickSort3W,
  8.                     sa_JnlbSort, sa_JnlbSortDnmc);
  9.  
  10. function Min(a, b: Integer): Integer;
  11. begin
  12.   case (a < b) of
  13.     True: Result := a;
  14.     False: Result := b;
  15.   end;
  16. end;
  17.  
  18. procedure TIAJnlbSort(var TIA: array of Integer; order: TSortOrder);
  19. var
  20.   a, b, x, i, l, hi, lo, s, tmp: Integer;
  21. begin
  22.   l := Length(TIA);
  23.   if (l > 1) then
  24.   begin
  25.     s := ((l - 1) div 2);
  26.     case order of
  27.       so_LowToHigh:
  28.       for i := 0 to s do
  29.       begin
  30.         lo := i;
  31.         hi := ((l - 1) - i);
  32.         a := lo;
  33.         b := hi;
  34.         if (TIA[hi] < TIA[lo]) then
  35.         begin
  36.           tmp := TIA[hi];
  37.           TIA[hi] := TIA[lo];
  38.           TIA[lo] := tmp;
  39.         end;
  40.         for x := (a + 1) to (b - 1) do
  41.           if (TIA[x] < TIA[lo]) then
  42.             lo := x
  43.           else
  44.             if (TIA[x] > TIA[hi]) then
  45.               hi := x;
  46.         if (lo > a) then
  47.         begin
  48.           tmp := TIA[a];
  49.           TIA[a] := TIA[lo];
  50.           TIA[lo] := tmp;
  51.         end;
  52.         if (hi < b) then
  53.         begin
  54.           tmp := TIA[b];
  55.           TIA[b] := TIA[hi];
  56.           TIA[hi] := tmp;
  57.         end;
  58.       end;
  59.       so_HighToLow:
  60.       for i := 0 to s do
  61.       begin
  62.         lo := i;
  63.         hi := ((l - 1) - i);
  64.         a := lo;
  65.         b := hi;
  66.         if (TIA[hi] > TIA[lo]) then
  67.         begin
  68.           tmp := TIA[hi];
  69.           TIA[hi] := TIA[lo];
  70.           TIA[lo] := tmp;
  71.         end;
  72.         for x := (a + 1) to (b - 1) do
  73.           if (TIA[x] > TIA[lo]) then
  74.             lo := x
  75.           else
  76.             if (TIA[x] < TIA[hi]) then
  77.               hi := x;
  78.         if (lo < a) then
  79.         begin
  80.           tmp := TIA[a];
  81.           TIA[a] := TIA[lo];
  82.           TIA[lo] := tmp;
  83.         end;
  84.         if (hi > b) then
  85.         begin
  86.           tmp := TIA[b];
  87.           TIA[b] := TIA[hi];
  88.           TIA[hi] := tmp;
  89.         end;
  90.       end;
  91.     end;
  92.   end;
  93. end;
  94.  
  95. procedure TSAJnlbSort(var TSA: array of string; order: TSortOrder);
  96. var
  97.   a, b, x, i, l, hi, lo, s: Integer;
  98.   tmp: string;
  99. begin
  100.   l := Length(TSA);
  101.   if (l > 1) then
  102.   begin
  103.     s := ((l - 1) div 2);
  104.     case order of
  105.       so_LowToHigh:
  106.       for i := 0 to s do
  107.       begin
  108.         lo := i;
  109.         hi := ((l - 1) - i);
  110.         a := lo;
  111.         b := hi;
  112.         if (TSA[hi] < TSA[lo]) then
  113.         begin
  114.           tmp := TSA[hi];
  115.           TSA[hi] := TSA[lo];
  116.           TSA[lo] := tmp;
  117.         end;
  118.         for x := (a + 1) to (b - 1) do
  119.           if (TSA[x] < TSA[lo]) then
  120.             lo := x
  121.           else
  122.             if (TSA[x] > TSA[hi]) then
  123.               hi := x;
  124.         if (lo > a) then
  125.         begin
  126.           tmp := TSA[a];
  127.           TSA[a] := TSA[lo];
  128.           TSA[lo] := tmp;
  129.         end;
  130.         if (hi < b) then
  131.         begin
  132.           tmp := TSA[b];
  133.           TSA[b] := TSA[hi];
  134.           TSA[hi] := tmp;
  135.         end;
  136.       end;
  137.       so_HighToLow:
  138.       for i := 0 to s do
  139.       begin
  140.         lo := i;
  141.         hi := ((l - 1) - i);
  142.         a := lo;
  143.         b := hi;
  144.         if (TSA[hi] > TSA[lo]) then
  145.         begin
  146.           tmp := TSA[hi];
  147.           TSA[hi] := TSA[lo];
  148.           TSA[lo] := tmp;
  149.         end;
  150.         for x := (a + 1) to (b - 1) do
  151.           if (TSA[x] > TSA[lo]) then
  152.             lo := x
  153.           else
  154.             if (TSA[x] < TSA[hi]) then
  155.               hi := x;
  156.         if (lo < a) then
  157.         begin
  158.           tmp := TSA[a];
  159.           TSA[a] := TSA[lo];
  160.           TSA[lo] := tmp;
  161.         end;
  162.         if (hi > b) then
  163.         begin
  164.           tmp := TSA[b];
  165.           TSA[b] := TSA[hi];
  166.           TSA[hi] := tmp;
  167.         end;
  168.       end;
  169.     end;
  170.   end;
  171. end;
  172.  
  173. procedure TEAJnlbSort(var TEA: array of Extended; order: TSortOrder);
  174. var
  175.   a, b, x, i, l, hi, lo, s: Integer;
  176.   tmp: Extended;
  177. begin
  178.   l := Length(TEA);
  179.   if (l > 1) then
  180.   begin
  181.     s := ((l - 1) div 2);
  182.     case order of
  183.       so_LowToHigh:
  184.       for i := 0 to s do
  185.       begin
  186.         lo := i;
  187.         hi := ((l - 1) - i);
  188.         a := lo;
  189.         b := hi;
  190.         if (TEA[hi] < TEA[lo]) then
  191.         begin
  192.           tmp := TEA[hi];
  193.           TEA[hi] := TEA[lo];
  194.           TEA[lo] := tmp;
  195.         end;
  196.         for x := (a + 1) to (b - 1) do
  197.           if (TEA[x] < TEA[lo]) then
  198.             lo := x
  199.           else
  200.             if (TEA[x] > TEA[hi]) then
  201.               hi := x;
  202.         if (lo > a) then
  203.         begin
  204.           tmp := TEA[a];
  205.           TEA[a] := TEA[lo];
  206.           TEA[lo] := tmp;
  207.         end;
  208.         if (hi < b) then
  209.         begin
  210.           tmp := TEA[b];
  211.           TEA[b] := TEA[hi];
  212.           TEA[hi] := tmp;
  213.         end;
  214.       end;
  215.       so_HighToLow:
  216.       for i := 0 to s do
  217.       begin
  218.         lo := i;
  219.         hi := ((l - 1) - i);
  220.         a := lo;
  221.         b := hi;
  222.         if (TEA[hi] > TEA[lo]) then
  223.         begin
  224.           tmp := TEA[hi];
  225.           TEA[hi] := TEA[lo];
  226.           TEA[lo] := tmp;
  227.         end;
  228.         for x := (a + 1) to (b - 1) do
  229.           if (TEA[x] > TEA[lo]) then
  230.             lo := x
  231.           else
  232.             if (TEA[x] < TEA[hi]) then
  233.               hi := x;
  234.         if (lo < a) then
  235.         begin
  236.           tmp := TEA[a];
  237.           TEA[a] := TEA[lo];
  238.           TEA[lo] := tmp;
  239.         end;
  240.         if (hi > b) then
  241.         begin
  242.           tmp := TEA[b];
  243.           TEA[b] := TEA[hi];
  244.           TEA[hi] := tmp;
  245.         end;
  246.       end;
  247.     end;
  248.   end;
  249. end;
  250.  
  251. procedure TCAJnlbSort(var TCA: array of Char; order: TSortOrder);
  252. var
  253.   a, b, x, i, l, hi, lo, s: Integer;
  254.   t: Char;
  255. begin
  256.   l := Length(TCA);
  257.   if (l > 1) then
  258.   begin
  259.     s := ((l - 1) div 2);
  260.     case order of
  261.       so_LowToHigh:
  262.       for i := 0 to s do
  263.       begin
  264.         lo := i;
  265.         hi := ((l - 1) - i);
  266.         a := lo;
  267.         b := hi;
  268.         if (TCA[hi] < TCA[lo]) then
  269.         begin
  270.           t := TCA[hi];
  271.           TCA[hi] := TCA[lo];
  272.           TCA[lo] := t;
  273.         end;
  274.         for x := (a + 1) to (b - 1) do
  275.           if (TCA[x] < TCA[lo]) then
  276.             lo := x
  277.           else
  278.             if (TCA[x] > TCA[hi]) then
  279.               hi := x;
  280.         if (lo > a) then
  281.         begin
  282.           t := TCA[a];
  283.           TCA[a] := TCA[lo];
  284.           TCA[lo] := t;
  285.         end;
  286.         if (hi < b) then
  287.         begin
  288.           t := TCA[b];
  289.           TCA[b] := TCA[hi];
  290.           TCA[hi] := t;
  291.         end;
  292.       end;
  293.       so_HighToLow:
  294.       for i := 0 to s do
  295.       begin
  296.         lo := i;
  297.         hi := ((l - 1) - i);
  298.         a := lo;
  299.         b := hi;
  300.         if (TCA[hi] > TCA[lo]) then
  301.         begin
  302.           t := TCA[hi];
  303.           TCA[hi] := TCA[lo];
  304.           TCA[lo] := t;
  305.         end;
  306.         for x := (a + 1) to (b - 1) do
  307.           if (TCA[x] > TCA[lo]) then
  308.             lo := x
  309.           else
  310.             if (TCA[x] < TCA[hi]) then
  311.               hi := x;
  312.         if (lo < a) then
  313.         begin
  314.           t := TCA[a];
  315.           TCA[a] := TCA[lo];
  316.           TCA[lo] := t;
  317.         end;
  318.         if (hi > b) then
  319.         begin
  320.           t := TCA[b];
  321.           TCA[b] := TCA[hi];
  322.           TCA[hi] := t;
  323.         end;
  324.       end;
  325.     end;
  326.   end;
  327. end;
  328.  
  329. procedure TIAJnlbSortDnmc(var TIA: array of Integer; order: TSortOrder);
  330. var
  331.   a, b, x, i, l, s, tmp: Integer;
  332. begin
  333.   l := Length(TIA);
  334.   if (l > 1) then
  335.   begin
  336.     s := ((l - 1) div 2);
  337.     case order of
  338.       so_LowToHigh:
  339.       for i := 0 to s do
  340.       begin
  341.         a := i;
  342.         b := ((l - 1) - i);
  343.         if (TIA[b] < TIA[a]) then
  344.         begin
  345.           tmp := TIA[b];
  346.           TIA[b] := TIA[a];
  347.           TIA[a] := tmp;
  348.         end;
  349.         for x := (a + 1) to (b - 1) do
  350.           if (TIA[x] < TIA[a]) then
  351.           begin
  352.             tmp := TIA[x];
  353.             TIA[x] := TIA[a];
  354.             TIA[a] := tmp;
  355.           end else
  356.             if (TIA[x] > TIA[b]) then
  357.             begin
  358.               tmp := TIA[x];
  359.               TIA[x] := TIA[b];
  360.               TIA[b] := tmp;
  361.             end;
  362.       end;
  363.       so_HighToLow:
  364.       for i := 0 to s do
  365.       begin
  366.         a := i;
  367.         b := ((l - 1) - i);
  368.         if (TIA[a] > TIA[b]) then
  369.         begin
  370.           tmp := TIA[a];
  371.           TIA[a] := TIA[b];
  372.           TIA[b] := tmp;
  373.         end;
  374.         for x := (a + 1) to (b - 1) do
  375.           if (TIA[x] > TIA[a]) then
  376.           begin
  377.             tmp := TIA[x];
  378.             TIA[x] := TIA[a];
  379.             TIA[a] := tmp;
  380.           end else
  381.             if (TIA[x] < TIA[b]) then
  382.             begin
  383.               tmp := TIA[x];
  384.               TIA[x] := TIA[b];
  385.               TIA[b] := tmp;
  386.             end;
  387.       end;
  388.     end;
  389.   end;
  390. end;
  391.  
  392. procedure TSAJnlbSortDnmc(var TSA: array of string; order: TSortOrder);
  393. var
  394.   a, b, x, i, l, s: Integer;
  395.   tmp: string;
  396. begin
  397.   l := Length(TSA);
  398.   if (l > 1) then
  399.   begin
  400.     s := ((l - 1) div 2);
  401.     case order of
  402.       so_LowToHigh:
  403.       for i := 0 to s do
  404.       begin
  405.         a := i;
  406.         b := ((l - 1) - i);
  407.         if (TSA[b] < TSA[a]) then
  408.         begin
  409.           tmp := TSA[b];
  410.           TSA[b] := TSA[a];
  411.           TSA[a] := tmp;
  412.         end;
  413.         for x := (a + 1) to (b - 1) do
  414.           if (TSA[x] < TSA[a]) then
  415.           begin
  416.             tmp := TSA[x];
  417.             TSA[x] := TSA[a];
  418.             TSA[a] := tmp;
  419.           end else
  420.             if (TSA[x] > TSA[b]) then
  421.             begin
  422.               tmp := TSA[x];
  423.               TSA[x] := TSA[b];
  424.               TSA[b] := tmp;
  425.             end;
  426.       end;
  427.       so_HighToLow:
  428.       for i := 0 to s do
  429.       begin
  430.         a := i;
  431.         b := ((l - 1) - i);
  432.         if (TSA[a] > TSA[b]) then
  433.         begin
  434.           tmp := TSA[a];
  435.           TSA[a] := TSA[b];
  436.           TSA[b] := tmp;
  437.         end;
  438.         for x := (a + 1) to (b - 1) do
  439.           if (TSA[x] > TSA[a]) then
  440.           begin
  441.             tmp := TSA[x];
  442.             TSA[x] := TSA[a];
  443.             TSA[a] := tmp;
  444.           end else
  445.             if (TSA[x] < TSA[b]) then
  446.             begin
  447.               tmp := TSA[x];
  448.               TSA[x] := TSA[b];
  449.               TSA[b] := tmp;
  450.             end;
  451.       end;
  452.     end;
  453.   end;
  454. end;
  455.  
  456. procedure TEAJnlbSortDnmc(var TEA: array of Extended; order: TSortOrder);
  457. var
  458.   a, b, x, i, l, s: Integer;
  459.   tmp: Extended;
  460. begin
  461.   l := Length(TEA);
  462.   if (l > 1) then
  463.   begin
  464.     s := ((l - 1) div 2);
  465.     case order of
  466.       so_LowToHigh:
  467.       for i := 0 to s do
  468.       begin
  469.         a := i;
  470.         b := ((l - 1) - i);
  471.         if (TEA[b] < TEA[a]) then
  472.         begin
  473.           tmp := TEA[b];
  474.           TEA[b] := TEA[a];
  475.           TEA[a] := tmp;
  476.         end;
  477.         for x := (a + 1) to (b - 1) do
  478.           if (TEA[x] < TEA[a]) then
  479.           begin
  480.             tmp := TEA[x];
  481.             TEA[x] := TEA[a];
  482.             TEA[a] := tmp;
  483.           end else
  484.             if (TEA[x] > TEA[b]) then
  485.             begin
  486.               tmp := TEA[x];
  487.               TEA[x] := TEA[b];
  488.               TEA[b] := tmp;
  489.             end;
  490.       end;
  491.       so_HighToLow:
  492.       for i := 0 to s do
  493.       begin
  494.         a := i;
  495.         b := ((l - 1) - i);
  496.         if (TEA[a] > TEA[b]) then
  497.         begin
  498.           tmp := TEA[a];
  499.           TEA[a] := TEA[b];
  500.           TEA[b] := tmp;
  501.         end;
  502.         for x := (a + 1) to (b - 1) do
  503.           if (TEA[x] > TEA[a]) then
  504.           begin
  505.             tmp := TEA[x];
  506.             TEA[x] := TEA[a];
  507.             TEA[a] := tmp;
  508.           end else
  509.             if (TEA[x] < TEA[b]) then
  510.             begin
  511.               tmp := TEA[x];
  512.               TEA[x] := TEA[b];
  513.               TEA[b] := tmp;
  514.             end;
  515.       end;
  516.     end;
  517.   end;
  518. end;
  519.  
  520. procedure TCAJnlbSortDnmc(var TCA: array of Char; order: TSortOrder);
  521. var
  522.   a, b, x, i, l, s: Integer;
  523.   t: Char;
  524. begin
  525.   l := Length(TCA);
  526.   if (l > 1) then
  527.   begin
  528.     s := ((l - 1) div 2);
  529.     case order of
  530.       so_LowToHigh:
  531.       for i := 0 to s do
  532.       begin
  533.         a := i;
  534.         b := ((l - 1) - i);
  535.         if (TCA[b] < TCA[a]) then
  536.         begin
  537.           t := TCA[b];
  538.           TCA[b] := TCA[a];
  539.           TCA[a] := t;
  540.         end;
  541.         for x := (a + 1) to (b - 1) do
  542.           if (TCA[x] < TCA[a]) then
  543.           begin
  544.             t := TCA[x];
  545.             TCA[x] := TCA[a];
  546.             TCA[a] := t;
  547.           end else
  548.             if (TCA[x] > TCA[b]) then
  549.             begin
  550.               t := TCA[x];
  551.               TCA[x] := TCA[b];
  552.               TCA[b] := t;
  553.             end;
  554.       end;
  555.       so_HighToLow:
  556.       for i := 0 to s do
  557.       begin
  558.         a := i;
  559.         b := ((l - 1) - i);
  560.         if (TCA[a] > TCA[b]) then
  561.         begin
  562.           t := TCA[a];
  563.           TCA[a] := TCA[b];
  564.           TCA[b] := t;
  565.         end;
  566.         for x := (a + 1) to (b - 1) do
  567.           if (TCA[x] > TCA[a]) then
  568.           begin
  569.             t := TCA[x];
  570.             TCA[x] := TCA[a];
  571.             TCA[a] := t;
  572.           end else
  573.             if (TCA[x] < TCA[b]) then
  574.             begin
  575.               t := TCA[x];
  576.               TCA[x] := TCA[b];
  577.               TCA[b] := t;
  578.             end;
  579.       end;
  580.     end;
  581.   end;
  582. end;
  583.  
  584. procedure TIABubbleSort(var TIA: array of Integer; order: TSortOrder);
  585. var
  586.   a, b, h, tmp: Integer;
  587. begin
  588.   h := High(TIA);
  589.   if (h > 0) then
  590.   case order of
  591.     so_LowToHigh:
  592.     for a := 0 to h do
  593.       for b := 1 to (h - a) do
  594.         if (TIA[(b - 1)] > TIA[b]) then
  595.         begin
  596.           tmp := TIA[(b - 1)];
  597.           TIA[(b - 1)] := TIA[b];
  598.           TIA[b] := tmp;
  599.         end;
  600.     so_HighToLow:
  601.     for a := 0 to h do
  602.       for b := 1 to (h - a) do
  603.         if (TIA[(b - 1)] < TIA[b]) then
  604.         begin
  605.           tmp := TIA[(b - 1)];
  606.           TIA[(b - 1)] := TIA[b];
  607.           TIA[b] := tmp;
  608.         end;
  609.   end;
  610. end;
  611.  
  612. procedure TSABubbleSort(var TSA: array of string; order: TSortOrder);
  613. var
  614.   a, b, h: Integer;
  615.   tmp: string;
  616. begin
  617.   h := High(TSA);
  618.   if (h > 0) then
  619.   case order of
  620.     so_LowToHigh:
  621.     for a := 0 to h do
  622.       for b := 1 to (h - a) do
  623.         if (TSA[(b - 1)] > TSA[b]) then
  624.         begin
  625.           tmp := TSA[(b - 1)];
  626.           TSA[(b - 1)] := TSA[b];
  627.           TSA[b] := tmp;
  628.         end;
  629.     so_HighToLow:
  630.     for a := 0 to h do
  631.       for b := 1 to (h - a) do
  632.         if (TSA[(b - 1)] < TSA[b]) then
  633.         begin
  634.           tmp := TSA[(b - 1)];
  635.           TSA[(b - 1)] := TSA[b];
  636.           TSA[b] := tmp;
  637.         end;
  638.   end;
  639. end;
  640.  
  641. procedure TEABubbleSort(var TEA: array of Extended; order: TSortOrder);
  642. var
  643.   a, b, h: Integer;
  644.   tmp: Extended;
  645. begin
  646.   h := High(TEA);
  647.   if (h > 0) then
  648.   case order of
  649.     so_LowToHigh:
  650.     for a := 0 to h do
  651.       for b := 1 to (h - a) do
  652.         if (TEA[(b - 1)] > TEA[b]) then
  653.         begin
  654.           tmp := TEA[(b - 1)];
  655.           TEA[(b - 1)] := TEA[b];
  656.           TEA[b] := tmp;
  657.         end;
  658.     so_HighToLow:
  659.     for a := 0 to h do
  660.       for b := 1 to (h - a) do
  661.         if (TEA[(b - 1)] < TEA[b]) then
  662.         begin
  663.           tmp := TEA[(b - 1)];
  664.           TEA[(b - 1)] := TEA[b];
  665.           TEA[b] := tmp;
  666.         end;
  667.   end;
  668. end;
  669.  
  670. procedure TCABubbleSort(var TCA: array of Char; order: TSortOrder);
  671. var
  672.   t: Char;
  673.   a, b, h: Integer;
  674. begin
  675.   h := High(TCA);
  676.   if (h > 0) then
  677.   case order of
  678.     so_LowToHigh:
  679.     for a := 0 to h do
  680.       for b := 1 to (h - a) do
  681.         if (TCA[(b - 1)] > TCA[b]) then
  682.         begin
  683.           t := TCA[(b - 1)];
  684.           TCA[(b - 1)] := TCA[b];
  685.           TCA[b] := t;
  686.         end;
  687.     so_HighToLow:
  688.     for a := 0 to h do
  689.       for b := 1 to (h - a) do
  690.         if (TCA[(b - 1)] < TCA[b]) then
  691.         begin
  692.           t := TCA[(b - 1)];
  693.           TCA[(b - 1)] := TCA[b];
  694.           TCA[b] := t;
  695.         end;
  696.   end;
  697. end;
  698.  
  699. procedure TIAInsertionSort(var TIA: array of Integer; order: TSortOrder);
  700. var
  701.   a, b, h, tmp: Integer;
  702. begin
  703.   h := High(TIA);
  704.   if (h > 0) then
  705.   case order of
  706.     so_LowToHigh:
  707.     for a := 1 to h do
  708.       for b := a downto 1 do
  709.       begin
  710.         if not (TIA[b] < TIA[(b - 1)]) then
  711.           Break;
  712.         tmp := TIA[(b - 1)];
  713.         TIA[(b - 1)] := TIA[b];
  714.         TIA[b] := tmp;
  715.       end;
  716.     so_HighToLow:
  717.     for a := 1 to h do
  718.       for b := a downto 1 do
  719.       begin
  720.         if not (TIA[b] > TIA[(b - 1)]) then
  721.           Break;
  722.         tmp := TIA[(b - 1)];
  723.         TIA[(b - 1)] := TIA[b];
  724.         TIA[b] := tmp;
  725.       end;
  726.   end;
  727. end;
  728.  
  729. procedure TSAInsertionSort(var TSA: array of string; order: TSortOrder);
  730. var
  731.   a, b, h: Integer;
  732.   tmp: string;
  733. begin
  734.   h := High(TSA);
  735.   if (h > 0) then
  736.   case order of
  737.     so_LowToHigh:
  738.     for a := 1 to h do
  739.       for b := a downto 1 do
  740.       begin
  741.         if not (TSA[b] < TSA[(b - 1)]) then
  742.           Break;
  743.         tmp := TSA[(b - 1)];
  744.         TSA[(b - 1)] := TSA[b];
  745.         TSA[b] := tmp;
  746.       end;
  747.     so_HighToLow:
  748.     for a := 1 to h do
  749.       for b := a downto 1 do
  750.       begin
  751.         if not (TSA[b] > TSA[(b - 1)]) then
  752.           Break;
  753.         tmp := TSA[(b - 1)];
  754.         TSA[(b - 1)] := TSA[b];
  755.         TSA[b] := tmp;
  756.       end;
  757.   end;
  758. end;
  759.  
  760. procedure TEAInsertionSort(var TEA: array of Extended; order: TSortOrder);
  761. var
  762.   a, b, h: Integer;
  763.   tmp: Extended;
  764. begin
  765.   h := High(TEA);
  766.   if (h > 0) then
  767.   case order of
  768.     so_LowToHigh:
  769.     for a := 1 to h do
  770.       for b := a downto 1 do
  771.       begin
  772.         if not (TEA[b] < TEA[(b - 1)]) then
  773.           Break;
  774.         tmp := TEA[(b - 1)];
  775.         TEA[(b - 1)] := TEA[b];
  776.         TEA[b] := tmp;
  777.       end;
  778.     so_HighToLow:
  779.     for a := 1 to h do
  780.       for b := a downto 1 do
  781.       begin
  782.         if not (TEA[b] > TEA[(b - 1)]) then
  783.           Break;
  784.         tmp := TEA[(b - 1)];
  785.         TEA[(b - 1)] := TEA[b];
  786.         TEA[b] := tmp;
  787.       end;
  788.   end;
  789. end;
  790.  
  791. procedure TCAInsertionSort(var TCA: array of Char; order: TSortOrder);
  792. var
  793.   t: Char;
  794.   a, b, h: Integer;
  795. begin
  796.   h := High(TCA);
  797.   if (h > 0) then
  798.   case order of
  799.     so_LowToHigh:
  800.     for a := 1 to h do
  801.       for b := a downto 1 do
  802.       begin
  803.         if not (TCA[b] < TCA[(b - 1)]) then
  804.           Break;
  805.         t := TCA[(b - 1)];
  806.         TCA[(b - 1)] := TCA[b];
  807.         TCA[b] := t;
  808.       end;
  809.     so_HighToLow:
  810.     for a := 1 to h do
  811.       for b := a downto 1 do
  812.       begin
  813.         if not (TCA[b] > TCA[(b - 1)]) then
  814.           Break;
  815.         t := TCA[(b - 1)];
  816.         TCA[(b - 1)] := TCA[b];
  817.         TCA[b] := t;
  818.       end;
  819.   end;
  820. end;
  821.  
  822. procedure TIAShellSort(var TIA: array of Integer; order: TSortOrder);
  823. var
  824.   x, a, b, l, tmp: Integer;
  825. begin
  826.   l := Length(TIA);
  827.   if (l > 1) then
  828.   begin
  829.     x := 0;
  830.     while (x < (l div 3)) do
  831.       x := ((x * 3) + 1);
  832.     case order of
  833.       so_HighToLow:
  834.       while (x >= 1) do
  835.       begin
  836.         for a := x to (l - 1) do
  837.         begin
  838.           b := a;
  839.           while ((b >= x) and (TIA[b] > TIA[(b - x)])) do
  840.           begin
  841.             tmp := TIA[b];
  842.             TIA[b] := TIA[(b - x)];
  843.             TIA[(b - x)] := tmp;
  844.             b := (b - x);
  845.           end;
  846.         end;
  847.         x := (x div 3);
  848.       end;
  849.       so_LowToHigh:
  850.       while (x >= 1) do
  851.       begin
  852.         for a := x to (l - 1) do
  853.         begin
  854.           b := a;
  855.           while ((b >= x) and (TIA[b] < TIA[(b - x)])) do
  856.           begin
  857.             tmp := TIA[b];
  858.             TIA[b] := TIA[(b - x)];
  859.             TIA[(b - x)] := tmp;
  860.             b := (b - x);
  861.           end;
  862.         end;
  863.         x := (x div 3);
  864.       end;
  865.     end;
  866.   end;
  867. end;
  868.  
  869. procedure TSAShellSort(var TSA: array of string; order: TSortOrder);
  870. var
  871.   x, a, b, l: Integer;
  872.   tmp: string;
  873. begin
  874.   l := Length(TSA);
  875.   if (l > 1) then
  876.   begin
  877.     x := 0;
  878.     while (x < (l div 3)) do
  879.       x := ((x * 3) + 1);
  880.     case order of
  881.       so_HighToLow:
  882.       while (x >= 1) do
  883.       begin
  884.         for a := x to (l - 1) do
  885.         begin
  886.           b := a;
  887.           while ((b >= x) and (TSA[b] > TSA[(b - x)])) do
  888.           begin
  889.             tmp := TSA[b];
  890.             TSA[b] := TSA[(b - x)];
  891.             TSA[(b - x)] := tmp;
  892.             b := (b - x);
  893.           end;
  894.         end;
  895.         x := (x div 3);
  896.       end;
  897.       so_LowToHigh:
  898.       while (x >= 1) do
  899.       begin
  900.         for a := x to (l - 1) do
  901.         begin
  902.           b := a;
  903.           while ((b >= x) and (TSA[b] < TSA[(b - x)])) do
  904.           begin
  905.             tmp := TSA[b];
  906.             TSA[b] := TSA[(b - x)];
  907.             TSA[(b - x)] := tmp;
  908.             b := (b - x);
  909.           end;
  910.         end;
  911.         x := (x div 3);
  912.       end;
  913.     end;
  914.   end;
  915. end;
  916.  
  917. procedure TEAShellSort(var TEA: array of Extended; order: TSortOrder);
  918. var
  919.   x, a, b, l: Integer;
  920.   tmp: Extended;
  921. begin
  922.   l := Length(TEA);
  923.   if (l > 1) then
  924.   begin
  925.     x := 0;
  926.     while (x < (l div 3)) do
  927.       x := ((x * 3) + 1);
  928.     case order of
  929.       so_HighToLow:
  930.       while (x >= 1) do
  931.       begin
  932.         for a := x to (l - 1) do
  933.         begin
  934.           b := a;
  935.           while ((b >= x) and (TEA[b] > TEA[(b - x)])) do
  936.           begin
  937.             tmp := TEA[b];
  938.             TEA[b] := TEA[(b - x)];
  939.             TEA[(b - x)] := tmp;
  940.             b := (b - x);
  941.           end;
  942.         end;
  943.         x := (x div 3);
  944.       end;
  945.       so_LowToHigh:
  946.       while (x >= 1) do
  947.       begin
  948.         for a := x to (l - 1) do
  949.         begin
  950.           b := a;
  951.           while ((b >= x) and (TEA[b] < TEA[(b - x)])) do
  952.           begin
  953.             tmp := TEA[b];
  954.             TEA[b] := TEA[(b - x)];
  955.             TEA[(b - x)] := tmp;
  956.             b := (b - x);
  957.           end;
  958.         end;
  959.         x := (x div 3);
  960.       end;
  961.     end;
  962.   end;
  963. end;
  964.  
  965. procedure TCAShellSort(var TCA: array of Char; order: TSortOrder);
  966. var
  967.   t: Char;
  968.   x, a, b, l: Integer;
  969. begin
  970.   l := Length(TCA);
  971.   if (l > 1) then
  972.   begin
  973.     x := 0;
  974.     while (x < (l div 3)) do
  975.       x := ((x * 3) + 1);
  976.     case order of
  977.       so_HighToLow:
  978.       while (x >= 1) do
  979.       begin
  980.         for a := x to (l - 1) do
  981.         begin
  982.           b := a;
  983.           while ((b >= x) and (TCA[b] > TCA[(b - x)])) do
  984.           begin
  985.             t := TCA[(b - x)];
  986.             TCA[(b - x)] := TCA[b];
  987.             TCA[b] := t;
  988.             b := (b - x);
  989.           end;
  990.         end;
  991.         x := (x div 3);
  992.       end;
  993.       so_LowToHigh:
  994.       while (x >= 1) do
  995.       begin
  996.         for a := x to (l - 1) do
  997.         begin
  998.           b := a;
  999.           while ((b >= x) and (TCA[b] < TCA[(b - x)])) do
  1000.           begin
  1001.             t := TCA[(b - x)];
  1002.             TCA[(b - x)] := TCA[b];
  1003.             TCA[b] := t;
  1004.             b := (b - x);
  1005.           end;
  1006.         end;
  1007.         x := (x div 3);
  1008.       end;
  1009.     end;
  1010.   end;
  1011. end;
  1012.  
  1013. procedure TIASelectionSort(var TIA: array of Integer; order: TSortOrder);
  1014. var
  1015.   c, t, h, m, tmp: Integer;
  1016. begin
  1017.   h := High(TIA);
  1018.   if (h > 0) then
  1019.   case order of
  1020.     so_LowToHigh:
  1021.     for c := 0 to h do
  1022.     begin
  1023.       m := c;
  1024.       for t := (c + 1) to h do
  1025.         if (TIA[m] > TIA[t]) then
  1026.           m := t;
  1027.       tmp := TIA[m];
  1028.       TIA[m] := TIA[c];
  1029.       TIA[c] := tmp;
  1030.     end;
  1031.     so_HighToLow:
  1032.     for c := 0 to h do
  1033.     begin
  1034.       m := c;
  1035.       for t := (c + 1) to h do
  1036.         if (TIA[m] < TIA[t]) then
  1037.           m := t;
  1038.       tmp := TIA[m];
  1039.       TIA[m] := TIA[c];
  1040.       TIA[c] := tmp;
  1041.     end;
  1042.   end;
  1043. end;
  1044.  
  1045. procedure TSASelectionSort(var TSA: array of string; order: TSortOrder);
  1046. var
  1047.   c, t, h, m: Integer;
  1048.   tmp: string;
  1049. begin
  1050.   h := High(TSA);
  1051.   if (h > 0) then
  1052.   case order of
  1053.     so_LowToHigh:
  1054.     for c := 0 to h do
  1055.     begin
  1056.       m := c;
  1057.       for t := (c + 1) to h do
  1058.         if (TSA[m] > TSA[t]) then
  1059.           m := t;
  1060.       tmp := TSA[m];
  1061.       TSA[m] := TSA[c];
  1062.       TSA[c] := tmp;
  1063.     end;
  1064.     so_HighToLow:
  1065.     for c := 0 to h do
  1066.     begin
  1067.       m := c;
  1068.       for t := (c + 1) to h do
  1069.         if (TSA[m] < TSA[t]) then
  1070.           m := t;
  1071.       tmp := TSA[m];
  1072.       TSA[m] := TSA[c];
  1073.       TSA[c] := tmp;
  1074.     end;
  1075.   end;
  1076. end;
  1077.  
  1078. procedure TEASelectionSort(var TEA: array of Extended; order: TSortOrder);
  1079. var
  1080.   c, t, h, m: Integer;
  1081.   tmp: Extended;
  1082. begin
  1083.   h := High(TEA);
  1084.   if (h > 0) then
  1085.   case order of
  1086.     so_LowToHigh:
  1087.     for c := 0 to h do
  1088.     begin
  1089.       m := c;
  1090.       for t := (c + 1) to h do
  1091.         if (TEA[m] > TEA[t]) then
  1092.           m := t;
  1093.       tmp := TEA[m];
  1094.       TEA[m] := TEA[c];
  1095.       TEA[c] := tmp;
  1096.     end;
  1097.     so_HighToLow:
  1098.     for c := 0 to h do
  1099.     begin
  1100.       m := c;
  1101.       for t := (c + 1) to h do
  1102.         if (TEA[m] < TEA[t]) then
  1103.           m := t;
  1104.       tmp := TEA[m];
  1105.       TEA[m] := TEA[c];
  1106.       TEA[c] := tmp;
  1107.     end;
  1108.   end;
  1109. end;
  1110.  
  1111. procedure TCASelectionSort(var TCA: array of Char; order: TSortOrder);
  1112. var
  1113.   c, t, h, m: Integer;
  1114.   z: Char;
  1115. begin
  1116.   h := High(TCA);
  1117.   if (h > 0) then
  1118.   case order of
  1119.     so_LowToHigh:
  1120.     for c := 0 to h do
  1121.     begin
  1122.       m := c;
  1123.       for t := (c + 1) to h do
  1124.         if (TCA[m] > TCA[t]) then
  1125.           m := t;
  1126.       z := TCA[m];
  1127.       TCA[m] := TCA[c];
  1128.       TCA[c] := z;
  1129.     end;
  1130.     so_HighToLow:
  1131.     for c := 0 to h do
  1132.     begin
  1133.       m := c;
  1134.       for t := (c + 1) to h do
  1135.         if (TCA[m] < TCA[t]) then
  1136.           m := t;
  1137.       z := TCA[m];
  1138.       TCA[m] := TCA[c];
  1139.       TCA[c] := z;
  1140.     end;
  1141.   end;
  1142. end;
  1143.  
  1144. procedure TIAHeapSort(var TIA: array of Integer; order: TSortOrder);
  1145. var
  1146.   a, b, r, c, l, tmp: Integer;
  1147. begin
  1148.   l := Length(TIA);
  1149.   if (l > 1) then
  1150.   begin
  1151.     a := ((l - 1) div 2);
  1152.     b := (l - 1);
  1153.     case order of
  1154.       so_LowToHigh:
  1155.       begin
  1156.         while (a >= 0) do
  1157.         begin
  1158.           r := a;
  1159.           while (((r * 2) + 1) <= (l - 1)) do
  1160.           begin
  1161.             c := ((r * 2) + 1);
  1162.             if ((c < (l - 1)) and (TIA[c] < TIA[(c + 1)])) then
  1163.               c := (c + 1);
  1164.             if (TIA[r] < TIA[c]) then
  1165.             begin
  1166.               tmp := TIA[r];
  1167.               TIA[r] := TIA[c];
  1168.               TIA[c] := tmp;
  1169.               r := c;
  1170.             end else
  1171.               Break;
  1172.           end;
  1173.           a := (a - 1);
  1174.         end;
  1175.         while (b > 0) do
  1176.         begin
  1177.           tmp := TIA[b];
  1178.           TIA[b] := TIA[0];
  1179.           TIA[0] := tmp;
  1180.           b := (b - 1);
  1181.           r := 0;
  1182.           while (((r * 2) + 1) <= b) do
  1183.           begin
  1184.             c := ((r * 2) + 1);
  1185.             if ((c < b) and (TIA[c] < TIA[(c + 1)])) then
  1186.               c := (c + 1);
  1187.             if (TIA[r] < TIA[c]) then
  1188.             begin
  1189.               tmp := TIA[r];
  1190.               TIA[r] := TIA[c];
  1191.               TIA[c] := tmp;
  1192.               r := c;
  1193.             end else
  1194.               Break;
  1195.           end;
  1196.         end;
  1197.       end;
  1198.       so_HighToLow:
  1199.       begin
  1200.         while (a >= 0) do
  1201.         begin
  1202.           r := a;
  1203.           while (((r * 2) + 1) <= (l - 1)) do
  1204.           begin
  1205.             c := ((r * 2) + 1);
  1206.             if ((c < (l - 1)) and (TIA[c] > TIA[(c + 1)])) then
  1207.               c := (c + 1);
  1208.             if (TIA[r] > TIA[c]) then
  1209.             begin
  1210.               tmp := TIA[r];
  1211.               TIA[r] := TIA[c];
  1212.               TIA[c] := tmp;
  1213.               r := c;
  1214.             end else
  1215.               Break;
  1216.           end;
  1217.           a := (a - 1);
  1218.         end;
  1219.         while (b > 0) do
  1220.         begin
  1221.           tmp := TIA[b];
  1222.           TIA[b] := TIA[0];
  1223.           TIA[0] := tmp;
  1224.           b := (b - 1);
  1225.           r := 0;
  1226.           while (((r * 2) + 1) <= b) do
  1227.           begin
  1228.             c := ((r * 2) + 1);
  1229.             if ((c < b) and (TIA[c] > TIA[(c + 1)])) then
  1230.               c := (c + 1);
  1231.             if (TIA[r] > TIA[c]) then
  1232.             begin
  1233.               tmp := TIA[r];
  1234.               TIA[r] := TIA[c];
  1235.               TIA[c] := tmp;
  1236.               r := c;
  1237.             end else
  1238.               Break;
  1239.           end;
  1240.         end;
  1241.       end;
  1242.     end;
  1243.   end;
  1244. end;
  1245.  
  1246. procedure TSAHeapSort(var TSA: array of string; order: TSortOrder);
  1247. var
  1248.   a, b, r, c, l: Integer;
  1249.   tmp: string;
  1250. begin
  1251.   l := Length(TSA);
  1252.   if (l > 1) then
  1253.   begin
  1254.     a := ((l - 1) div 2);
  1255.     b := (l - 1);
  1256.     case order of
  1257.       so_LowToHigh:
  1258.       begin
  1259.         while (a >= 0) do
  1260.         begin
  1261.           r := a;
  1262.           while (((r * 2) + 1) <= (l - 1)) do
  1263.           begin
  1264.             c := ((r * 2) + 1);
  1265.             if ((c < (l - 1)) and (TSA[c] < TSA[(c + 1)])) then
  1266.               c := (c + 1);
  1267.             if (TSA[r] < TSA[c]) then
  1268.             begin
  1269.               tmp := TSA[r];
  1270.               TSA[r] := TSA[c];
  1271.               TSA[c] := tmp;
  1272.               r := c;
  1273.             end else
  1274.               Break;
  1275.           end;
  1276.           a := (a - 1);
  1277.         end;
  1278.         while (b > 0) do
  1279.         begin
  1280.           tmp := TSA[b];
  1281.           TSA[b] := TSA[0];
  1282.           TSA[0] := tmp;
  1283.           b := (b - 1);
  1284.           r := 0;
  1285.           while (((r * 2) + 1) <= b) do
  1286.           begin
  1287.             c := ((r * 2) + 1);
  1288.             if ((c < b) and (TSA[c] < TSA[(c + 1)])) then
  1289.               c := (c + 1);
  1290.             if (TSA[r] < TSA[c]) then
  1291.             begin
  1292.               tmp := TSA[r];
  1293.               TSA[r] := TSA[c];
  1294.               TSA[c] := tmp;
  1295.               r := c;
  1296.             end else
  1297.               Break;
  1298.           end;
  1299.         end;
  1300.       end;
  1301.       so_HighToLow:
  1302.       begin
  1303.         while (a >= 0) do
  1304.         begin
  1305.           r := a;
  1306.           while (((r * 2) + 1) <= (l - 1)) do
  1307.           begin
  1308.             c := ((r * 2) + 1);
  1309.             if ((c < (l - 1)) and (TSA[c] > TSA[(c + 1)])) then
  1310.               c := (c + 1);
  1311.             if (TSA[r] > TSA[c]) then
  1312.             begin
  1313.               tmp := TSA[r];
  1314.               TSA[r] := TSA[c];
  1315.               TSA[c] := tmp;
  1316.               r := c;
  1317.             end else
  1318.               Break;
  1319.           end;
  1320.           a := (a - 1);
  1321.         end;
  1322.         while (b > 0) do
  1323.         begin
  1324.           tmp := TSA[b];
  1325.           TSA[b] := TSA[0];
  1326.           TSA[0] := tmp;
  1327.           b := (b - 1);
  1328.           r := 0;
  1329.           while (((r * 2) + 1) <= b) do
  1330.           begin
  1331.             c := ((r * 2) + 1);
  1332.             if ((c < b) and (TSA[c] > TSA[(c + 1)])) then
  1333.               c := (c + 1);
  1334.             if (TSA[r] > TSA[c]) then
  1335.             begin
  1336.               tmp := TSA[r];
  1337.               TSA[r] := TSA[c];
  1338.               TSA[c] := tmp;
  1339.               r := c;
  1340.             end else
  1341.               Break;
  1342.           end;
  1343.         end;
  1344.       end;
  1345.     end;
  1346.   end;
  1347. end;
  1348.  
  1349. procedure TEAHeapSort(var TEA: array of Extended; order: TSortOrder);
  1350. var
  1351.   a, b, r, c, l: Integer;
  1352.   tmp: Extended;
  1353. begin
  1354.   l := Length(TEA);
  1355.   if (l > 1) then
  1356.   begin
  1357.     a := ((l - 1) div 2);
  1358.     b := (l - 1);
  1359.     case order of
  1360.       so_LowToHigh:
  1361.       begin
  1362.         while (a >= 0) do
  1363.         begin
  1364.           r := a;
  1365.           while (((r * 2) + 1) <= (l - 1)) do
  1366.           begin
  1367.             c := ((r * 2) + 1);
  1368.             if ((c < (l - 1)) and (TEA[c] < TEA[(c + 1)])) then
  1369.               c := (c + 1);
  1370.             if (TEA[r] < TEA[c]) then
  1371.             begin
  1372.               tmp := TEA[r];
  1373.               TEA[r] := TEA[c];
  1374.               TEA[c] := tmp;
  1375.               r := c;
  1376.             end else
  1377.               Break;
  1378.           end;
  1379.           a := (a - 1);
  1380.         end;
  1381.         while (b > 0) do
  1382.         begin
  1383.           tmp := TEA[b];
  1384.           TEA[b] := TEA[0];
  1385.           TEA[0] := tmp;
  1386.           b := (b - 1);
  1387.           r := 0;
  1388.           while (((r * 2) + 1) <= b) do
  1389.           begin
  1390.             c := ((r * 2) + 1);
  1391.             if ((c < b) and (TEA[c] < TEA[(c + 1)])) then
  1392.               c := (c + 1);
  1393.             if (TEA[r] < TEA[c]) then
  1394.             begin
  1395.               tmp := TEA[r];
  1396.               TEA[r] := TEA[c];
  1397.               TEA[c] := tmp;
  1398.               r := c;
  1399.             end else
  1400.               Break;
  1401.           end;
  1402.         end;
  1403.       end;
  1404.       so_HighToLow:
  1405.       begin
  1406.         while (a >= 0) do
  1407.         begin
  1408.           r := a;
  1409.           while (((r * 2) + 1) <= (l - 1)) do
  1410.           begin
  1411.             c := ((r * 2) + 1);
  1412.             if ((c < (l - 1)) and (TEA[c] > TEA[(c + 1)])) then
  1413.               c := (c + 1);
  1414.             if (TEA[r] > TEA[c]) then
  1415.             begin
  1416.               tmp := TEA[r];
  1417.               TEA[r] := TEA[c];
  1418.               TEA[c] := tmp;
  1419.               r := c;
  1420.             end else
  1421.               Break;
  1422.           end;
  1423.           a := (a - 1);
  1424.         end;
  1425.         while (b > 0) do
  1426.         begin
  1427.           tmp := TEA[b];
  1428.           TEA[b] := TEA[0];
  1429.           TEA[0] := tmp;
  1430.           b := (b - 1);
  1431.           r := 0;
  1432.           while (((r * 2) + 1) <= b) do
  1433.           begin
  1434.             c := ((r * 2) + 1);
  1435.             if ((c < b) and (TEA[c] > TEA[(c + 1)])) then
  1436.               c := (c + 1);
  1437.             if (TEA[r] > TEA[c]) then
  1438.             begin
  1439.               tmp := TEA[r];
  1440.               TEA[r] := TEA[c];
  1441.               TEA[c] := tmp;
  1442.               r := c;
  1443.             end else
  1444.               Break;
  1445.           end;
  1446.         end;
  1447.       end;
  1448.     end;
  1449.   end;
  1450. end;
  1451.  
  1452. procedure TCAHeapSort(var TCA: array of Char; order: TSortOrder);
  1453. var
  1454.   a, b, r, c, l: Integer;
  1455.   t: Char;
  1456. begin
  1457.   l := Length(TCA);
  1458.   if (l > 1) then
  1459.   begin
  1460.     a := ((l - 1) div 2);
  1461.     b := (l - 1);
  1462.     case order of
  1463.       so_LowToHigh:
  1464.       begin
  1465.         while (a >= 0) do
  1466.         begin
  1467.           r := a;
  1468.           while (((r * 2) + 1) <= (l - 1)) do
  1469.           begin
  1470.             c := ((r * 2) + 1);
  1471.             if ((c < (l - 1)) and (TCA[c] < TCA[(c + 1)])) then
  1472.               c := (c + 1);
  1473.             if (TCA[r] < TCA[c]) then
  1474.             begin
  1475.               t := TCA[r];
  1476.               TCA[r] := TCA[c];
  1477.               TCA[c] := t;
  1478.               r := c;
  1479.             end else
  1480.               Break;
  1481.           end;
  1482.           a := (a - 1);
  1483.         end;
  1484.         while (b > 0) do
  1485.         begin
  1486.           t := TCA[b];
  1487.           TCA[b] := TCA[0];
  1488.           TCA[0] := t;
  1489.           b := (b - 1);
  1490.           r := 0;
  1491.           while (((r * 2) + 1) <= b) do
  1492.           begin
  1493.             c := ((r * 2) + 1);
  1494.             if ((c < b) and (TCA[c] < TCA[(c + 1)])) then
  1495.               c := (c + 1);
  1496.             if (TCA[r] < TCA[c]) then
  1497.             begin
  1498.               t := TCA[r];
  1499.               TCA[r] := TCA[c];
  1500.               TCA[c] := t;
  1501.               r := c;
  1502.             end else
  1503.               Break;
  1504.           end;
  1505.         end;
  1506.       end;
  1507.       so_HighToLow:
  1508.       begin
  1509.         while (a >= 0) do
  1510.         begin
  1511.           r := a;
  1512.           while (((r * 2) + 1) <= (l - 1)) do
  1513.           begin
  1514.             c := ((r * 2) + 1);
  1515.             if ((c < (l - 1)) and (TCA[c] > TCA[(c + 1)])) then
  1516.               c := (c + 1);
  1517.             if (TCA[r] > TCA[c]) then
  1518.             begin
  1519.               t := TCA[r];
  1520.               TCA[r] := TCA[c];
  1521.               TCA[c] := t;
  1522.               r := c;
  1523.             end else
  1524.               Break;
  1525.           end;
  1526.           a := (a - 1);
  1527.         end;
  1528.         while (b > 0) do
  1529.         begin
  1530.           t := TCA[b];
  1531.           TCA[b] := TCA[0];
  1532.           TCA[0] := t;
  1533.           b := (b - 1);
  1534.           r := 0;
  1535.           while (((r * 2) + 1) <= b) do
  1536.           begin
  1537.             c := ((r * 2) + 1);
  1538.             if ((c < b) and (TCA[c] > TCA[(c + 1)])) then
  1539.               c := (c + 1);
  1540.             if (TCA[r] > TCA[c]) then
  1541.             begin
  1542.               t := TCA[r];
  1543.               TCA[r] := TCA[c];
  1544.               TCA[c] := t;
  1545.               r := c;
  1546.             end else
  1547.               Break;
  1548.           end;
  1549.         end;
  1550.       end;
  1551.     end;
  1552.   end;
  1553. end;
  1554.  
  1555. procedure __TIA_LH_QS(TIA: array of Integer; Lo, Hi: Integer);
  1556. var
  1557.   L, R, v, m, tmp: Integer;
  1558. begin
  1559.   if (Lo >= Hi) then
  1560.     Exit;
  1561.   v := TIA[Lo];
  1562.   L := Lo;
  1563.   R := (Hi + 1);
  1564.   while True do
  1565.   begin
  1566.     repeat
  1567.       Inc(L);
  1568.       if ((v < TIA[L]) or (L = Hi)) then
  1569.         Break;
  1570.     until False;
  1571.     repeat
  1572.       Dec(R);
  1573.       if ((v > TIA[R]) or (R = Lo)) then
  1574.         Break;
  1575.     until False;
  1576.     if (L >= R) then
  1577.       Break;
  1578.     tmp := TIA[L];
  1579.     TIA[L] := TIA[R];
  1580.     TIA[R] := tmp;
  1581.   end;
  1582.   tmp := TIA[R];
  1583.   TIA[R] := TIA[Lo];
  1584.   TIA[Lo] := tmp;
  1585.   m := R;
  1586.   __TIA_LH_QS(TIA, Lo, (m - 1));
  1587.   __TIA_LH_QS(TIA, (m + 1), Hi);
  1588. end;
  1589.  
  1590. procedure __TIA_HL_QS(TIA: array of Integer; Lo, Hi: Integer);
  1591. var
  1592.   L, R, v, m, tmp: Integer;
  1593. begin
  1594.   if (Lo >= Hi) then
  1595.     Exit;
  1596.   v := TIA[Lo];
  1597.   L := Lo;
  1598.   R := (Hi + 1);
  1599.   while True do
  1600.   begin
  1601.     repeat
  1602.       Inc(L);
  1603.       if ((v > TIA[L]) or (L = Hi)) then
  1604.         Break;
  1605.     until False;
  1606.     repeat
  1607.       Dec(R);
  1608.       if ((v < TIA[R]) or (R = Lo)) then
  1609.         Break;
  1610.     until False;
  1611.     if (L >= R) then
  1612.       Break;
  1613.     tmp := TIA[L];
  1614.     TIA[L] := TIA[R];
  1615.     TIA[R] := tmp;
  1616.   end;
  1617.   tmp := TIA[R];
  1618.   TIA[R] := TIA[Lo];
  1619.   TIA[Lo] := tmp;
  1620.   m := R;
  1621.   __TIA_HL_QS(TIA, Lo, (m - 1));
  1622.   __TIA_HL_QS(TIA, (m + 1), Hi);
  1623. end;
  1624.  
  1625. procedure __TEA_LH_QS(TEA: array of Extended; Lo, Hi: Integer);
  1626. var
  1627.   L, R, m: Integer;
  1628.   v, tmp: Extended;
  1629. begin
  1630.   if (Lo >= Hi) then
  1631.     Exit;
  1632.   v := TEA[Lo];
  1633.   L := Lo;
  1634.   R := (Hi + 1);
  1635.   while True do
  1636.   begin
  1637.     repeat
  1638.       Inc(L);
  1639.       if ((v < TEA[L]) or (L = Hi)) then
  1640.         Break;
  1641.     until False;
  1642.     repeat
  1643.       Dec(R);
  1644.       if ((v > TEA[R]) or (R = Lo)) then
  1645.         Break;
  1646.     until False;
  1647.     if (L >= R) then
  1648.       Break;
  1649.     tmp := TEA[L];
  1650.     TEA[L] := TEA[R];
  1651.     TEA[R] := tmp;
  1652.   end;
  1653.   tmp := TEA[R];
  1654.   TEA[R] := TEA[Lo];
  1655.   TEA[Lo] := tmp;
  1656.   m := R;
  1657.   __TEA_LH_QS(TEA, Lo, (m - 1));
  1658.   __TEA_LH_QS(TEA, (m + 1), Hi);
  1659. end;
  1660.  
  1661. procedure __TEA_HL_QS(TEA: array of Extended; Lo, Hi: Integer);
  1662. var
  1663.   L, R, m: Integer;
  1664.   v, tmp: Extended;
  1665. begin
  1666.   if (Lo >= Hi) then
  1667.     Exit;
  1668.   v := TEA[Lo];
  1669.   L := Lo;
  1670.   R := (Hi + 1);
  1671.   while True do
  1672.   begin
  1673.     repeat
  1674.       Inc(L);
  1675.       if ((v > TEA[L]) or (L = Hi)) then
  1676.         Break;
  1677.     until False;
  1678.     repeat
  1679.       Dec(R);
  1680.       if ((v < TEA[R]) or (R = Lo)) then
  1681.         Break;
  1682.     until False;
  1683.     if (L >= R) then
  1684.       Break;
  1685.     tmp := TEA[L];
  1686.     TEA[L] := TEA[R];
  1687.     TEA[R] := tmp;
  1688.   end;
  1689.   tmp := TEA[R];
  1690.   TEA[R] := TEA[Lo];
  1691.   TEA[Lo] := tmp;
  1692.   m := R;
  1693.   __TEA_HL_QS(TEA, Lo, (m - 1));
  1694.   __TEA_HL_QS(TEA, (m + 1), Hi);
  1695. end;
  1696.  
  1697. procedure __TSA_LH_QS(TSA: array of string; Lo, Hi: Integer);
  1698. var
  1699.   L, R, m: Integer;
  1700.   v, tmp: string;
  1701. begin
  1702.   if (Lo >= Hi) then
  1703.     Exit;
  1704.   v := TSA[Lo];
  1705.   L := Lo;
  1706.   R := (Hi + 1);
  1707.   while True do
  1708.   begin
  1709.     repeat
  1710.       Inc(L);
  1711.       if ((v < TSA[L]) or (L = Hi)) then
  1712.         Break;
  1713.     until False;
  1714.     repeat
  1715.       Dec(R);
  1716.       if ((v > TSA[R]) or (R = Lo)) then
  1717.         Break;
  1718.     until False;
  1719.     if (L >= R) then
  1720.       Break;
  1721.     tmp := TSA[L];
  1722.     TSA[L] := TSA[R];
  1723.     TSA[R] := tmp;
  1724.   end;
  1725.   tmp := TSA[R];
  1726.   TSA[R] := TSA[Lo];
  1727.   TSA[Lo] := tmp;
  1728.   m := R;
  1729.   __TSA_LH_QS(TSA, Lo, (m - 1));
  1730.   __TSA_LH_QS(TSA, (m + 1), Hi);
  1731. end;
  1732.  
  1733. procedure __TSA_HL_QS(TSA: array of string; Lo, Hi: Integer);
  1734. var
  1735.   L, R, m: Integer;
  1736.   v, tmp: string;
  1737. begin
  1738.   if (Lo >= Hi) then
  1739.     Exit;
  1740.   v := TSA[Lo];
  1741.   L := Lo;
  1742.   R := (Hi + 1);
  1743.   while True do
  1744.   begin
  1745.     repeat
  1746.       Inc(L);
  1747.       if ((v > TSA[L]) or (L = Hi)) then
  1748.         Break;
  1749.     until False;
  1750.     repeat
  1751.       Dec(R);
  1752.       if ((v < TSA[R]) or (R = Lo)) then
  1753.         Break;
  1754.     until False;
  1755.     if (L >= R) then
  1756.       Break;
  1757.     tmp := TSA[L];
  1758.     TSA[L] := TSA[R];
  1759.     TSA[R] := tmp;
  1760.   end;
  1761.   tmp := TSA[R];
  1762.   TSA[R] := TSA[Lo];
  1763.   TSA[Lo] := tmp;
  1764.   m := R;
  1765.   __TSA_HL_QS(TSA, Lo, (m - 1));
  1766.   __TSA_HL_QS(TSA, (m + 1), Hi);
  1767. end;
  1768.  
  1769. procedure __TCA_LH_QS(TCA: array of Char; Lo, Hi: Integer);
  1770. var
  1771.   L, R, m: Integer;
  1772.   v, t: char;
  1773. begin
  1774.   if (Lo >= Hi) then
  1775.     Exit;
  1776.   v := TCA[Lo];
  1777.   L := Lo;
  1778.   R := (Hi + 1);
  1779.   while True do
  1780.   begin
  1781.     repeat
  1782.       Inc(L);
  1783.       if ((v < TCA[L]) or (L = Hi)) then
  1784.         Break;
  1785.     until False;
  1786.     repeat
  1787.       Dec(R);
  1788.       if ((v > TCA[R]) or (R = Lo)) then
  1789.         Break;
  1790.     until False;
  1791.     if (L >= R) then
  1792.       Break;
  1793.     t := TCA[L];
  1794.     TCA[L] := TCA[R];
  1795.     TCA[R] := t;
  1796.   end;
  1797.   t := TCA[R];
  1798.   TCA[R] := TCA[Lo];
  1799.   TCA[Lo] := t;
  1800.   m := R;
  1801.   __TCA_LH_QS(TCA, Lo, (m - 1));
  1802.   __TCA_LH_QS(TCA, (m + 1), Hi);
  1803. end;
  1804.  
  1805. procedure __TCA_HL_QS(TCA: array of Char; Lo, Hi: Integer);
  1806. var
  1807.   L, R, m: Integer;
  1808.   v, t: Char;
  1809. begin
  1810.   if (Lo >= Hi) then
  1811.     Exit;
  1812.   v := TCA[Lo];
  1813.   L := Lo;
  1814.   R := (Hi + 1);
  1815.   while True do
  1816.   begin
  1817.     repeat
  1818.       Inc(L);
  1819.       if ((v > TCA[L]) or (L = Hi)) then
  1820.         Break;
  1821.     until False;
  1822.     repeat
  1823.       Dec(R);
  1824.       if ((v < TCA[R]) or (R = Lo)) then
  1825.         Break;
  1826.     until False;
  1827.     if (L >= R) then
  1828.       Break;
  1829.     t := TCA[L];
  1830.     TCA[L] := TCA[R];
  1831.     TCA[R] := t;
  1832.   end;
  1833.   t := TCA[R];
  1834.   TCA[R] := TCA[Lo];
  1835.   TCA[Lo] := t;
  1836.   m := R;
  1837.   __TCA_HL_QS(TCA, Lo, (m - 1));
  1838.   __TCA_HL_QS(TCA, (m + 1), Hi);
  1839. end;
  1840.  
  1841. procedure TIAQuickSort(TIA: array of Integer; order: TSortOrder);
  1842. var
  1843.   h: Integer;
  1844. begin
  1845.   h := High(TIA);
  1846.   if (h > 0) then
  1847.   case order of
  1848.     so_LowToHigh: __TIA_LH_QS(TIA, 0, h);
  1849.     so_HighToLow: __TIA_HL_QS(TIA, 0, h);
  1850.   end;
  1851. end;
  1852.  
  1853. procedure TSAQuickSort(TSA: array of string; order: TSortOrder);
  1854. var
  1855.   h: Integer;
  1856. begin
  1857.   h := High(TSA);
  1858.   if (h > 0) then
  1859.   case order of
  1860.     so_LowToHigh: __TSA_LH_QS(TSA, 0, h);
  1861.     so_HighToLow: __TSA_HL_QS(TSA, 0, h);
  1862.   end;
  1863. end;
  1864.  
  1865. procedure TEAQuickSort(TEA: array of Extended; order: TSortOrder);
  1866. var
  1867.   h: Integer;
  1868. begin
  1869.   h := High(TEA);
  1870.   if (h > 0) then
  1871.   case order of
  1872.     so_LowToHigh: __TEA_LH_QS(TEA, 0, h);
  1873.     so_HighToLow: __TEA_HL_QS(TEA, 0, h);
  1874.   end;
  1875. end;
  1876.  
  1877. procedure TCAQuickSort(TCA: array of Char; order: TSortOrder);
  1878. var
  1879.   h: Integer;
  1880. begin
  1881.   h := High(TCA);
  1882.   if (h > 0) then
  1883.   case order of
  1884.     so_LowToHigh: __TCA_LH_QS(TCA, 0, h);
  1885.     so_HighToLow: __TCA_HL_QS(TCA, 0, h);
  1886.   end;
  1887. end;
  1888.  
  1889. procedure __TSA_HL_QS3W(var TSA: array of string; const L, H: Integer);
  1890. var
  1891.   ls, rs, p: Integer;
  1892.   x, tmp: string;
  1893. begin
  1894.   if (L >= H) then
  1895.     Exit;
  1896.   x := TSA[L];
  1897.   ls := L;
  1898.   rs := H;
  1899.   p := (L + 1);
  1900.   while (p <= rs) do
  1901.     if (TSA[p] > x) then
  1902.     begin
  1903.       tmp := TSA[ls];
  1904.       TSA[ls] := TSA[p];
  1905.       TSA[p] := tmp;
  1906.       Inc(p);
  1907.       Inc(ls);
  1908.     end else
  1909.     if (TSA[p] < x) then
  1910.     begin
  1911.       tmp := TSA[rs];
  1912.       TSA[rs] := TSA[p];
  1913.       TSA[p] := tmp;
  1914.       Dec(rs);
  1915.     end else
  1916.       Inc(p);
  1917.   __TSA_HL_QS3W(TSA, L, (ls - 1));
  1918.   __TSA_HL_QS3W(TSA, (rs + 1), H);
  1919. end;
  1920.  
  1921. procedure __TSA_LH_QS3W(var TSA: array of string; const L, H: Integer);
  1922. var
  1923.   ls, rs, p: Integer;
  1924.   x, tmp: string;
  1925. begin
  1926.   if (L >= H) then
  1927.     Exit;
  1928.   x := TSA[L];
  1929.   ls := L;
  1930.   rs := H;
  1931.   p := (L + 1);
  1932.   while (p <= rs) do
  1933.     if (TSA[p] < x) then
  1934.     begin
  1935.       tmp := TSA[ls];
  1936.       TSA[ls] := TSA[p];
  1937.       TSA[p] := tmp;
  1938.       Inc(p);
  1939.       Inc(ls);
  1940.     end else
  1941.     if (TSA[p] > x) then
  1942.     begin
  1943.       tmp := TSA[rs];
  1944.       TSA[rs] := TSA[p];
  1945.       TSA[p] := tmp;
  1946.       Dec(rs);
  1947.     end else
  1948.       Inc(p);
  1949.   __TSA_LH_QS3W(TSA, L, (ls - 1));
  1950.   __TSA_LH_QS3W(TSA, (rs + 1), H);
  1951. end;
  1952.  
  1953. procedure __TEA_HL_QS3W(var TEA: array of Extended; const L, H: Integer);
  1954. var
  1955.   ls, rs, p: Integer;
  1956.   x, tmp: Extended;
  1957. begin
  1958.   if (L >= H) then
  1959.     Exit;
  1960.   x := TEA[L];
  1961.   ls := L;
  1962.   rs := H;
  1963.   p := (L + 1);
  1964.   while (p <= rs) do
  1965.     if (TEA[p] > x) then
  1966.     begin
  1967.       tmp := TEA[ls];
  1968.       TEA[ls] := TEA[p];
  1969.       TEA[p] := tmp;
  1970.       Inc(p);
  1971.       Inc(ls);
  1972.     end else
  1973.     if (TEA[p] < x) then
  1974.     begin
  1975.       tmp := TEA[rs];
  1976.       TEA[rs] := TEA[p];
  1977.       TEA[p] := tmp;
  1978.       Dec(rs);
  1979.     end else
  1980.       Inc(p);
  1981.   __TEA_HL_QS3W(TEA, L, (ls - 1));
  1982.   __TEA_HL_QS3W(TEA, (rs + 1), H);
  1983. end;
  1984.  
  1985. procedure __TEA_LH_QS3W(var TEA: array of Extended; const L, H: Integer);
  1986. var
  1987.   ls, rs, p: Integer;
  1988.   x, tmp: Extended;
  1989. begin
  1990.   if (L >= H) then
  1991.     Exit;
  1992.   x := TEA[L];
  1993.   ls := L;
  1994.   rs := H;
  1995.   p := (L + 1);
  1996.   while (p <= rs) do
  1997.     if (TEA[p] < x) then
  1998.     begin
  1999.       tmp := TEA[ls];
  2000.       TEA[ls] := TEA[p];
  2001.       TEA[p] := tmp;
  2002.       Inc(p);
  2003.       Inc(ls);
  2004.     end else
  2005.     if (TEA[p] > x) then
  2006.     begin
  2007.       tmp := TEA[rs];
  2008.       TEA[rs] := TEA[p];
  2009.       TEA[p] := tmp;
  2010.       Dec(rs);
  2011.     end else
  2012.       Inc(p);
  2013.   __TEA_LH_QS3W(TEA, L, (ls - 1));
  2014.   __TEA_LH_QS3W(TEA, (rs + 1), H);
  2015. end;
  2016.  
  2017. procedure __TCA_HL_QS3W(var TCA: array of Char; const L, H: Integer);
  2018. var
  2019.   t: Char;
  2020.   ls, rs, p: Integer;
  2021.   x: string;
  2022. begin
  2023.   if (L >= H) then
  2024.     Exit;
  2025.   x := TCA[L];
  2026.   ls := L;
  2027.   rs := H;
  2028.   p := (L + 1);
  2029.   while (p <= rs) do
  2030.     if (TCA[p] > x) then
  2031.     begin
  2032.       t := TCA[ls];
  2033.       TCA[ls] := TCA[p];
  2034.       TCA[p] := t;
  2035.       Inc(p);
  2036.       Inc(ls);
  2037.     end else
  2038.     if (TCA[p] < x) then
  2039.     begin
  2040.       t := TCA[rs];
  2041.       TCA[rs] := TCA[p];
  2042.       TCA[p] := t;
  2043.       Dec(rs);
  2044.     end else
  2045.       Inc(p);
  2046.   __TCA_HL_QS3W(TCA, L, (ls - 1));
  2047.   __TCA_HL_QS3W(TCA, (rs + 1), H);
  2048. end;
  2049.  
  2050. procedure __TCA_LH_QS3W(var TCA: array of Char; const L, H: Integer);
  2051. var
  2052.   t: Char;
  2053.   ls, rs, p: Integer;
  2054.   x: string;
  2055. begin
  2056.   if (L >= H) then
  2057.     Exit;
  2058.   x := TCA[L];
  2059.   ls := L;
  2060.   rs := H;
  2061.   p := (L + 1);
  2062.   while (p <= rs) do
  2063.     if (TCA[p] < x) then
  2064.     begin
  2065.       t := TCA[ls];
  2066.       TCA[ls] := TCA[p];
  2067.       TCA[p] := t;
  2068.       Inc(p);
  2069.       Inc(ls);
  2070.     end else
  2071.     if (TCA[p] > x) then
  2072.     begin
  2073.       t := TCA[rs];
  2074.       TCA[rs] := TCA[p];
  2075.       TCA[p] := t;
  2076.       Dec(rs);
  2077.     end else
  2078.       Inc(p);
  2079.   __TCA_LH_QS3W(TCA, L, (ls - 1));
  2080.   __TCA_LH_QS3W(TCA, (rs + 1), H);
  2081. end;
  2082.  
  2083. procedure __TIA_HL_QS3W(var TIA: array of Integer; const L, H: Integer);
  2084. var
  2085.   ls, rs, p, x, tmp: Integer;
  2086. begin
  2087.   if (L >= H) then
  2088.     Exit;
  2089.   x := TIA[L];
  2090.   ls := L;
  2091.   rs := H;
  2092.   p := (L + 1);
  2093.   while (p <= rs) do
  2094.     if (TIA[p] > x) then
  2095.     begin
  2096.       tmp := TIA[ls];
  2097.       TIA[ls] := TIA[p];
  2098.       TIA[p] := tmp;
  2099.       Inc(p);
  2100.       Inc(ls);
  2101.     end else
  2102.     if (TIA[p] < x) then
  2103.     begin
  2104.       tmp := TIA[rs];
  2105.       TIA[rs] := TIA[p];
  2106.       TIA[p] := tmp;
  2107.       Dec(rs);
  2108.     end else
  2109.       Inc(p);
  2110.   __TIA_HL_QS3W(TIA, L, (ls - 1));
  2111.   __TIA_HL_QS3W(TIA, (rs + 1), H);
  2112. end;
  2113.  
  2114. procedure __TIA_LH_QS3W(var TIA: array of Integer; const L, H: Integer);
  2115. var
  2116.   ls, rs, p, x, tmp: Integer;
  2117. begin
  2118.   if (L >= H) then
  2119.     Exit;
  2120.   x := TIA[L];
  2121.   ls := L;
  2122.   rs := H;
  2123.   p := (L + 1);
  2124.   while (p <= rs) do
  2125.     if (TIA[p] < x) then
  2126.     begin
  2127.       tmp := TIA[ls];
  2128.       TIA[ls] := TIA[p];
  2129.       TIA[p] := tmp;
  2130.       Inc(p);
  2131.       Inc(ls);
  2132.     end else
  2133.     if (TIA[p] > x) then
  2134.     begin
  2135.       tmp := TIA[rs];
  2136.       TIA[rs] := TIA[p];
  2137.       TIA[p] := tmp;
  2138.       Dec(rs);
  2139.     end else
  2140.       Inc(p);
  2141.   __TIA_LH_QS3W(TIA, L, (ls - 1));
  2142.   __TIA_LH_QS3W(TIA, (rs + 1), H);
  2143. end;
  2144.  
  2145. procedure TIAQuickSort3W(var TIA: array of Integer; order: TSortOrder);
  2146. var
  2147.   h: Integer;
  2148. begin
  2149.   h := High(TIA);
  2150.   if (h > 0) then
  2151.   case order of
  2152.     so_LowToHigh: __TIA_LH_QS3W(TIA, 0, h);
  2153.     so_HighToLow: __TIA_HL_QS3W(TIA, 0, h);
  2154.   end;
  2155. end;
  2156.  
  2157. procedure TSAQuickSort3W(var TSA: array of string; order: TSortOrder);
  2158. var
  2159.   h: Integer;
  2160. begin
  2161.   h := High(TSA);
  2162.   if (h > 0) then
  2163.   case order of
  2164.     so_LowToHigh: __TSA_LH_QS3W(TSA, 0, h);
  2165.     so_HighToLow: __TSA_HL_QS3W(TSA, 0, h);
  2166.   end;
  2167. end;
  2168.  
  2169. procedure TEAQuickSort3W(var TEA: array of Extended; order: TSortOrder);
  2170. var
  2171.   h: Integer;
  2172. begin
  2173.   h := High(TEA);
  2174.   if (h > 0) then
  2175.   case order of
  2176.     so_LowToHigh: __TEA_LH_QS3W(TEA, 0, h);
  2177.     so_HighToLow: __TEA_HL_QS3W(TEA, 0, h);
  2178.   end;
  2179. end;
  2180.  
  2181. procedure TCAQuickSort3W(var TCA: array of Char; order: TSortOrder);
  2182. var
  2183.   h: Integer;
  2184. begin
  2185.   h := High(TCA);
  2186.   if (h > 0) then
  2187.   case order of
  2188.     so_LowToHigh: __TCA_LH_QS3W(TCA, 0, h);
  2189.     so_HighToLow: __TCA_HL_QS3W(TCA, 0, h);
  2190.   end;
  2191. end;
  2192.  
  2193. procedure __TIA_LH_M(var TIA, tmp: array of Integer; const Lo, Hi: Integer);
  2194. var
  2195.   L, R, i, m: Integer;
  2196. begin
  2197.   if (Lo >= Hi) then
  2198.     Exit;
  2199.   m := (Lo + (Hi - Lo) div 2);
  2200.   __TIA_LH_M(TIA, tmp, Lo, m);
  2201.   __TIA_LH_M(TIA, tmp, (m + 1), Hi);
  2202.   L := Lo;
  2203.   R := (m + 1);
  2204.   for i := Lo to Hi do
  2205.     tmp[i] := TIA[i];
  2206.   for i := Lo to Hi do
  2207.     if (L > m) then
  2208.     begin
  2209.       TIA[i] := tmp[R];
  2210.       Inc(R);
  2211.     end else
  2212.       if (R > Hi) then
  2213.       begin
  2214.         TIA[i] := tmp[L];
  2215.         Inc(L);
  2216.       end else
  2217.         if (tmp[R] < tmp[L]) then
  2218.         begin
  2219.           TIA[i] := tmp[R];
  2220.           Inc(R);
  2221.         end else
  2222.         begin
  2223.           TIA[i] := tmp[L];
  2224.           Inc(L);
  2225.         end;
  2226. end;
  2227.  
  2228. procedure __TIA_HL_M(var TIA, tmp: array of Integer; const Lo, Hi: Integer);
  2229. var
  2230.   L, R, i, m: Integer;
  2231. begin
  2232.   if (Lo >= Hi) then
  2233.     Exit;
  2234.   m := (Lo + (Hi - Lo) div 2);
  2235.   __TIA_HL_M(TIA, tmp, Lo, m);
  2236.   __TIA_HL_M(TIA, tmp, (m + 1), Hi);
  2237.   L := Lo;
  2238.   R := (m + 1);
  2239.   for i := Lo to Hi do
  2240.     tmp[i] := TIA[i];
  2241.   for i := Lo to Hi do
  2242.     if (L > m) then
  2243.     begin
  2244.       TIA[i] := tmp[R];
  2245.       Inc(R);
  2246.     end else
  2247.       if (R > Hi) then
  2248.       begin
  2249.         TIA[i] := tmp[L];
  2250.         Inc(L);
  2251.       end else
  2252.         if (tmp[R] > tmp[L]) then
  2253.         begin
  2254.           TIA[i] := tmp[R];
  2255.           Inc(R);
  2256.         end else
  2257.         begin
  2258.           TIA[i] := tmp[L];
  2259.           Inc(L);
  2260.         end;
  2261. end;
  2262.  
  2263. procedure __TEA_LH_M(var TEA, tmp: array of Extended; const Lo, Hi: Integer);
  2264. var
  2265.   L, R, i, m: Integer;
  2266. begin
  2267.   if (Lo >= Hi) then
  2268.     Exit;
  2269.   m := (Lo + (Hi - Lo) div 2);
  2270.   __TEA_LH_M(TEA, tmp, Lo, m);
  2271.   __TEA_LH_M(TEA, tmp, (m + 1), Hi);
  2272.   L := Lo;
  2273.   R := (m + 1);
  2274.   for i := Lo to Hi do
  2275.     tmp[i] := TEA[i];
  2276.   for i := Lo to Hi do
  2277.     if (L > m) then
  2278.     begin
  2279.       TEA[i] := tmp[R];
  2280.       Inc(R);
  2281.     end else
  2282.       if (R > Hi) then
  2283.       begin
  2284.         TEA[i] := tmp[L];
  2285.         Inc(L);
  2286.       end else
  2287.         if (tmp[R] < tmp[L]) then
  2288.         begin
  2289.           TEA[i] := tmp[R];
  2290.           Inc(R);
  2291.         end else
  2292.         begin
  2293.           TEA[i] := tmp[L];
  2294.           Inc(L);
  2295.         end;
  2296. end;
  2297.  
  2298. procedure __TEA_HL_M(var TEA, tmp: array of Extended; const Lo, Hi: Integer);
  2299. var
  2300.   L, R, i, m: Integer;
  2301. begin
  2302.   if (Lo >= Hi) then
  2303.     Exit;
  2304.   m := (Lo + (Hi - Lo) div 2);
  2305.   __TEA_HL_M(TEA, tmp, Lo, m);
  2306.   __TEA_HL_M(TEA, tmp, (m + 1), Hi);
  2307.   L := Lo;
  2308.   R := (m + 1);
  2309.   for i := Lo to Hi do
  2310.     tmp[i] := TEA[i];
  2311.   for i := Lo to Hi do
  2312.     if (L > m) then
  2313.     begin
  2314.       TEA[i] := tmp[R];
  2315.       Inc(R);
  2316.     end else
  2317.       if (R > Hi) then
  2318.       begin
  2319.         TEA[i] := tmp[L];
  2320.         Inc(L);
  2321.       end else
  2322.         if (tmp[R] > tmp[L]) then
  2323.         begin
  2324.           TEA[i] := tmp[R];
  2325.           Inc(R);
  2326.         end else
  2327.         begin
  2328.           TEA[i] := tmp[L];
  2329.           Inc(L);
  2330.         end;
  2331. end;
  2332.  
  2333. procedure __TSA_LH_M(var TSA, tmp: array of string; const Lo, Hi: Integer);
  2334. var
  2335.   L, R, i, m: Integer;
  2336. begin
  2337.   if (Lo >= Hi) then
  2338.     Exit;
  2339.   m := (Lo + (Hi - Lo) div 2);
  2340.   __TSA_LH_M(TSA, tmp, Lo, m);
  2341.   __TSA_LH_M(TSA, tmp, (m + 1), Hi);
  2342.   L := Lo;
  2343.   R := (m + 1);
  2344.   for i := Lo to Hi do
  2345.     tmp[i] := TSA[i];
  2346.   for i := Lo to Hi do
  2347.     if (L > m) then
  2348.     begin
  2349.       TSA[i] := tmp[R];
  2350.       Inc(R);
  2351.     end else
  2352.       if (R > Hi) then
  2353.       begin
  2354.         TSA[i] := tmp[L];
  2355.         Inc(L);
  2356.       end else
  2357.         if (tmp[R] < tmp[L]) then
  2358.         begin
  2359.           TSA[i] := tmp[R];
  2360.           Inc(R);
  2361.         end else
  2362.         begin
  2363.           TSA[i] := tmp[L];
  2364.           Inc(L);
  2365.         end;
  2366. end;
  2367.  
  2368. procedure __TSA_HL_M(var TSA, tmp: array of string; const Lo, Hi: Integer);
  2369. var
  2370.   L, R, i, m: Integer;
  2371. begin
  2372.   if (Lo >= Hi) then
  2373.     Exit;
  2374.   m := (Lo + (Hi - Lo) div 2);
  2375.   __TSA_HL_M(TSA, tmp, Lo, m);
  2376.   __TSA_HL_M(TSA, tmp, (m + 1), Hi);
  2377.   L := Lo;
  2378.   R := (m + 1);
  2379.   for i := Lo to Hi do
  2380.     tmp[i] := TSA[i];
  2381.   for i := Lo to Hi do
  2382.     if (L > m) then
  2383.     begin
  2384.       TSA[i] := tmp[R];
  2385.       Inc(R);
  2386.     end else
  2387.       if (R > Hi) then
  2388.       begin
  2389.         TSA[i] := tmp[L];
  2390.         Inc(L);
  2391.       end else
  2392.         if (tmp[R] > tmp[L]) then
  2393.         begin
  2394.           TSA[i] := tmp[R];
  2395.           Inc(R);
  2396.         end else
  2397.         begin
  2398.           TSA[i] := tmp[L];
  2399.           Inc(L);
  2400.         end;
  2401. end;
  2402.  
  2403. procedure __TCA_LH_M(var TCA, tmp: array of Char; const Lo, Hi: Integer);
  2404. var
  2405.   L, R, i, m: Integer;
  2406. begin
  2407.   if (Lo >= Hi) then
  2408.     Exit;
  2409.   m := (Lo + (Hi - Lo) div 2);
  2410.   __TCA_LH_M(TCA, tmp, Lo, m);
  2411.   __TCA_LH_M(TCA, tmp, (m + 1), Hi);
  2412.   L := Lo;
  2413.   R := (m + 1);
  2414.   for i := Lo to Hi do
  2415.     tmp[i] := TCA[i];
  2416.   for i := Lo to Hi do
  2417.     if (L > m) then
  2418.     begin
  2419.       TCA[i] := tmp[R];
  2420.       Inc(R);
  2421.     end else
  2422.       if (R > Hi) then
  2423.       begin
  2424.         TCA[i] := tmp[L];
  2425.         Inc(L);
  2426.       end else
  2427.         if (tmp[R] < tmp[L]) then
  2428.         begin
  2429.           TCA[i] := tmp[R];
  2430.           Inc(R);
  2431.         end else
  2432.         begin
  2433.           TCA[i] := tmp[L];
  2434.           Inc(L);
  2435.         end;
  2436. end;
  2437.  
  2438. procedure __TCA_HL_M(var TCA, tmp: array of Char; const Lo, Hi: Integer);
  2439. var
  2440.   L, R, i, m: Integer;
  2441. begin
  2442.   if (Lo >= Hi) then
  2443.     Exit;
  2444.   m := (Lo + (Hi - Lo) div 2);
  2445.   __TCA_HL_M(TCA, tmp, Lo, m);
  2446.   __TCA_HL_M(TCA, tmp, (m + 1), Hi);
  2447.   L := Lo;
  2448.   R := (m + 1);
  2449.   for i := Lo to Hi do
  2450.     tmp[i] := TCA[i];
  2451.   for i := Lo to Hi do
  2452.     if (L > m) then
  2453.     begin
  2454.       TCA[i] := tmp[R];
  2455.       Inc(R);
  2456.     end else
  2457.       if (R > Hi) then
  2458.       begin
  2459.         TCA[i] := tmp[L];
  2460.         Inc(L);
  2461.       end else
  2462.         if (tmp[R] > tmp[L]) then
  2463.         begin
  2464.           TCA[i] := tmp[R];
  2465.           Inc(R);
  2466.         end else
  2467.         begin
  2468.           TCA[i] := tmp[L];
  2469.           Inc(L);
  2470.         end;
  2471. end;
  2472.  
  2473. procedure TIAMergeSort(var TIA: array of Integer; order: TSortOrder);
  2474. var
  2475.   l: Integer;
  2476.   t: array of Integer;
  2477. begin
  2478.   l := Length(TIA);
  2479.   if (l > 1) then
  2480.   begin
  2481.     SetLength(t, l);
  2482.     case order of
  2483.       so_LowToHigh: __TIA_LH_M(TIA, t, 0, (l - 1));
  2484.       so_HighToLow: __TIA_HL_M(TIA, t, 0, (l - 1));
  2485.     end;
  2486.   end;
  2487. end;
  2488.  
  2489. procedure TSAMergeSort(var TSA: array of string; order: TSortOrder);
  2490. var
  2491.   l: Integer;
  2492.   t: array of string;
  2493. begin
  2494.   l := Length(TSA);
  2495.   if (l > 1) then
  2496.   begin
  2497.     SetLength(t, l);
  2498.     case order of
  2499.       so_LowToHigh: __TSA_LH_M(TSA, t, 0, (l - 1));
  2500.       so_HighToLow: __TSA_HL_M(TSA, t, 0, (l - 1));
  2501.     end;
  2502.   end;
  2503. end;
  2504.  
  2505. procedure TEAMergeSort(var TEA: array of Extended; order: TSortOrder);
  2506. var
  2507.   l: Integer;
  2508.   t: array of Extended;
  2509. begin
  2510.   l := Length(TEA);
  2511.   if (l > 1) then
  2512.   begin
  2513.     SetLength(t, l);
  2514.     case order of
  2515.       so_LowToHigh: __TEA_LH_M(TEA, t, 0, (l - 1));
  2516.       so_HighToLow: __TEA_HL_M(TEA, t, 0, (l - 1));
  2517.     end;
  2518.   end;
  2519. end;
  2520.  
  2521. procedure TCAMergeSort(var TCA: array of Char; order: TSortOrder);
  2522. var
  2523.   l: Integer;
  2524.   t: array of Char;
  2525. begin
  2526.   l := Length(TCA);
  2527.   if (l > 1) then
  2528.   begin
  2529.     SetLength(t, l);
  2530.     case order of
  2531.       so_LowToHigh: __TCA_LH_M(TCA, t, 0, (l - 1));
  2532.       so_HighToLow: __TCA_HL_M(TCA, t, 0, (l - 1));
  2533.     end;
  2534.   end;
  2535. end;
  2536.  
  2537. procedure __TIA_LH_MBU(var TIA, tmp: array of Integer; const Lo, Mid, Hi: Integer);
  2538. var
  2539.   L, R, i: Integer;
  2540. begin
  2541.   L := Lo;
  2542.   R := (Mid + 1);
  2543.   for i := Lo to Hi do
  2544.     tmp[i] := TIA[i];
  2545.   for i := Lo to Hi do
  2546.     if (L > Mid) then
  2547.     begin
  2548.       TIA[i] := tmp[R];
  2549.       Inc(R);
  2550.     end else
  2551.       if (R > Hi) then
  2552.       begin
  2553.         TIA[i] := tmp[L];
  2554.         Inc(L);
  2555.       end else
  2556.         if (tmp[R] < tmp[L]) then
  2557.         begin
  2558.           TIA[i] := tmp[R];
  2559.           Inc(R);
  2560.         end else
  2561.         begin
  2562.           TIA[i] := tmp[L];
  2563.           Inc(L);
  2564.         end;
  2565. end;
  2566.  
  2567. procedure __TIA_HL_MBU(var TIA, tmp: array of Integer; const Lo, Mid, Hi: Integer);
  2568. var
  2569.   L, R, i: Integer;
  2570. begin
  2571.   L := Lo;
  2572.   R := (Mid + 1);
  2573.   for i := Lo to Hi do
  2574.     tmp[i] := TIA[i];
  2575.   for i := Lo to Hi do
  2576.     if (L > Mid) then
  2577.     begin
  2578.       TIA[i] := tmp[R];
  2579.       Inc(R);
  2580.     end else
  2581.       if (R > Hi) then
  2582.       begin
  2583.         TIA[i] := tmp[L];
  2584.         Inc(L);
  2585.       end else
  2586.         if (tmp[R] > tmp[L]) then
  2587.         begin
  2588.           TIA[i] := tmp[R];
  2589.           Inc(R);
  2590.         end else
  2591.         begin
  2592.           TIA[i] := tmp[L];
  2593.           Inc(L);
  2594.         end;
  2595. end;
  2596.  
  2597. procedure __TEA_LH_MBU(var TEA, tmp: array of Extended; const Lo, Mid, Hi: Integer);
  2598. var
  2599.   L, R, i: Integer;
  2600. begin
  2601.   L := Lo;
  2602.   R := (Mid + 1);
  2603.   for i := Lo to Hi do
  2604.     tmp[i] := TEA[i];
  2605.   for i := Lo to Hi do
  2606.     if (L > Mid) then
  2607.     begin
  2608.       TEA[i] := tmp[R];
  2609.       Inc(R);
  2610.     end else
  2611.       if (R > Hi) then
  2612.       begin
  2613.         TEA[i] := tmp[L];
  2614.         Inc(L);
  2615.       end else
  2616.         if (tmp[R] < tmp[L]) then
  2617.         begin
  2618.           TEA[i] := tmp[R];
  2619.           Inc(R);
  2620.         end else
  2621.         begin
  2622.           TEA[i] := tmp[L];
  2623.           Inc(L);
  2624.         end;
  2625. end;
  2626.  
  2627. procedure __TEA_HL_MBU(var TEA, tmp: array of Extended; const Lo, Mid, Hi: Integer);
  2628. var
  2629.   L, R, i: Integer;
  2630. begin
  2631.   L := Lo;
  2632.   R := (Mid + 1);
  2633.   for i := Lo to Hi do
  2634.     tmp[i] := TEA[i];
  2635.   for i := Lo to Hi do
  2636.     if (L > Mid) then
  2637.     begin
  2638.       TEA[i] := tmp[R];
  2639.       Inc(R);
  2640.     end else
  2641.       if (R > Hi) then
  2642.       begin
  2643.         TEA[i] := tmp[L];
  2644.         Inc(L);
  2645.       end else
  2646.         if (tmp[R] > tmp[L]) then
  2647.         begin
  2648.           TEA[i] := tmp[R];
  2649.           Inc(R);
  2650.         end else
  2651.         begin
  2652.           TEA[i] := tmp[L];
  2653.           Inc(L);
  2654.         end;
  2655. end;
  2656.  
  2657. procedure __TSA_LH_MBU(var TSA, tmp: array of string; const Lo, Mid, Hi: Integer);
  2658. var
  2659.   L, R, i: Integer;
  2660. begin
  2661.   L := Lo;
  2662.   R := (Mid + 1);
  2663.   for i := Lo to Hi do
  2664.     tmp[i] := TSA[i];
  2665.   for i := Lo to Hi do
  2666.     if (L > Mid) then
  2667.     begin
  2668.       TSA[i] := tmp[R];
  2669.       Inc(R);
  2670.     end else
  2671.       if (R > Hi) then
  2672.       begin
  2673.         TSA[i] := tmp[L];
  2674.         Inc(L);
  2675.       end else
  2676.         if (tmp[R] < tmp[L]) then
  2677.         begin
  2678.           TSA[i] := tmp[R];
  2679.           Inc(R);
  2680.         end else
  2681.         begin
  2682.           TSA[i] := tmp[L];
  2683.           Inc(L);
  2684.         end;
  2685. end;
  2686.  
  2687. procedure __TSA_HL_MBU(var TSA, tmp: array of string; const Lo, Mid, Hi: Integer);
  2688. var
  2689.   L, R, i: Integer;
  2690. begin
  2691.   L := Lo;
  2692.   R := (Mid + 1);
  2693.   for i := Lo to Hi do
  2694.     tmp[i] := TSA[i];
  2695.   for i := Lo to Hi do
  2696.     if (L > Mid) then
  2697.     begin
  2698.       TSA[i] := tmp[R];
  2699.       Inc(R);
  2700.     end else
  2701.       if (R > Hi) then
  2702.       begin
  2703.         TSA[i] := tmp[L];
  2704.         Inc(L);
  2705.       end else
  2706.         if (tmp[R] > tmp[L]) then
  2707.         begin
  2708.           TSA[i] := tmp[R];
  2709.           Inc(R);
  2710.         end else
  2711.         begin
  2712.           TSA[i] := tmp[L];
  2713.           Inc(L);
  2714.         end;
  2715. end;
  2716.  
  2717. procedure __TCA_LH_MBU(var TCA, tmp: array of Char; const Lo, Mid, Hi: Integer);
  2718. var
  2719.   L, R, i: Integer;
  2720. begin
  2721.   L := Lo;
  2722.   R := (Mid + 1);
  2723.   for i := Lo to Hi do
  2724.     tmp[i] := TCA[i];
  2725.   for i := Lo to Hi do
  2726.     if (L > Mid) then
  2727.     begin
  2728.       TCA[i] := tmp[R];
  2729.       Inc(R);
  2730.     end else
  2731.       if (R > Hi) then
  2732.       begin
  2733.         TCA[i] := tmp[L];
  2734.         Inc(L);
  2735.       end else
  2736.         if (tmp[R] < tmp[L]) then
  2737.         begin
  2738.           TCA[i] := tmp[R];
  2739.           Inc(R);
  2740.         end else
  2741.         begin
  2742.           TCA[i] := tmp[L];
  2743.           Inc(L);
  2744.         end;
  2745. end;
  2746.  
  2747. procedure __TCA_HL_MBU(var TCA, tmp: array of Char; const Lo, Mid, Hi: Integer);
  2748. var
  2749.   L, R, i: Integer;
  2750. begin
  2751.   L := Lo;
  2752.   R := (Mid + 1);
  2753.   for i := Lo to Hi do
  2754.     tmp[i] := TCA[i];
  2755.   for i := Lo to Hi do
  2756.     if (L > Mid) then
  2757.     begin
  2758.       TCA[i] := tmp[R];
  2759.       Inc(R);
  2760.     end else
  2761.       if (R > Hi) then
  2762.       begin
  2763.         TCA[i] := tmp[L];
  2764.         Inc(L);
  2765.       end else
  2766.         if (tmp[R] > tmp[L]) then
  2767.         begin
  2768.           TCA[i] := tmp[R];
  2769.           Inc(R);
  2770.         end else
  2771.         begin
  2772.           TCA[i] := tmp[L];
  2773.           Inc(L);
  2774.         end;
  2775. end;
  2776.  
  2777. procedure TIAMergeSortBU(var TIA: array of Integer; order: TSortOrder);
  2778. var
  2779.   l, s, Lo: Integer;
  2780.   tmp: array of Integer;
  2781. begin
  2782.   l := Length(TIA);
  2783.   if (l > 1) then
  2784.   begin
  2785.     SetLength(tmp, l);
  2786.     s := 1;
  2787.     case order of
  2788.       so_LowToHigh:
  2789.       while (s < l) do
  2790.       begin
  2791.         Lo := 0;
  2792.         while (Lo < (l - s)) do
  2793.         begin
  2794.           __TIA_LH_MBU(TIA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2795.           Lo := (Lo + (s * 2));
  2796.         end;
  2797.         s := (s + s);
  2798.       end;
  2799.       so_HighToLow:
  2800.       while (s < l) do
  2801.       begin
  2802.         Lo := 0;
  2803.         while (Lo < (l - s)) do
  2804.         begin
  2805.           __TIA_HL_MBU(TIA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2806.           Lo := (Lo + (s * 2));
  2807.         end;
  2808.         s := (s + s);
  2809.       end;
  2810.     end;
  2811.   end;
  2812. end;
  2813.  
  2814. procedure TSAMergeSortBU(var TSA: array of string; order: TSortOrder);
  2815. var
  2816.   l, s, Lo: Integer;
  2817.   tmp: array of string;
  2818. begin
  2819.   l := Length(TSA);
  2820.   if (l > 1) then
  2821.   begin
  2822.     SetLength(tmp, l);
  2823.     s := 1;
  2824.     case order of
  2825.       so_LowToHigh:
  2826.       while (s < l) do
  2827.       begin
  2828.         Lo := 0;
  2829.         while (Lo < (l - s)) do
  2830.         begin
  2831.           __TSA_LH_MBU(TSA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2832.           Lo := (Lo + (s * 2));
  2833.         end;
  2834.         s := (s + s);
  2835.       end;
  2836.       so_HighToLow:
  2837.       while (s < l) do
  2838.       begin
  2839.         Lo := 0;
  2840.         while (Lo < (l - s)) do
  2841.         begin
  2842.           __TSA_HL_MBU(TSA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2843.           Lo := (Lo + (s * 2));
  2844.         end;
  2845.         s := (s + s);
  2846.       end;
  2847.     end;
  2848.   end;
  2849. end;
  2850.  
  2851. procedure TEAMergeSortBU(var TEA: array of Extended; order: TSortOrder);
  2852. var
  2853.   l, s, Lo: Integer;
  2854.   tmp: array of Extended;
  2855. begin
  2856.   l := Length(TEA);
  2857.   if (l > 1) then
  2858.   begin
  2859.     SetLength(tmp, l);
  2860.     s := 1;
  2861.     case order of
  2862.       so_LowToHigh:
  2863.       while (s < l) do
  2864.       begin
  2865.         Lo := 0;
  2866.         while (Lo < (l - s)) do
  2867.         begin
  2868.           __TEA_LH_MBU(TEA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2869.           Lo := (Lo + (s * 2));
  2870.         end;
  2871.         s := (s + s);
  2872.       end;
  2873.       so_HighToLow:
  2874.       while (s < l) do
  2875.       begin
  2876.         Lo := 0;
  2877.         while (Lo < (l - s)) do
  2878.         begin
  2879.           __TEA_HL_MBU(TEA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2880.           Lo := (Lo + (s * 2));
  2881.         end;
  2882.         s := (s + s);
  2883.       end;
  2884.     end;
  2885.   end;
  2886. end;
  2887.  
  2888. procedure TCAMergeSortBU(var TCA: array of Char; order: TSortOrder);
  2889. var
  2890.   l, s, Lo: Integer;
  2891.   tmp: array of Char;
  2892. begin
  2893.   l := Length(TCA);
  2894.   if (l > 1) then
  2895.   begin
  2896.     SetLength(tmp, l);
  2897.     s := 1;
  2898.     case order of
  2899.       so_LowToHigh:
  2900.       while (s < l) do
  2901.       begin
  2902.         Lo := 0;
  2903.         while (Lo < (l - s)) do
  2904.         begin
  2905.           __TCA_LH_MBU(TCA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2906.           Lo := (Lo + (s * 2));
  2907.         end;
  2908.         s := (s + s);
  2909.       end;
  2910.       so_HighToLow:
  2911.       while (s < l) do
  2912.       begin
  2913.         Lo := 0;
  2914.         while (Lo < (l - s)) do
  2915.         begin
  2916.           __TCA_HL_MBU(TCA, tmp, Lo, ((Lo + s) - 1), Min(((Lo + (s * 2)) - 1), (l - 1)));
  2917.           Lo := (Lo + (s * 2));
  2918.         end;
  2919.         s := (s + s);
  2920.       end;
  2921.     end;
  2922.   end;
  2923. end;
  2924.  
  2925. procedure TIASort(var TIA: array of Integer; algorithm: TSortAlgorithm; order: TSortOrder); // register;
  2926. begin
  2927.   case algorithm of
  2928.     sa_BubbleSort: TIABubbleSort(TIA, order);
  2929.     sa_InsertionSort: TIAInsertionSort(TIA, order);
  2930.     sa_QuickSort3W: TIAQuickSort3W(TIA, order);
  2931.     sa_QuickSort: TIAQuickSort(TIA, order);
  2932.     sa_ShellSort: TIAShellSort(TIA, order);
  2933.     sa_SelectionSort: TIASelectionSort(TIA, order);
  2934.     sa_JnlbSort: TIAJnlbSort(TIA, order);
  2935.     sa_JnlbSortDnmc: TIAJnlbSortDnmc(TIA, order);
  2936.     sa_HeapSort: TIAHeapSort(TIA, order);
  2937.     sa_MergeSort: TIAMergeSort(TIA, order);
  2938.     sa_MergeSortBU: TIAMergeSortBU(TIA, order);
  2939.   end;
  2940. end;
  2941.  
  2942. procedure TSASort(var TSA: array of string; algorithm: TSortAlgorithm; order: TSortOrder); // register;
  2943. begin
  2944.   case algorithm of
  2945.     sa_BubbleSort: TSABubbleSort(TSA, order);
  2946.     sa_InsertionSort: TSAInsertionSort(TSA, order);
  2947.     sa_QuickSort3W: TSAQuickSort3W(TSA, order);
  2948.     sa_QuickSort: TSAQuickSort(TSA, order);
  2949.     sa_ShellSort: TSAShellSort(TSA, order);
  2950.     sa_SelectionSort: TSASelectionSort(TSA, order);
  2951.     sa_JnlbSort: TSAJnlbSort(TSA, order);
  2952.     sa_JnlbSortDnmc: TSAJnlbSortDnmc(TSA, order);
  2953.     sa_HeapSort: TSAHeapSort(TSA, order);
  2954.     sa_MergeSort: TSAMergeSort(TSA, order);
  2955.     sa_MergeSortBU: TSAMergeSortBU(TSA, order);
  2956.   end;
  2957. end;
  2958.  
  2959. procedure TEASort(var TEA: array of Extended; algorithm: TSortAlgorithm; order: TSortOrder); // register;
  2960. begin
  2961.   case algorithm of
  2962.     sa_BubbleSort: TEABubbleSort(TEA, order);
  2963.     sa_InsertionSort: TEAInsertionSort(TEA, order);
  2964.     sa_QuickSort3W: TEAQuickSort3W(TEA, order);
  2965.     sa_QuickSort: TEAQuickSort(TEA, order);
  2966.     sa_ShellSort: TEAShellSort(TEA, order);
  2967.     sa_SelectionSort: TEASelectionSort(TEA, order);
  2968.     sa_JnlbSort: TEAJnlbSort(TEA, order);
  2969.     sa_JnlbSortDnmc: TEAJnlbSortDnmc(TEA, order);
  2970.     sa_HeapSort: TEAHeapSort(TEA, order);
  2971.     sa_MergeSort: TEAMergeSort(TEA, order);
  2972.     sa_MergeSortBU: TEAMergeSortBU(TEA, order);
  2973.   end;
  2974. end;
  2975.  
  2976. procedure TCASort(var TCA: array of Char; algorithm: TSortAlgorithm; order: TSortOrder); // register;
  2977. begin
  2978.   case algorithm of
  2979.     sa_BubbleSort: TCABubbleSort(TCA, order);
  2980.     sa_InsertionSort: TCAInsertionSort(TCA, order);
  2981.     sa_QuickSort3W: TCAQuickSort3W(TCA, order);
  2982.     sa_QuickSort: TCAQuickSort(TCA, order);
  2983.     sa_ShellSort: TCAShellSort(TCA, order);
  2984.     sa_SelectionSort: TCASelectionSort(TCA, order);
  2985.     sa_JnlbSort: TCAJnlbSort(TCA, order);
  2986.     sa_JnlbSortDnmc: TCAJnlbSortDnmc(TCA, order);
  2987.     sa_HeapSort: TCAHeapSort(TCA, order);
  2988.     sa_MergeSort: TCAMergeSort(TCA, order);
  2989.     sa_MergeSortBU: TCAMergeSortBU(TCA, order);
  2990.   end;
  2991. end;
  2992.  
  2993. {==============================================================================]
  2994.   Explanation: Returns a TIA that contains all the value from start value (aStart) to finishing value (aFinish)..
  2995. [==============================================================================}
  2996. function TIAByRange(aStart, aFinish: Integer): TIntegerArray;
  2997. var
  2998.   i, s, f: Integer;
  2999. begin
  3000.   if (aStart <> aFinish) then
  3001.   begin
  3002.     s := Integer(aStart);
  3003.     f := Integer(aFinish);
  3004.     SetLength(Result, (IAbs(aStart - aFinish) + 1));
  3005.     case (aStart > aFinish) of
  3006.       True:
  3007.       for i := s downto f do
  3008.         Result[(s - i)] := i;
  3009.       False:
  3010.       for i := s to f do
  3011.         Result[(i - s)] := i;
  3012.     end;
  3013.   end else
  3014.     Result := [Integer(aStart)];
  3015. end;
  3016.  
  3017. {==============================================================================]
  3018.   Explanation: Returns a TIA that contains all the value from start value (aStart) to finishing value (aFinish)..
  3019.   NOTE: Works with 2-bit method, that cuts loop in half.
  3020. [==============================================================================}
  3021. function TIAByRange2bit(aStart, aFinish: Integer): TIntegerArray;
  3022. var
  3023.   g, l, i, s, f: Integer;
  3024. begin
  3025.   if (aStart <> aFinish) then
  3026.   begin
  3027.     s := Integer(aStart);
  3028.     f := Integer(aFinish);
  3029.     l := (IAbs(aStart - aFinish) + 1);
  3030.     SetLength(Result, l);
  3031.     g := ((l - 1) div 2);
  3032.     case (aStart < aFinish) of
  3033.       True:
  3034.       begin
  3035.         for i := 0 to g do
  3036.         begin
  3037.           Result[i] := (s + i);
  3038.           Result[((l - 1) - i)] := (f - i);
  3039.         end;
  3040.         if ((l mod 2) <> 0) then
  3041.           Result[i] := (s + i);
  3042.       end;
  3043.       False:
  3044.       begin
  3045.         for i := 0 to g do
  3046.         begin
  3047.           Result[i] := (s - i);
  3048.           Result[((l - 1) - i)] := (f + i);
  3049.         end;
  3050.         if ((l mod 2) <> 0) then
  3051.           Result[i] := (s - i);
  3052.       end;
  3053.     end;
  3054.   end else
  3055.     Result := [Integer(aStart)];
  3056. end;
  3057.  
  3058. {==============================================================================]
  3059.   Explanation: Randomizes TIA.
  3060.                Example: [1, 2, 3] => [2, 3, 1]
  3061.                The higher count of shuffles is, the "stronger" randomization you'll get.
  3062. [==============================================================================}
  3063. procedure TIARandomizeEx(var TIA: TIntegerArray; shuffles: Integer);
  3064. var
  3065.   l, i, t: Integer;
  3066. begin
  3067.   l := Length(TIA);
  3068.   if ((l > 1) and (shuffles > 0)) then
  3069.     for t := 1 to shuffles do
  3070.       for i := 0 to (l - 1) do
  3071.         Swap(TIA[Random(l)], TIA[Random(l)]);
  3072. end;
  3073.  
  3074. {==============================================================================]
  3075.   Explanation: Fills TIA items with x.
  3076. [==============================================================================}
  3077. procedure TIAFillEx(var TIA: TIntegerArray; x: TIntegerArray);
  3078. var
  3079.   i, h, l: Integer;
  3080. begin
  3081.   h := High(TIA);
  3082.   l := Length(x);
  3083.   for i := 0 to h do
  3084.     TIA[i] := Integer(x[i mod l]);
  3085. end;
  3086.  
  3087. {==============================================================================]
  3088.   Explanation: Clones (a.K.a returns copy of) TIA.
  3089. [==============================================================================}
  3090. function TIAClone(TIA: TIntegerArray): TIntegerArray;
  3091. var
  3092.   h, i: Integer;
  3093. begin
  3094.   h := High(TIA);
  3095.   SetLength(Result, (h + 1));
  3096.   for i := 0 to h do
  3097.     Result[i] := Integer(TIA[i]);
  3098. end;
  3099.  
  3100. {==============================================================================]
  3101.   Explanation: Reverses TIA.
  3102. [==============================================================================}
  3103. procedure TIAReverse(var TIA: TIntegerArray);
  3104. var
  3105.   g, i, l: Integer;
  3106. begin
  3107.   l := (Length(TIA) - 1);
  3108.   if (l < 1) then
  3109.     Exit;
  3110.   g := (l div 2);
  3111.   for i := 0 to g do
  3112.     Swap(TIA[i], TIA[(l - i)]);
  3113. end;
  3114.  
  3115. procedure SortingTimer(TIA: TIntegerArray; algorithm: TSortAlgorithm);
  3116. var
  3117.   t: Integer;
  3118.   s: string;
  3119.   arr: TIntegerArray;
  3120. begin
  3121.   arr := TIAClone(TIA);
  3122.   t := GetSystemTime;
  3123.   case algorithm of
  3124.     sa_BubbleSort:
  3125.     begin
  3126.       TIABubbleSort(arr, so_LowToHigh);
  3127.       s := 'BubbleSort()';
  3128.     end;
  3129.     sa_HeapSort:
  3130.     begin
  3131.       TIAHeapSort(arr, so_LowToHigh);
  3132.       s := 'HeapSort()';
  3133.     end;
  3134.     sa_InsertionSort:
  3135.     begin
  3136.       TIAInsertionSort(arr, so_LowToHigh);
  3137.       s := 'InsertionSort()';
  3138.     end;
  3139.     sa_MergeSort:
  3140.     begin
  3141.       TIAMergeSort(arr, so_LowToHigh);
  3142.       s := 'MergeSort()';
  3143.     end;
  3144.     sa_MergeSortBU:
  3145.     begin
  3146.       TIAMergeSortBU(arr, so_LowToHigh);
  3147.       s := 'MergeSortBU()';
  3148.     end;
  3149.     sa_SelectionSort:
  3150.     begin
  3151.       TIASelectionSort(arr, so_LowToHigh);
  3152.       s := 'SelectionSort()';
  3153.     end;
  3154.     sa_ShellSort:
  3155.     begin
  3156.       TIAShellSort(arr, so_LowToHigh);
  3157.       s := 'ShellSort()';
  3158.     end;
  3159.     sa_QuickSort:
  3160.     begin
  3161.       TIAQuickSort(arr, so_LowToHigh);
  3162.       s := 'QuickSort()';
  3163.     end;
  3164.     sa_QuickSort3W:
  3165.     begin
  3166.       TIAQuickSort3W(arr, so_LowToHigh);
  3167.       s := 'QuickSort3W()';
  3168.     end;
  3169.     sa_JnlbSort:
  3170.     begin
  3171.       TIAJnlbSort(arr, so_LowToHigh);
  3172.       s := 'JnlbSort()';
  3173.     end;
  3174.     sa_JnlbSortDnmc:
  3175.     begin
  3176.       TIAJnlbSortDnmc(arr, so_LowToHigh);
  3177.       s := 'JnlbSortDnmc()';
  3178.     end;
  3179.   end;
  3180.   t := (GetSystemTime - t);
  3181.   WriteLn(MD5(ToStr(arr)) + ': ' + IntToStr(t) + ' ms. [' + s + ']');
  3182.   SetLength(arr, 0);
  3183. end;
  3184.  
  3185. var
  3186.   original: TIntegerArray;
  3187.  
  3188. begin
  3189.   ClearDebug;
  3190.   original := TIAByRange2bit(500, -500);
  3191.   WriteLn(MD5(ToStr(original)) + ' (REVERSED):');
  3192.  
  3193.   SortingTimer(original, sa_JnlbSort);
  3194.   SortingTimer(original, sa_JnlbSortDnmc);
  3195.   SortingTimer(original, sa_BubbleSort);
  3196.   SortingTimer(original, sa_ShellSort);
  3197.   SortingTimer(original, sa_SelectionSort);
  3198.   SortingTimer(original, sa_InsertionSort);
  3199.   SortingTimer(original, sa_MergeSort);
  3200.   SortingTimer(original, sa_MergeSortBU);
  3201.   SortingTimer(original, sa_HeapSort);
  3202.   SortingTimer(original, sa_QuickSort);
  3203.   SortingTimer(original, sa_QuickSort3W);
  3204.  
  3205.   WriteLn('');
  3206.   TIAReverse(original);
  3207.   WriteLn(MD5(ToStr(original)) + ' (ALREADY SORTED):');
  3208.  
  3209.   SortingTimer(original, sa_JnlbSort);
  3210.   SortingTimer(original, sa_JnlbSortDnmc);
  3211.   SortingTimer(original, sa_BubbleSort);
  3212.   SortingTimer(original, sa_ShellSort);
  3213.   SortingTimer(original, sa_SelectionSort);
  3214.   SortingTimer(original, sa_InsertionSort);
  3215.   SortingTimer(original, sa_MergeSort);
  3216.   SortingTimer(original, sa_MergeSortBU);
  3217.   SortingTimer(original, sa_HeapSort);
  3218.   SortingTimer(original, sa_QuickSort);
  3219.   SortingTimer(original, sa_QuickSort3W);
  3220.  
  3221.   WriteLn('');
  3222.   TIARandomizeEx(original, 2);
  3223.   WriteLn(MD5(ToStr(original)) + ' (RANDOMIZED):');
  3224.  
  3225.   SortingTimer(original, sa_JnlbSort);
  3226.   SortingTimer(original, sa_JnlbSortDnmc);
  3227.   SortingTimer(original, sa_BubbleSort);
  3228.   SortingTimer(original, sa_ShellSort);
  3229.   SortingTimer(original, sa_SelectionSort);
  3230.   SortingTimer(original, sa_InsertionSort);
  3231.   SortingTimer(original, sa_MergeSort);
  3232.   SortingTimer(original, sa_MergeSortBU);
  3233.   SortingTimer(original, sa_HeapSort);
  3234.   SortingTimer(original, sa_QuickSort);
  3235.   SortingTimer(original, sa_QuickSort3W);
  3236.  
  3237.   WriteLn('');
  3238.   TIAFillEx(original, [1, 2, 4, 8, 16, 32, 64, 128, 256, 512, 1024, 2048, 4096, 8192, 16384]);
  3239.   WriteLn(MD5(ToStr(original)) + ' ("FEW" UNIQUE):');
  3240.  
  3241.   SortingTimer(original, sa_JnlbSort);
  3242.   SortingTimer(original, sa_JnlbSortDnmc);
  3243.   SortingTimer(original, sa_BubbleSort);
  3244.   SortingTimer(original, sa_ShellSort);
  3245.   SortingTimer(original, sa_SelectionSort);
  3246.   SortingTimer(original, sa_InsertionSort);
  3247.   SortingTimer(original, sa_MergeSort);
  3248.   SortingTimer(original, sa_MergeSortBU);
  3249.   SortingTimer(original, sa_HeapSort);
  3250.   SortingTimer(original, sa_QuickSort);
  3251.   SortingTimer(original, sa_QuickSort3W);
  3252.  
  3253.   SetLength(original, 0);
  3254. end.
Advertisement
Add Comment
Please, Sign In to add comment