unit Sorty;

interface

uses 
  Classes, Graphics, ExtCtrls; 

type
  pole=array of integer; 

  TSortThread = class(TThread) 
  private 
    g:TCanvas; 
    vi,vj,vys:integer;
    ff:TColor; 
    procedure KresliPrvok(i:integer; f:TColor); 
    procedure synchrovymen; 
    procedure synchroprirad; 
    procedure Kresli(f:TColor); 
    procedure synchroKresli; 
  protected 
    p:pole; 
    procedure vymen(i,j:integer); 
    procedure prirad(i,hodn:integer); 
    procedure Sort; virtual; abstract; 
    procedure Execute; override; 
  public 
    constructor Create(const np:pole; im:TImage); 
  end;

//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

  TBubbleSort = class(TSortThread)
    procedure Sort; override;
  end;

  TMinSort = class(TSortThread)
    procedure Sort; override;
  end;

  TInsertSort = class(TSortThread)
    procedure Sort; override;
  end;

  TQuickSort = class(TSortThread)
    procedure  rozdel(z,k:integer; var ip:integer);
    procedure quick(z,k:integer);
    procedure Sort; override;
  end;

  THeapSort = class(TSortThread)
    procedure posun(var i:integer; m:integer);
    procedure uprac_haldu(k,m:integer);
    procedure vytvor_haldu;
    procedure Sort; override;
  end;


implementation

constructor TSortThread.Create(const np:pole; im:TImage); 
begin 
  inherited Create(true); 
  p:=copy(np,0,Length(np)); 
  vys:=im.Height; 
  g:=im.Canvas; 
  g.FillRect(im.ClientRect); 
  Kresli(clSkyBlue); 
  FreeOnTerminate:=true;
end; 

procedure TSortThread.KresliPrvok(i:integer; f:TColor); 
begin
  g.Pen.Color:=f; g.Polyline([Point(i,vys),Point(i,vys-p[i]-1)]); 
end; 

procedure TSortThread.vymen(i,j:integer); 
begin 
  if i=j
    then
      exit; 
  vi:=i; vj:=j; 
  Synchronize(synchrovymen); 
end; 

procedure TSortThread.synchrovymen; 
var t:integer; 
begin 
  KresliPrvok(vi,clWhite); 
  KresliPrvok(vj,clWhite); 
  t:=p[vi]; p[vi]:=p[vj]; p[vj]:=t; 
  KresliPrvok(vi,clMoneyGreen);
  KresliPrvok(vj,clSkyBlue);
end; 

procedure TSortThread.prirad(i,hodn:integer); 
begin 
  if p[i]=hodn
    then
      exit;
  vi:=i; vj:=hodn; 
  Synchronize(synchroprirad); 
end; 

procedure TSortThread.synchroprirad; 
begin 
  KresliPrvok(vi,clWhite); 
  p[vi]:=vj; 
  KresliPrvok(vi,clMoneyGreen);
end; 

procedure TSortThread.Execute; 
begin 
  Sort; 
end; 

procedure TSortThread.Kresli(f:TColor); 
begin 
  ff:=f; 
  Synchronize(synchroKresli); 
end; 

procedure TSortThread.synchroKresli; 
var i:integer; 
begin 
  for i:=low(p) to high(p) do 
    KresliPrvok(i,ff); 
end;

//////////////////////BUBBLE SORT///////////////////////////////////

procedure TBubbleSort.Sort;
var
  i,j:integer;
begin 
  for i:=high(p)-1 downto low(p) do 
    for j:=low(p) to i do 
      if p[j]>p[j+1]
        then
          vymen(j,j+1);
end;

/////////////////MIN SORT////////////////////////////////////////

procedure TMinSort.Sort; 
var i,j,min:integer; 
begin 
  for i:=low(p) to high(p)-1 do begin 
    min:=i; 
    for j:=i+1 to high(p) do 
      if p[j]<p[min]
        then
          min:=j;
    vymen(i,min); 
  end; 
end;


/////////////////INSERT SORT/////////////////////////////////////

procedure TInsertSort.Sort; 
var i,j,t:integer; 
begin 
  for i:=low(p) to high(p) do begin
    j:=i-1; t:=p[i];
    while (j>=low(p)) and (p[j]>t) do  begin
      prirad(j+1,p[j]); dec(j)
    end;
    prirad(j+1,t);
  end;
end;

///////////////////////QUICK SORT//////////////////////////////////

procedure TQuickSort.rozdel(z,k:integer; var ip:integer);
var
  pivot:integer;
  i:integer;
begin
  pivot:=p[z]; ip:=z;
  for i:=z+1 to k do begin
    if p[i]<pivot
      then begin
        inc(ip); vymen(ip,i);
      end;
  end;
  vymen(z,ip);

end;

procedure TQuickSort.quick(z,k:integer);
var
  ipivot:integer;
begin
  if z>=k then exit;
  rozdel(z,k,ipivot);
  quick(z,ipivot-1);
  quick(ipivot+1,k);
end;

procedure TQuickSort.Sort;
begin
  quick(0,299);
end;

///////////////////////////////HEAP SORT//////////////////////////

procedure THeapSort.posun(var i:integer; m:integer);
begin
  if 2*i+1<=m 
    then begin 
      i:=2*i+1;
      if (i<m) and (p[i+1]>p[i])
        then
          i:=i+1
    end; 
end; 

procedure THeapSort.uprac_haldu(k,m:integer);
var 
  i:integer;
begin 
  i:=k; posun(i,m); 
  while p[k]<p[i] do begin 
    vymen(k,i);
    k:=i; 
    posun(i,m);      
  end; 
end; 

procedure THeapSort.vytvor_haldu;
var 
  i:integer; 
begin 
  for i:= high(p) div 2 downto 0 do uprac_haldu(i,high(p)) 
end;

procedure THeapSort.Sort;
var i:integer; 
begin 
  vytvor_haldu; 
  i:=high(p);
  while i>0 do begin 
    vymen(0,i);
    dec(i);
    uprac_haldu(0,i);    
  end; 
end;

end.