unit2.pas

Delphi basic program. Basic programing guide for delphi language. Several samples are giving.

unit Unit2;

interface

uses
  Classes,Graphics,ExtCtrls,SysUtils;

type
  {Sort Thread}
  PSortArray = ^TSortArray;
  TSortArray = array[0..MaxInt div SizeOf(Integer) - 1] of Integer;

  TSortThread = class(TThread)
  private
    { Private declarations }
    FBox: TPaintBox;
    FSortArray: PSortArray;
    FSize: integer;
    FA,FB,FI,FJ: integer;
    procedure DoVisualSwap;
  protected
    procedure Execute; override;
    procedure VisualSwap(A, B, I, J: integer);
    procedure Sort(var A: array of integer); virtual; abstract;
  public
    constructor Create(Box: TPaintBox; var SortArray: array of integer);
  end;

{TBubbleSort}
  TBubbleSort = class(TSortThread)
  protected
    procedure Sort(var A: array of integer); override;
  end;

{TSelectionSort}
  TSelectionSort = class(TSortThread)
  protected
    procedure Sort(var A: array of integer); override;
  end;

{TQuickSort}
  TQuickSort = class(TSortThread)
  protected
    procedure Sort(var A: array of integer); override;
  end;

procedure PaintLine(Canvas: TCanvas; I, Len: integer);

implementation

Procedure PaintLine(Canvas: TCanvas; I, Len: integer);
begin
  Canvas.Polyline([Point(0,I * 2 + 1), Point(Len, I * 2 + 1)]);
end;

{ TSortThread }

constructor TSortThread.Create(Box: TPaintBox;
  var SortArray: array of integer);
begin
  FBox := Box;
  FSortArray := @SortArray;
  FSize := High(SortArray) - Low(SortArray) + 1;
  FreeOnTerminate := True;
  inherited Create(False);
end;

procedure TSortThread.DoVisualSwap;
begin
  with FBox do
  begin
    Canvas.Pen.Color := clBtnFace;
    PaintLine(Canvas, FI, FA);
    PaintLine(Canvas, FJ, FB);
    Canvas.Pen.Color := clRed;
    PaintLine(Canvas, FI, FB);
    PaintLine(Canvas, FJ, FA);
  end;
end;

procedure TSortThread.Execute;
begin
  Sort(Slice(FSortArray^, FSize));
end;

procedure TSortThread.VisualSwap(A, B, I, J: integer);
begin
  FA := A;
  FB := B;
  FI := I;
  FJ := J;
  Synchronize(DoVisualSwap);
end;

{ TBubbleSort }

procedure TBubbleSort.Sort(var A: array of integer);
var
  i, j, t: integer;
begin
  for i := High(A) downto Low(A) do
    for j := Low(A) to High(A) -1 do
      if A[j] > A[j + 1] then
      begin
        VisualSwap(A[j], A[j + 1], j, j + 1);
        t := A[j];
        A[j] := A[j + 1];
        A[j + 1] := t;
        if Terminated then Exit;
      end;
end;

{ TSelectionSort }

procedure TSelectionSort.Sort(var A: array of integer);
var
 i, j, t: integer;
begin
  for i :=  Low(A) to High(A) - 1 do
    for j := High(A) downto i + 1 do
      if A[i] > A[j] then
      begin
        VisualSwap(A[i], A[j], i, j);
        t := A[i];
        A[i] := A[j];
        A[j] := t;
        if Terminated then Exit;
      end;

end;

{ TQuickSort }

procedure TQuickSort.Sort(var A: array of integer);

  procedure QuickSort(var A: array of integer; iLo, iHi: integer);
  var
    Lo, Hi, Mid, t: integer;
  begin
    Lo := iLo;
    Hi := iHi;
    Mid := A[(Lo + Hi) div 2];
    repeat
      while A[Lo] < Mid do Inc(Lo);
      while A[Hi] > Mid do Dec(Hi);
      if Lo <= Hi then
      begin
        VisualSwap(A[Lo], A[Hi], Lo, Hi);
        t := A[Lo];
        A[Lo] := A[Hi];
        A[Hi] := t;
        Inc(Lo);
        Dec(Hi);
      end;
    until Lo > Hi;
    if Hi > iLo then QuickSort(A, iLo, Hi);
    if Lo < iHi then QuickSort(A, Lo, iHi);
    if Terminated then Exit;
  end;

begin
  QuickSort(A, Low(A), High(A));
end;

end.