function ThreadFunc1(): Integer; stdcall; var Count:Integer; begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin try for Count := 0 to 100 do begin Sleep(2); Form1.Edit1.Text := IntToStr(Count); end; Form1.Edit1.Text := '线程1结束'; sleep(200); finally ReleaseMutex(hMutex); end; end; end;
function ThreadFunc2(): Integer; stdcall; var Count:Integer; begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin try for Count := 100 to 200 do begin Sleep(2); Form1.Edit1.Text := IntToStr(Count); end; Form1.Edit1.Text := '线程2结束'; sleep(200); finally ReleaseMutex(hMutex); end; end; end;
function ThreadFunc3(): Integer; stdcall; var Count:Integer; begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin try for Count := 200 to 300 do begin Sleep(2); Form1.Edit1.Text := IntToStr(Count); end; Form1.Edit1.Text := '线程3结束'; sleep(200); finally ReleaseMutex(hMutex); end; end; end;
function ThreadFunc4(): Integer; stdcall; var Count:Integer; begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin try for Count := 300 to 400 do begin Sleep(2); Form1.Edit1.Text := IntToStr(Count); end; Form1.Edit1.Text := '线程4结束'; sleep(200); finally ReleaseMutex(hMutex); end; end; end;
function ThreadFunc5(): Integer; stdcall; var Count:Integer; begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin try for Count := 400 to 500 do begin Sleep(2); Form1.Edit1.Text := IntToStr(Count); end; Form1.Edit1.Text := '线程5结束'; sleep(200); finally ReleaseMutex(hMutex); end; end; end;
function ThreadFunc6(): Integer; stdcall; var Count:Integer; begin if WaitForSingleObject(hMutex,INFINITE)=WAIT_OBJECT_0 then begin try for Count := 500 to 600 do begin Sleep(2); Form1.Edit1.Text := IntToStr(Count); end; Form1.Edit1.Text := '线程6结束'; sleep(200); finally ReleaseMutex(hMutex); end; end; end;
function CheckThreadFreed(Thread:THandle):Byte; //返回值:0-已释放;1-正在运行;2-已终止但未释放,3-未建立或不存在 var i:DWord; IsQuit: Boolean; begin if Thread<>0 then begin IsQuit := GetExitCodeThread(Thread,i); if IsQuit then begin if i = STILL_ACTIVE then Result := 1 else Result := 2; end else Result := 0;
end else Result := 3; end;
procedure Delay(msecs:integer); var Tick: DWord; Event: THandle; begin Event := CreateEvent(nil, False, False, nil); try Tick := GetTickCount + DWord(msecs); while (msecs > 0) and (MsgWaitForMultipleObjects(1, Event, False, msecs, QS_ALLINPUT) <> WAIT_TIMEOUT) do begin Application.ProcessMessages; msecs := Tick - GetTickcount; end; finally CloseHandle(Event); end; end;
procedure TForm1.Button1Click(Sender: TObject); var ThreadId1,ThreadId2,ThreadId3,ThreadId4,ThreadId5,ThreadId6,StopThread:DWORD; begin
hMutex:=0; hMutex:=CreateMutex(nil,false,nil);
h1:=CreateThread(nil, 0, @ThreadFunc1, nil, 0, ThreadId1); Delay(50); h2:=CreateThread(nil, 0, @ThreadFunc2, nil, 0, ThreadId2); while true do begin Delay(50); if CheckThreadFreed(h2)=2 then begin TerminateThread(h1,0); TerminateThread(h2,0); closehandle(h1); closehandle(h2); break; end; end; h3:=CreateThread(nil, 0, @ThreadFunc3, nil, 0, ThreadId3); Delay(50); h4:=CreateThread(nil, 0, @ThreadFunc4, nil, 0, ThreadId4); while true do begin Delay(50); if CheckThreadFreed(h4)=2 then begin TerminateThread(h3,0); TerminateThread(h4,0); closehandle(h3); closehandle(h4); break; end; end; h5:=CreateThread(nil, 0, @ThreadFunc5, nil, 0, ThreadId5); Delay(50); h6:=CreateThread(nil, 0, @ThreadFunc6, nil, 0, ThreadId6); while true do begin Delay(50); if CheckThreadFreed(h6)=2 then begin TerminateThread(h5,0); TerminateThread(h6,0); closehandle(h5); closehandle(h6); break; end; end; end;