1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
| interface
uses
Windows, Messages, Controls, Forms,Dialogs;
type
TProcess= procedure of object;
function Submit(Process: TProcess): integer;
implementation
type
PProcess=^TProcess;
function StartMe(Hwnd: HWND): integer;
begin
Result := 0;
with FindControl(Hwnd) do
try
PProcess(Tag)^;
except
Result := -1;
end;
PostMessage(Hwnd,WM_CLOSE,0,0);
EndThread(Result);
end;
function Submit(Process: TProcess): integer;
var
FThread :Cardinal;
begin
with CreateMessageDialog('Veuillez patienter...', mtCustom, [mbAbort])do
try
Tag:=Integer(@@Process);
FThread := BeginThread(nil,0,@StartMe,Pointer(Handle),0,PDWord(nil)^);
if WaitForSingleObject(FThread,2000) = WAIT_TIMEOUT then
if ShowModal()= mrAbort then
TerminateThread(FThread, DWORD(-1));
WaitForSingleObject(FThread,INFINITE);
GetExitCodeThread(FThread, PDWord(@Result)^) ;
CloseHandle(FThread);
finally
Free;
end;
end;
end. |
Partager