Home: Code Repository: Mastering Delphi 5

Project THWAIT

Project Structure

THWAIT.DPR
MAINFORM.PAS
CHECKTH.PAS
MAINFORM.DFM

program ThWait;

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

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.

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