Home:
Code Repository:
Mastering Delphi 5
Project THSYNCH
Project Structure
- THSYNCH.DPR
SYNCFORM.PAS
MUTEX.PAS
PLAIN.PAS
CRITSEC.PAS
TCRISECT.PAS
SYNCFORM.DFM
MUTEX.DFM
PLAIN.DFM
CRITSEC.DFM
TCRISECT.DFM
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
