📄 main.pas
字号:
unit main;
{ Copyright (c) 1996 by Charlie Calvert
Shows how to use Mutexs when working with threads.
The program intentionally creates an error condition
and then shows how to use Mutexs to straighten
the program out. }
interface
uses
Windows, Messages, SysUtils,
Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls,
Menus;
const
TotalCount = 20;
type
TForm1 = class(TForm)
ListBox1: TListBox;
ListBox2: TListBox;
MainMenu1: TMainMenu;
Options1: TMenuItem;
RunThread1: TMenuItem;
UseMutex1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure RunThread1Click(Sender: TObject);
procedure UseMutex1Click(Sender: TObject);
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
var
UseMutex: Boolean;
hMutex: THandle;
GlobalData: Integer;
/////////////////////////////////////////////////////////
// The thread routine
/////////////////////////////////////////////////////////
function ThreadFunc1(P: Pointer): LongInt; stdcall;
var
i, j: Integer;
S: string;
begin
Form1.ListBox1.Items.Clear;
for j := 0 to TotalCount do begin
if (UseMutex) then WaitForSingleObject(hMutex, INFINITE);
Sleep(3);
Inc(GlobalData, 3);
i := GlobalData - 3;
S := Format('Information: %d', [i]);
SendMessage(Form1.ListBox1.Handle, lb_AddString, 0, LongInt(S));
Dec(GlobalData, 3);
if (UseMutex) then ReleaseMutex(hMutex);
end;
Result := 0;
end;
/////////////////////////////////////////////////////////
// The thread routine
/////////////////////////////////////////////////////////
function ThreadFunc2(P: Pointer): LongInt; stdcall;
var
i, j: Integer;
S: string;
begin
Form1.ListBox2.Clear;
for j := 0 to TotalCount do begin
if (UseMutex) then WaitForSingleObject(hMutex, INFINITE);
Sleep(3);
Dec(GlobalData, 3);
i := GlobalData + 3;
S := Format('Information: %d', [i]);
SendMessage(Form1.ListBox2.Handle, lb_AddString, 0, LongInt(S));
Inc(GlobalData, 3);
if (UseMutex) then ReleaseMutex(hMutex);
end;
Result := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
hMutex := CreateMutex(nil, False, nil);
UseMutex := False;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
CloseHandle(hMutex);
end;
procedure TForm1.RunThread1Click(Sender: TObject);
var
ThreadID1: DWord;
ThreadID2: DWord;
ThreadHandles: array [0..1] of THandle;
begin
GlobalData := 100;
ThreadHandles[0] := CreateThread(nil, 0, @ThreadFunc1,
nil, 0, ThreadID1);
ThreadHandles[1] := CreateThread(nil, 0, @ThreadFunc2,
nil, 0, ThreadID2);
if (ThreadHandles[0] = 0) or (ThreadHandles[1] = 0) then
MessageBox(Handle, 'No Thread', nil, MB_OK);
end;
procedure TForm1.UseMutex1Click(Sender: TObject);
begin
UseMutex1.Checked := not UseMutex1.Checked;
UseMutex := UseMutex1.Checked;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -