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 THWAIT

Project Structure


THWAIT.DPR

program ThWait;

uses
  Forms,
  MainForm in 'MainForm.pas' {Form1},
  CheckTh in 'CheckTh.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, ComCtrls, CheckTh;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ProgressBar1: TProgressBar;
    ProgressBar2: TProgressBar;
    ProgressBar3: TProgressBar;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    ProgressBar4: TProgressBar;
    ProgressBar5: TProgressBar;
    Edit1: TEdit;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
  private
    MainThread: TMultiFind;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  I: Integer;
begin
  if Assigned (MainThread) then
    MainThread.Free;
  MainThread := TMultiFind.Create (True);
  MainThread.Progresses [1] := ProgressBar1;
  MainThread.Progresses [2] := ProgressBar2;
  MainThread.Progresses [3] := ProgressBar3;
  MainThread.Progresses [4] := ProgressBar4;
  MainThread.Progresses [5] := ProgressBar5;
  MainThread.Progresses [1].Max := 4;
  for I := 2 to 5 do
    MainThread.Progresses[I].Max := Memo1.Lines.Count;
  for I := 1 to 5 do
    MainThread.Progresses[I].Position := 0;

  MainThread.LookFor := Edit1.Text;
  MainThread.Resume;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if OpenDialog1.Execute then
    Memo1.Lines.LoadFromFile (OpenDialog1.FileName);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  if Assigned (MainThread) then
    MainThread.Free;
end;

procedure TForm1.Edit1Exit(Sender: TObject);
begin
  if Length (Edit1.Text) <> 4 then
  begin
    Edit1.SetFocus;
    ShowMessage ('The edit box requires four characters');
  end;
end;

end.

CHECKTH.PAS

unit CheckTh;

interface

uses
  Classes, Graphics, ComCtrls;

type
  TFindThread = class(TThread)
  protected
    Progr: Integer;
    procedure UpdateProgress;
    procedure Execute; override;
  public
    Found: Integer;
    LookFor: Char;
    Progress: TProgressBar;
  end;

type
  TMultiFind = class(TThread)
  protected
    Progr: Integer;
    procedure UpdateProgress;
    procedure Execute; override;
    procedure Show;
  public
    LookFor, Output: String;
    Progresses: array [1..5] of TProgressBar;
  end;

implementation

{ TPainterThread }

uses
  MainForm, Dialogs, SysUtils;

procedure TFindThread.Execute;
var
  I, J: Integer;
  Line: string;
begin
  Found := 0;
  with Form1.Memo1 do
    for I := 0 to Lines.Count - 1 do
    begin
      Line := Lines [I];
      for J := 1 to Length (Line) do
        if Line [J] = LookFor then
          Inc (Found);
      Progr := I + 1;
      Synchronize (UpdateProgress);
    end;
end;

procedure TFindThread.UpdateProgress;
begin
  Progress.Position := Progr;
end;

procedure TMultiFind.Execute;
var
  Finders: array [1..4] of TFindThread;
  I: Integer;
begin
  // setup the four threads
  for I := 1 to 4 do
  begin
    Finders[I] := TFindThread.Create (True);
    Finders[I].LookFor := LookFor[I];
    Finders[I].Progress := Progresses [I+1];
    Finders[I].Resume;
  end;

  // wait the threads to end...
  for I := 1 to 4 do
  begin
    Finders[I].WaitFor;
    Progr := I;
    Synchronize (UpdateProgress);
  end;

  // show the result
  Output := 'Found: ';
  for I := 1 to 4 do
    Output := Output + Format ('%d %s, ',
      [Finders[I].Found, LookFor[I]]);
  Synchronize (Show);

  // delete threads
  for I := 1 to 4 do
    Finders[I].Free;
end;

procedure TMultiFind.UpdateProgress;
begin
  Progresses[1].Position := Progr;
end;

procedure TMultiFind.Show;
begin
  ShowMessage (Output);
end;

end.

MAINFORM.DFM

object Form1: TForm1
  Left = 245
  Top = 126
  Width = 462
  Height = 278
  Caption = 'Thread WaitFor'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object Label1: TLabel
    Left = 281
    Top = 12
    Width = 23
    Height = 13
    Caption = 'Find:'
  end
  object Button1: TButton
    Left = 360
    Top = 40
    Width = 67
    Height = 25
    Caption = 'Start'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Memo1: TMemo
    Left = 8
    Top = 8
    Width = 241
    Height = 233
    Lines.Strings = (
      'Sample text: '
      'load a text file for a more '
      'complete test')
    TabOrder = 1
  end
  object ProgressBar1: TProgressBar
    Left = 280
    Top = 72
    Width = 150
    Height = 13
    Min = 0
    Max = 3
    TabOrder = 2
  end
  object ProgressBar2: TProgressBar
    Left = 280
    Top = 96
    Width = 150
    Height = 13
    Min = 0
    Max = 3
    TabOrder = 3
  end
  object ProgressBar3: TProgressBar
    Left = 280
    Top = 120
    Width = 150
    Height = 13
    Min = 0
    Max = 3
    TabOrder = 4
  end
  object Button2: TButton
    Left = 280
    Top = 40
    Width = 65
    Height = 25
    Caption = 'Load...'
    TabOrder = 5
    OnClick = Button2Click
  end
  object ProgressBar4: TProgressBar
    Left = 280
    Top = 144
    Width = 150
    Height = 13
    Min = 0
    Max = 100
    TabOrder = 6
  end
  object ProgressBar5: TProgressBar
    Left = 280
    Top = 168
    Width = 150
    Height = 13
    Min = 0
    Max = 100
    TabOrder = 7
  end
  object Edit1: TEdit
    Left = 312
    Top = 8
    Width = 65
    Height = 21
    MaxLength = 4
    TabOrder = 8
    Text = 'Marc'
    OnExit = Edit1Exit
  end
  object OpenDialog1: TOpenDialog
    Filter = 'Text file (*.txt)|*.txt|Any file (*.*)|*.*'
    Left = 272
    Top = 208
  end
end