开发环境是Delphi7
此处用的是临界；信号量，互斥就不做测试了！
仅仅是测试，哈哈
=================Unit
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo2: TMemo;
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TMythread=class(TThread)
protected
procedure Execute;override;
end;
var
Form1: TForm1;
Critical:TRTLCriticalSection ;
A:Integer;
MyThread:TMythread;
implementation
{$R *.dfm}
var
WaitLockBool: boolean; //主线程的该操作是否处于等待状态
function PubF(Ini:Integer ;var AA:integer):string;
var
vstr:string;
i:Integer;
begin
EnterCriticalSection(Critical);//进入临界段
Form1.Memo2.Lines.Add('开启');
for i:=0 to 2 do
begin
Sleep(1000);
Application.ProcessMessages ;
inc(AA);
Form1.Memo2.Lines.Add('Str_'+inttostr(AA)+' '+inttostr(i)+' '+ IntToStr(ini));
end;
Form1.Memo2.Lines.Add('关闭');
Result :='Str_'+inttostr(AA)+' '+inttostr(i)+' '+ IntToStr(ini);
LeaveCriticalSection(Critical);//退出临界段
end;
procedure PMainWaitLock; //主线程等待临界区执行完成
var
i,vCount: integer;
begin
WaitLockBool := true;
vCount:=12000; //如果看不出效果，请把这个参数改小，改成vCount:=1200 或者120
for i:=1 to vCount do //超时时长，可根据实际情况进行设置
begin
if Critical.LockCount<>-1 then
begin
Application.ProcessMessages;
sleep(1); //休眠1毫秒
end
else
break;
end;
if (i<vCount) then
WaitLockBool := false;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitializeCriticalSection(Critical);
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
DeleteCriticalSection(Critical);
if MyThread<>nil then
if not MyThread.Terminated then
begin
MyThread.Terminate;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
MyThread:=TMythread.Create(False);
end;
{ TMythread }
procedure TMythread.Execute;
var
i,AA:Integer;
begin
AA:=0;
for I := 1 to 2 do
begin
Sleep(1000);
PubF(i,AA);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
var
AA:Integer;
begin
AA:=1000;
PMainWaitLock;
if not WaitLockBool then
PubF(10,AA)
else
ShowMessage('被占用，请重试！')
end;
end.
==============Form
object Form1: TForm1
Left = 669
Top = 413
Width = 326
Height = 508
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnClose = FormClose
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object Button1: TButton
Left = 48
Top = 384
Width = 75
Height = 25
Caption = 'B1_线程'
TabOrder = 0
OnClick = Button1Click
end
object Button2: TButton
Left = 192
Top = 384
Width = 75
Height = 25
Caption = 'B2主'
TabOrder = 1
OnClick = Button2Click
end
object Memo2: TMemo
Left = 24
Top = 16
Width = 273
Height = 241
ImeName = '中文(简体) - 搜狗拼音输入法'
ScrollBars = ssBoth
TabOrder = 2
end
end
