exampleofthreads

example of threads

{ thsorts.dpr }

program ThSorts;

uses
Forms,
main in 'main.pas' {Form1},
secform in 'secform.pas' {Form2},
thform in 'thform.pas' {Form3};

{$R *.RES}

begin
Application.CreateForm(TForm1, Form1);
Application.CreateForm(TForm2, Form2);
Application.CreateForm(TForm3, Form3);
Application.Run;
end.

{ main.pas }

unit main;

interface

uses
SysUtils, WinTypes, WinProcs,
Messages, Classes, Graphics,
Controls, Forms, Dialogs,
StdCtrls, ComCtrls, Buttons;

type
TForm1 = class(TForm)
    Edit1: TEdit;
    Label2: TLabel;
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    BitBtn1: TBitBtn;
    BubbleTrackBar: TTrackBar;
    QuickTrackBar: TTrackBar;
    procedure Button1Click(Sender: TObject);
private
    { Private declarations }
    T1 : THandle;
    T2 : THandle;
public
    { Public declarations }
end;

TForm2 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

TForm3 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

const
aMax = 300;

var
Form1: TForm1;
Form2: TForm2;
Form3: TForm3;
a,b : array[0..aMax-1] of integer;
numItems : integer;

implementation

{$R *.DFM}

procedure BubbleSort(var ia:array of integer; items: integer);
var
i,j,t : integer;
begin
for i := items downto 0 do
begin
    for j := 0 to items-1 do
      if ia[j] < ia[j+1] then
      begin
        t := ia[j];
        form2.canvas.pixels[ia[j+1]+5,j+1+5] := clBlue;
        form2.canvas.pixels[ia[j]+5,j+5] := clBlue;
        ia[j] := ia[j+1];
        ia[j+1] := t;
        form2.canvas.pixels[ia[j+1]+5,j+1+5] := clYellow;
        form2.canvas.pixels[ia[j]+5,j+5] := clYellow;
      end;
   end;
end;

procedure QuickSort(var ia:array of integer; iLo,iHi : integer);
var
Lo,Hi,Mid,T : integer;
begin
Lo := iLo;
Hi := iHi;
mid := ia[(Lo+hi) div 2];
repeat
    while ia[Lo] < mid do Inc(Lo);
    while ia[Hi] > mid do Dec(Hi);
    if Lo <= Hi then
    begin
      T := ia[Lo];
      form3.canvas.pixels[ia[Lo]+5,Lo+5] := clBlue;
      form3.canvas.pixels[ia[Hi]+5,Hi+5] := clBlue;
      ia[Lo] := ia[Hi];
      ia[Hi] := T;
      form3.canvas.pixels[ia[Lo]+5,Lo+5] := clLime;
      form3.canvas.pixels[ia[Hi]+5,Hi+5] := clLime;
      inc(Lo);
      dec(Hi);
    end;
until Lo > Hi;
if Hi > iLo then QuickSort(ia,iLo,Hi);
if Lo < iHi then QuickSort(ia,Lo,iHi);
end;

function BubbleThread(parms:pointer) : LongInt; far;
begin
BubbleSort(a,numItems-1);
end;

function QuickThread(parms:pointer) : LongInt; far;
begin
QuickSort(b,0,numItems-1);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i : integer;
ThreadID : dWord;
begin
numItems := strToInt(Edit1.Text);
if numItems <= aMax then
begin
    form2.free;
    form2 := TForm2.Create(self);
    form2.top := 140;
    form2.left := 2;
    form2.clientheight := numItems+10;
    form2.clientwidth := numItems+10;
    form2.color := clBlue;
    form2.caption := 'Bubble Sort';
    form2.show;

    form3.free;
    form3 := TForm3.Create(self);
    form3.top := 140;
    form3.left := 320;
    form3.clientheight := numItems+10;
    form3.clientwidth := numItems+10;
    form3.color := clBlue;
    form3.caption := 'Quick Sort';
    form3.show;

    Randomize;
    for i := 0 to numItems-1 do
    begin
      a[i] := random(numItems);
      b[i] := a[i];
      form2.canvas.pixels[a[i]+5,i+5] := clYellow;
      form3.canvas.pixels[b[i]+5,i+5] := clLime;
    end;
    T1 := createThread(nil,0,@BubbleThread,nil,0,threadID);
    setThreadPriority(T1,BubbleTrackBar.Position);
    T2 := createThread(nil,0,@QuickThread,nil,0,threadID);
    setThreadPriority(T2,QuickTrackBar.Position);
{ BubbleSort(a,j-1);
    QuickSort(b,0,j-1); }
end
else
    Form1.Caption := 'Too Large!';
end;

end.

{ main.dfm }

object Form1: TForm1
Left = 192
Top = 107
Width = 309
Height = 186
Caption = 'Threaded Sorts'
Font.Color = clWindowText
Font.Height = -13
Font.Name = 'System'
Font.Style = []
PixelsPerInch = 96
TextHeight = 16
object Label2: TLabel
    Left = 8
    Top = 0
    Width = 36
    Height = 19
    Caption = 'Items'
end
object Label1: TLabel
    Left = 0
    Top = 51
    Width = 76
    Height = 16
    Caption = 'Bubble Sort'
end
object Label3: TLabel
    Left = 10
    Top = 83
    Width = 66
    Height = 16
    Caption = 'Quick Sort'
end
object Label4: TLabel
    Left = 32
    Top = 32
    Width = 46
    Height = 16
    Caption = 'Priority'
    Color = clSilver
    Font.Color = clNavy
    Font.Height = -13
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
end
object Label5: TLabel
    Left = 87
    Top = 32
    Width = 140
    Height = 16
    Caption = '-2             0             +2'
    Color = clSilver
    Font.Color = clNavy
    Font.Height = -13
    Font.Name = 'System'
    Font.Style = [fsBold]
    ParentColor = False
    ParentFont = False
end
object Edit1: TEdit
    Left = 52
    Top = 0
    Width = 53
    Height = 24
    TabOrder = 0
    Text = '300'
end
object BitBtn1: TBitBtn
    Left = 120
    Top = 0
    Width = 113
    Height = 27
    Caption = 'Start Sorting'
    TabOrder = 1
    OnClick = Button1Click
    Glyph.Data = {
      36050000424D360500000000000036040000280000000F000000100000000100
      08000000000000010000CE0E0000C40E00000000000000000000000000000000
      80000080000000808000800000008000800080800000C0C0C000C0DCC000F0CA
      A6003F3F5F003F3F7F003F3F9F003F3FBF003F3FDF003F3FFF003F5F3F003F5F
      5F003F5F7F003F5F9F003F5FBF003F5FDF003F5FFF003F7F3F003F7F5F003F7F
      7F003F7F9F003F7FBF003F7FDF003F7FFF003F9F3F003F9F5F003F9F7F003F9F
      9F003F9FBF003F9FDF003F9FFF003FBF3F003FBF5F003FBF7F003FBF9F003FBF
      BF003FBFDF003FBFFF003FDF3F003FDF5F003FDF7F003FDF9F003FDFBF003FDF
      DF003FDFFF003FFF3F003FFF5F003FFF7F003FFF9F003FFFBF003FFFDF003FFF
      FF005F3F3F005F3F5F005F3F7F005F3F9F005F3FBF005F3FDF005F3FFF005F5F
      3F005F5F5F005F5F7F005F5F9F005F5FBF005F5FDF005F5FFF005F7F3F005F7F
      5F005F7F7F005F7F9F005F7FBF005F7FDF005F7FFF005F9F3F005F9F5F005F9F
      7F005F9F9F005F9FBF005F9FDF005F9FFF005FBF3F005FBF5F005FBF7F005FBF
      9F005FBFBF005FBFDF005FBFFF005FDF3F005FDF5F005FDF7F005FDF9F005FDF
      BF005FDFDF005FDFFF005FFF3F005FFF5F005FFF7F005FFF9F005FFFBF005FFF
      DF005FFFFF007F3F3F007F3F5F007F3F7F007F3F9F007F3FBF007F3FDF007F3F
      FF007F5F3F007F5F5F007F5F7F007F5F9F007F5FBF007F5FDF007F5FFF007F7F
      3F007F7F5F007F7F7F007F7F9F007F7FBF007F7FDF007F7FFF007F9F3F007F9F
      5F007F9F7F007F9F9F007F9FBF007F9FDF007F9FFF007FBF3F007FBF5F007FBF
      7F007FBF9F007FBFBF007FBFDF007FBFFF007FDF3F007FDF5F007FDF7F007FDF
      9F007FDFBF007FDFDF007FDFFF007FFF3F007FFF5F007FFF7F007FFF9F007FFF
      BF007FFFDF007FFFFF009F3F3F009F3F5F009F3F7F009F3F9F009F3FBF009F3F
      DF009F3FFF009F5F3F009F5F5F009F5F7F009F5F9F009F5FBF009F5FDF009F5F
      FF009F7F3F009F7F5F009F7F7F009F7F9F009F7FBF009F7FDF009F7FFF009F9F
      3F009F9F5F009F9F7F009F9F9F009F9FBF009F9FDF009F9FFF009FBF3F009FBF
      5F009FBF7F009FBF9F009FBFBF009FBFDF009FBFFF009FDF3F009FDF5F009FDF
      7F009FDF9F009FDFBF009FDFDF009FDFFF009FFF3F009FFF5F009FFF7F009FFF
      9F009FFFBF009FFFDF009FFFFF00BF3F3F00BF3F5F00BF3F7F00BF3F9F00BF3F
      BF00BF3FDF00BF3FFF00BF5F3F00BF5F5F00BF5F7F00BF5F9F00BF5FBF00BF5F
      DF00BF5FFF00BF7F3F00BF7F5F00BF7F7F00BF7F9F00BF7FBF00BF7FDF00BF7F
      FF00BF9F3F00BF9F5F00BF9F7F00BF9F9F00BF9FBF00BF9FDF00BF9FFF00BFBF
      3F00BFBF5F00BFBF7F00BFBF9F00BFBFBF00BFBFDF00BFBFFF00BFDF3F00BFDF
      5F00BFDF7F00BFDF9F00BFDFBF00BFDFDF00F0FBFF00A4A0A000808080000000
      FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00070707070707
      070707070707070707000707070707F807070707070707070700070707070700
      00070707070707070700070707070700FF000707070707070700070707070700
      FBFF0007070707070700070707F80000FF0000F80707070707000707070700FF
      FB000707070707070700070707070700FFFB0007070707070700070707070700
      FBFFFB000707070707000707F8000000FF000000F8070707070007070700FBFF
      FBFF00070707070707000707070700FBFFFBFF000707070707000707070700FF
      FBFFFBFF0007070707000707070707000000000000F807070700070707070707
      0707070707070707070007070707070707070707070707070700}
end
object BubbleTrackBar: TTrackBar
    Left = 88
    Top = 56
    Width = 145
    Height = 17
    TickStyle = tsAuto
    TickMarks = tmBottomRight
    Orientation = tbHorizontal
    Position = 0
    SelStart = 0
    SelEnd = 0
    Min = -2
    Max = 2
end
object QuickTrackBar: TTrackBar
    Left = 88
    Top = 80
    Width = 142
    Height = 17
    TickStyle = tsAuto
    TickMarks = tmBottomRight
    Orientation = tbHorizontal
    Position = 0
    SelStart = 0
    SelEnd = 0
    Min = -2
    Max = 2
end
end

{ secform.pas }

unit secform;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm2 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form2: TForm2;

implementation

{$R *.DFM}

end.

{ secform.dfm }

object Form2: TForm2
Left = 200
Top = 104
Width = 435
Height = 300
Caption = 'Form2'
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
end

{ thform.pas }

unit thform;

interface

uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs;

type
TForm3 = class(TForm)
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form3: TForm3;

implementation

{$R *.DFM}

end.

{ thform.dfm }

object Form3: TForm3
Left = 200
Top = 104
Width = 435
Height = 300
Caption = 'Form3'
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
PixelsPerInch = 96
TextHeight = 13
end