New book: Delphi 2007 Handbook
My blog in online
Delphi tech support service: support.marcocantu.com

Menu for Development

Development

Code Repository

Site Menu

Delphi 2007 Handbook

Mastering Borland Delphi 2005

Essential Pascal

Essential Delphi

Buy Books Online

Code Repository

Newsgroups

White Papers

Tools

Conferences

Training

Delphi Links

Contact Marco

	My Other Sites
	Italian Site (www.marcocantu.it)
	Developers Newsgroups Browser (dev.newswhat.com)
	My town (www.piazzacavalli.net)
	the delphi search
	Wintech Italia (my company)

	Breaking News
	Buy Mastering Borland Delphi 2005 from Amazon
	Free ebook: Mastering Delphi Update for Delphi 2006

	Advertising

Home: Code Repository: Mastering Delphi 5

Project THSYNCH

Project Structure

THSYNCH.DPR

program ThSynch;

uses
  Forms,
  SyncForm in 'SyncForm.pas' {Form1},
  Mutex in 'Mutex.pas' {Form4},
  Plain in 'Plain.pas' {Form2},
  CritSec in 'CritSec.pas' {Form3},
  TCriSect in 'TCriSect.pas' {Form5};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.CreateForm(TForm4, Form4);
  Application.CreateForm(TForm2, Form2);
  Application.CreateForm(TForm3, Form3);
  Application.CreateForm(TForm5, Form5);
  Application.Run;
end.

SYNCFORM.PAS

unit SyncForm;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

uses
  Plain, CritSec, Mutex, TCriSect;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Form2.Show;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Form3.Show;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
  Form4.Show;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  Form5.Show;
end;

end.

MUTEX.PAS

unit Mutex;

interface

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

type
  TListThread = class (TThread)
  private
    Str: String;
  protected
    procedure AddToList;
    procedure Execute; override;
  public
    LBox: TListBox;
  end;

  TForm4 = class(TForm)
    BtnStart: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Th1, Th2: TListThread;
  public
    { Public declarations }
  end;

var
  Form4: TForm4;
  Letters: string = 'AAAAAAAAAAAAAAAAAAAA';
  hMutex: THandle;

implementation

{$R *.DFM}

procedure TListThread.AddToList;
begin
  if Assigned (LBox) then
    LBox.Items.Add (Str);
end;

procedure TListThread.Execute;
var
  I, J, K: Integer;
begin
  for I := 0 to 50 do
  begin
    WaitForSingleObject (hMutex, INFINITE);
    for J := 1 to 20 do
      for K := 1 to 2601 do // useless repetition...
        if Letters [J] < 'Z' then
          Letters [J] := Succ (Letters [J])
        else
          Letters [J] := 'A';
    Str := Letters;
    ReleaseMutex (hMutex);
    Synchronize (AddToList);
  end;
end;

procedure TForm4.BtnStartClick(Sender: TObject);
begin
  ListBox1.Clear;
  ListBox2.Clear;
  Th1 := TListThread.Create (True);
  Th2 := TListThread.Create (True);
  Th1.FreeOnTerminate := True;
  Th2.FreeOnTerminate := True;
  Th1.LBox := Listbox1;
  Th2.LBox := Listbox2;
  Th1.Resume;
  Th2.Resume;
end;

procedure TForm4.FormCreate(Sender: TObject);
begin
  hMutex := CreateMutex (nil, false, nil);
end;

procedure TForm4.FormDestroy(Sender: TObject);
begin
  CloseHandle (hMutex);
end;


end.

PLAIN.PAS

unit Plain;

interface

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

type
  TListThread = class (TThread)
  private
    Str: String;
  protected
    procedure AddToList;
    procedure Execute; override;
  public
    LBox: TListBox;
  end;

  TForm2 = class(TForm)
    ListBox1: TListBox;
    ListBox2: TListBox;
    BtnStart: TButton;
    procedure BtnStartClick(Sender: TObject);
  private
    Th1, Th2: TListThread;
  public
    { Public declarations }
  end;

var
  Form2: TForm2;
  Letters: string = 'AAAAAAAAAAAAAAAAAAAA';

implementation

{$R *.DFM}

procedure TListThread.AddToList;
begin
  if Assigned (LBox) then
    LBox.Items.Add (Str);
end;

procedure TListThread.Execute;
var
  I, J, K: Integer;
begin
  for I := 0 to 50 do
  begin
    for J := 1 to 20 do
      for K := 1 to 2601 do // useless repetition...
        if Letters [J] < 'Z' then
          Letters [J] := Succ (Letters [J])
        else
          Letters [J] := 'A';
    Str := Letters;
    Synchronize (AddToList);
  end;
end;

procedure TForm2.BtnStartClick(Sender: TObject);
begin
  ListBox1.Clear;
  ListBox2.Clear;
  Th1 := TListThread.Create (True);
  Th2 := TListThread.Create (True);
  Th1.FreeOnTerminate := True;
  Th2.FreeOnTerminate := True;
  Th1.LBox := Listbox1;
  Th2.LBox := Listbox2;
  Th1.Resume;
  Th2.Resume;
end;

end.

CRITSEC.PAS

unit CritSec;

interface

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

type
  TListThread = class (TThread)
  private
    Str: String;
  protected
    procedure AddToList;
    procedure Execute; override;
  public
    LBox: TListBox;
  end;

  TForm3 = class(TForm)
    BtnStart: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Th1, Th2: TListThread;
  public
    { Public declarations }
  end;

var
  Form3: TForm3;
  Letters: string = 'AAAAAAAAAAAAAAAAAAAA';
  Critical1: TRTLCriticalSection;

implementation

{$R *.DFM}

procedure TListThread.AddToList;
begin
  if Assigned (LBox) then
    LBox.Items.Add (Str);
end;

procedure TListThread.Execute;
var
  I, J, K: Integer;
begin
  for I := 0 to 50 do
  begin
    EnterCriticalSection (Critical1);
    for J := 1 to 20 do
      for K := 1 to 2601 do // useless repetition...
        if Letters [J] < 'Z' then
          Letters [J] := Succ (Letters [J])
        else
          Letters [J] := 'A';
    Str := Letters;
    LeaveCriticalSection (Critical1);
    Synchronize (AddToList);
  end;
end;

procedure TForm3.BtnStartClick(Sender: TObject);
begin
  ListBox1.Clear;
  ListBox2.Clear;
  Th1 := TListThread.Create (True);
  Th2 := TListThread.Create (True);
  Th1.FreeOnTerminate := True;
  Th2.FreeOnTerminate := True;
  Th1.LBox := Listbox1;
  Th2.LBox := Listbox2;
  Th1.Resume;
  Th2.Resume;
end;

procedure TForm3.FormCreate(Sender: TObject);
begin
  InitializeCriticalSection (Critical1);
end;

procedure TForm3.FormDestroy(Sender: TObject);
begin
  DeleteCriticalSection (Critical1);
end;


end.

TCRISECT.PAS

unit TCriSect;

interface

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

type
  TListThread = class (TThread)
  private
    Str: String;
  protected
    procedure AddToList;
    procedure Execute; override;
  public
    LBox: TListBox;
  end;

  TForm5 = class(TForm)
    BtnStart: TButton;
    ListBox1: TListBox;
    ListBox2: TListBox;
    procedure BtnStartClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    Th1, Th2: TListThread;
  public
    { Public declarations }
  end;

var
  Form5: TForm5;
  Letters: string = 'AAAAAAAAAAAAAAAAAAAA';
  Critical1: TCriticalSection;

implementation

{$R *.DFM}

procedure TListThread.AddToList;
begin
  if Assigned (LBox) then
    LBox.Items.Add (Str);
end;

procedure TListThread.Execute;
var
  I, J, K: Integer;
begin
  for I := 0 to 50 do
  begin
    Critical1.Enter;
    for J := 1 to 20 do
      for K := 1 to 2601 do // useless repetition...
        if Letters [J] < 'Z' then
          Letters [J] := Succ (Letters [J])
        else
          Letters [J] := 'A';
    Str := Letters;
    Critical1.Leave;
    Synchronize (AddToList);
  end;
end;

procedure TForm5.BtnStartClick(Sender: TObject);
begin
  ListBox1.Clear;
  ListBox2.Clear;
  Th1 := TListThread.Create (True);
  Th2 := TListThread.Create (True);
  Th1.FreeOnTerminate := True;
  Th2.FreeOnTerminate := True;
  Th1.LBox := Listbox1;
  Th2.LBox := Listbox2;
  Th1.Resume;
  Th2.Resume;
end;

procedure TForm5.FormCreate(Sender: TObject);
begin
  Critical1 := TCriticalSection.Create;
end;

procedure TForm5.FormDestroy(Sender: TObject);
begin
  Critical1.Free;
end;

end.

SYNCFORM.DFM

object Form1: TForm1
  Left = 142
  Top = 220
  Width = 296
  Height = 127
  Caption = 'Thread Win32 Synch'
  Font.Charset = ANSI_CHARSET
  Font.Color = clBlack
  Font.Height = -13
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  PixelsPerInch = 96
  TextHeight = 16
  object Button1: TButton
    Left = 12
    Top = 12
    Width = 125
    Height = 30
    Caption = 'Plain'
    TabOrder = 0
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 144
    Top = 12
    Width = 129
    Height = 30
    Caption = 'Critical Section (API)'
    TabOrder = 1
    OnClick = Button2Click
  end
  object Button3: TButton
    Left = 12
    Top = 53
    Width = 125
    Height = 30
    Caption = 'Mutex (API)'
    TabOrder = 2
    OnClick = Button3Click
  end
  object Button4: TButton
    Left = 144
    Top = 52
    Width = 129
    Height = 30
    Caption = 'TCriticalSection'
    TabOrder = 3
    OnClick = Button4Click
  end
end

MUTEX.DFM

object Form4: TForm4
  Left = 249
  Top = 170
  Width = 449
  Height = 274
  Caption = 'Mutex'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -10
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object BtnStart: TButton
    Left = 7
    Top = 7
    Width = 60
    Height = 20
    Caption = 'Start'
    TabOrder = 0
    OnClick = BtnStartClick
  end
  object ListBox1: TListBox
    Left = 7
    Top = 32
    Width = 210
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 1
  end
  object ListBox2: TListBox
    Left = 222
    Top = 32
    Width = 211
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 2
  end
end

PLAIN.DFM

object Form2: TForm2
  Left = 193
  Top = 110
  Width = 448
  Height = 275
  Caption = 'Plain'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -10
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object ListBox1: TListBox
    Left = 7
    Top = 30
    Width = 210
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 0
  end
  object ListBox2: TListBox
    Left = 222
    Top = 30
    Width = 211
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 1
  end
  object BtnStart: TButton
    Left = 7
    Top = 7
    Width = 60
    Height = 20
    Caption = 'Start'
    TabOrder = 2
    OnClick = BtnStartClick
  end
end

CRITSEC.DFM

object Form3: TForm3
  Left = 218
  Top = 140
  Width = 449
  Height = 274
  Caption = 'Critical Section'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -10
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object BtnStart: TButton
    Left = 7
    Top = 7
    Width = 60
    Height = 20
    Caption = 'Start'
    TabOrder = 0
    OnClick = BtnStartClick
  end
  object ListBox1: TListBox
    Left = 7
    Top = 32
    Width = 210
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 1
  end
  object ListBox2: TListBox
    Left = 222
    Top = 32
    Width = 211
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 2
  end
end

TCRISECT.DFM

object Form5: TForm5
  Left = 229
  Top = 147
  Width = 448
  Height = 274
  Caption = 'TCriticalSection'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object BtnStart: TButton
    Left = 7
    Top = 7
    Width = 60
    Height = 20
    Caption = 'Start'
    TabOrder = 0
    OnClick = BtnStartClick
  end
  object ListBox1: TListBox
    Left = 7
    Top = 32
    Width = 210
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 1
  end
  object ListBox2: TListBox
    Left = 222
    Top = 32
    Width = 211
    Height = 211
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -13
    Font.Name = 'Courier New'
    Font.Style = []
    ItemHeight = 16
    ParentFont = False
    TabOrder = 2
  end
end