Текущий архив: 2003.08.04;
Скачать: CL | DM;

Вниз

Использование SetTimer и KillTimer   Найти похожие ветки 

← →
-=IGA=-   (2003-06-03 08:29) [0]

Может у когонибудь есть пример, напишите плиз.

---

← →
Digitman ©   (2003-06-03 09:50) [1]

вот, разбирайся :


function TTransportThread.Send(const Data: IDataBlock; WaitResultTimeout: Integer): IDataBlock;
var
Context: DWord;
Msg: TMsg;
hWaitEvent: THandle;
hTimer: THandle;

procedure TimerProc(hWnd: Thandle; uMsg: DWord; idTimer: THandle; dwTime: DWord); stdcall;
begin
KillTimer(0, hTimer);
hTimer := 0;
CloseHandle(hWaitEvent);
hWaitEvent := 0;
end;

begin
Result := nil;
hWaitEvent := 0;
hTimer := 0;
if Assigned(Data) then
begin

if Data.Context = 0 then
Data.Context := GetCurrentThreadId;

if WaitResultTimeout <> 0 then
begin
hWaitEvent := CreateEvent(nil, False, False, nil);
Win32Check(hWaitEvent <> 0);
end;
try
Context := SendMessage(FhWnd, TM_SEND_DATABLOCK, wParam(Data), hWaitEvent);
if Context = 0 then
raise EACSConnectionError.CreateRes(@sACSConnectionError);
if WaitResultTimeout <> INFINITE then
begin
hTimer := SetTimer(0, 0, WaitResultTimeout, @TimerProc);
Win32Check(hTimer <> 0);
end;
try
while True do
case MsgWaitForMultipleObjects(1, hWaitEvent, False, INFINITE, QS_ALLINPUT) of
WAIT_OBJECT_0:
begin
Result := IDataBlock(SendMessage(FhWnd, TM_RECV_DATABLOCK, hWaitEvent, Context));
if not Assigned(Result) then
raise EACSConnectionError.CreateRes(@sACSConnectionError);
end;
WAIT_OBJECT_0 + 1:
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
WAIT_ABANDONED_0:
raise EACSConnectionError.CreateRes(@sACSConnectionError);
WAIT_FAILED:
raise EACSConnectionError.CreateRes(@sACSTimeoutError);
end;
finally
if hTimer <> 0 then
KillTimer(0, hTimer);
end;
finally
if hWaitEvent <> 0 then
CloseHandle(hWaitEvent);
end;
end;
end;


---

← →
Polevi ©   (2003-06-03 13:20) [2]

LOL

---

Страницы: 1 вся ветка

Текущий архив: 2003.08.04;
Скачать: CL | DM;

Наверх

Память: 0.47 MB
Время: 0.04 c