Multithreading — The Delphi Way · © 2000 Martin Harvey
Source example 17
type
TPrimeFrm = class(TForm)
public
StringSemaphore: THandle;
property StringBuf: TStringList read FStringBuf write FStringBuf;
end;
procedure TPrimeFrm.StartBtnClick(Sender: TObject);
begin
if not FStringSectInit then
begin
StringSemaphore := CreateSemaphore(nil, 1, 1, SemName);
FStringBuf := TStringList.Create;
FStringSectInit := true;
FPrimeThread := TPrimeThrd2.Create(true);
SetThreadPriority(FPrimeThread.Handle, THREAD_PRIORITY_BELOW_NORMAL);
try
FPrimeThread.StartNum := StrToInt(StartNumEdit.Text);
except
on EConvertError do FPrimeThread.StartNum := 2;
end;
FPrimeThread.Resume;
end;
UpdateButtons;
end;
procedure TPrimeFrm.StopBtnClick(Sender: TObject);
begin
if FStringSectInit then
begin
with FPrimeThread do
begin
Terminate;
WaitFor;
Free;
end;
FPrimeThread := nil;
FStringBuf.Free;
FStringBuf := nil;
CloseHandle(StringSemaphore);
FStringSectInit := false;
end;
UpdateButtons;
end;
procedure TPrimeFrm.HandleNewData(var Message: TMessage);
begin
if FStringSectInit then
begin
WaitForSingleObject(StringSemaphore, INFINITE);
ResultMemo.Lines.Add(FStringBuf.Strings[0]);
FStringBuf.Delete(0);
ReleaseSemaphore(StringSemaphore, 1, nil);
if ResultMemo.Lines.Count > MaxMemoLines then
ResultMemo.Lines.Delete(0);
end;
end;
procedure TPrimeThrd2.Execute;
var
CurrentNum: integer;
begin
CurrentNum := FStartNum;
while not Terminated do
begin
if IsPrime(CurrentNum) then
begin
WaitForSingleObject(PrimeFrm.StringSemaphore, INFINITE);
PrimeFrm.StringBuf.Add(IntToStr(CurrentNum) + ' is prime.');
ReleaseSemaphore(PrimeFrm.StringSemaphore, 1, nil);
PostMessage(PrimeFrm.Handle, WM_DATA_IN_BUF, 0, 0);
end;
Inc(CurrentNum);
end;
end;