Home: Code Repository: Mastering Delphi 5

Project THPRIOR

Project Structure

THPRIOR.DPR
MAINFORM.PAS
PAINTTH.PAS
MAINFORM.DFM

program ThPrior;

uses
  Forms,
  MainForm in 'MainForm.pas' {Form1},
  paintth in 'paintth.pas';

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

unit MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, Paintth, ComCtrls;

type
  TForm1 = class(TForm)
    CheckBox1: TCheckBox;
    CheckBox2: TCheckBox;
    CheckBox3: TCheckBox;
    CheckBox4: TCheckBox;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    TrackBar4: TTrackBar;
    procedure CheckBox1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    PT: array [1..4] of TPainterThread;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.CheckBox1Click(Sender: TObject);
begin
  if (Sender as TCheckbox).Checked then
    PT [(Sender as TCheckbox).Tag].Resume
  else
    // basic version
    // PT [(Sender as TCheckbox).Tag].Suspend;
    // safer version:
    PT [(Sender as TCheckbox).Tag].DelayedSuspend;
end;

procedure TForm1.TrackBar1Change(Sender: TObject);
begin
  PT [(Sender as TTrackBar).Tag].Priority :=
    TThreadPriority ((Sender as TTrackBar).Position);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  PT [1] := TPainterThread.Create (clRed);
  PT [2] := TPainterThread.Create (clBlue);
  PT [3] := TPainterThread.Create (clGreen);
  PT [4] := TPainterThread.Create (ClBlack);
end;

end.

unit paintth;

interface

uses
  Classes, Graphics, Windows;

type
  TPainterThread = class(TThread)
  private
    Color: Integer;
    SuspendRequest: Boolean;
  protected
    procedure Execute; override;
  public
    constructor Create (Col: TColor);
    procedure DelayedSuspend;
  end;

implementation

{ TPainterThread }

uses
  MainForm;

constructor TPainterThread.Create(Col: TColor);
begin
  Color:= Col;
  inherited Create (True);
end;

procedure TPainterThread.DelayedSuspend;
begin
  SuspendRequest := True;
end;

procedure TPainterThread.Execute;
var
  X, Y, X1: Integer;
begin
  X := 0;
  Y := 0;
  repeat
    // scan the lines...
    X1 := X + 1;
    X := X1 mod 250;
    Y := Y + X1 div 250;
    Y := Y mod Form1.ClientHeight;

    Form1.Canvas.Lock;
    try
      Form1.Canvas.Pixels [X, Y] := Color;
    finally
      Form1.Canvas.UnLock;
    end;
    if SuspendRequest then
    begin
      Suspend;
      SuspendRequest := False;
    end;
  until Terminated;
end;

end.

object Form1: TForm1
  Left = 307
  Top = 113
  Width = 452
  Height = 278
  Caption = 'Thread Priorities'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object CheckBox1: TCheckBox
    Tag = 1
    Left = 272
    Top = 56
    Width = 65
    Height = 17
    Caption = 'Red'
    TabOrder = 0
    OnClick = CheckBox1Click
  end
  object CheckBox2: TCheckBox
    Tag = 2
    Left = 272
    Top = 96
    Width = 65
    Height = 17
    Caption = 'Blue'
    TabOrder = 1
    OnClick = CheckBox1Click
  end
  object CheckBox3: TCheckBox
    Tag = 3
    Left = 272
    Top = 136
    Width = 65
    Height = 17
    Caption = 'Green'
    TabOrder = 2
    OnClick = CheckBox1Click
  end
  object CheckBox4: TCheckBox
    Tag = 4
    Left = 272
    Top = 176
    Width = 65
    Height = 17
    Caption = 'Black'
    TabOrder = 3
    OnClick = CheckBox1Click
  end
  object TrackBar1: TTrackBar
    Tag = 1
    Left = 336
    Top = 56
    Width = 100
    Height = 25
    Max = 4
    Min = 1
    Orientation = trHorizontal
    PageSize = 1
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 4
    TabStop = False
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
  end
  object TrackBar2: TTrackBar
    Tag = 2
    Left = 336
    Top = 96
    Width = 100
    Height = 25
    Max = 4
    Min = 1
    Orientation = trHorizontal
    PageSize = 1
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 5
    TabStop = False
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
  end
  object TrackBar3: TTrackBar
    Tag = 3
    Left = 336
    Top = 136
    Width = 100
    Height = 25
    Max = 4
    Min = 1
    Orientation = trHorizontal
    PageSize = 1
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 6
    TabStop = False
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
  end
  object TrackBar4: TTrackBar
    Tag = 4
    Left = 336
    Top = 176
    Width = 100
    Height = 25
    Max = 4
    Min = 1
    Orientation = trHorizontal
    PageSize = 1
    Frequency = 1
    Position = 3
    SelEnd = 0
    SelStart = 0
    TabOrder = 7
    TabStop = False
    TickMarks = tmBottomRight
    TickStyle = tsAuto
    OnChange = TrackBar1Change
  end
end