Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 5

Project THPRIOR

Project Structure


THPRIOR.DPR

program ThPrior;

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

{$R *.RES}

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

MAINFORM.PAS

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.

PAINTTH.PAS

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.

MAINFORM.DFM

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