paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-08-16 20:49:24 +02:00
Code Issues Packages Projects Releases Wiki Activity

* win32: fix waiting for event handles

Browse Source 
git-svn-id: trunk@16951 -
This commit is contained in:
micha 2008-10-10 20:48:40 +00:00
parent 0efaa14dd7
commit 54fd9e1a03
2 changed files with 19 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/interfaces/win32/win32int.pp
View File

@ -146,6 +146,7 @@ type
FWaitHandles: array of HANDLE; FWaitHandles: array of HANDLE;
FWaitHandlers: array of TWaitHandler; FWaitHandlers: array of TWaitHandler;
FWaitPipeHandlers: PPipeEventInfo; FWaitPipeHandlers: PPipeEventInfo;
FPendingWaitHandlerIndex: Integer;
InitCommonControlsEx: function(ICC: PInitCommonControlsEx): LongBool; stdcall; InitCommonControlsEx: function(ICC: PInitCommonControlsEx): LongBool; stdcall;

21
lcl/interfaces/win32/win32object.inc
View File

@ -30,6 +30,7 @@
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
constructor TWin32WidgetSet.Create; constructor TWin32WidgetSet.Create;
begin begin
FPendingWaitHandlerIndex := -1;
inherited Create; inherited Create;
FTimerData := TList.Create; FTimerData := TList.Create;
FMetrics.cbSize := SizeOf(FMetrics); FMetrics.cbSize := SizeOf(FMetrics);
@ -281,8 +282,20 @@ var
AccelTable: HACCEL; AccelTable: HACCEL;
retVal, index: dword; retVal, index: dword;
pHandles: Windows.LPHANDLE; pHandles: Windows.LPHANDLE;
procedure CallWaitHandler;
begin
FWaitHandlers[index].OnEvent(FWaitHandlers[index].UserData, 0);
end;
begin begin
repeat repeat
if FPendingWaitHandlerIndex >= 0 then
begin
index := FPendingWaitHandlerIndex;
FPendingWaitHandlerIndex := -1;
CallWaitHandler;
end;
{$ifdef DEBUG_ASYNCEVENTS} {$ifdef DEBUG_ASYNCEVENTS}
if Length(FWaitHandles) > 0 then if Length(FWaitHandles) > 0 then
DebugLn('[ProcessMessages] WaitHandleCount=', IntToStr(FWaitHandleCount), DebugLn('[ProcessMessages] WaitHandleCount=', IntToStr(FWaitHandleCount),
@ -297,7 +310,7 @@ begin
if (WAIT_OBJECT_0 <= retVal) and (retVal < WAIT_OBJECT_0 + FWaitHandleCount) then if (WAIT_OBJECT_0 <= retVal) and (retVal < WAIT_OBJECT_0 + FWaitHandleCount) then
begin begin
index := retVal-WAIT_OBJECT_0; index := retVal-WAIT_OBJECT_0;
FWaitHandlers[index].OnEvent(FWaitHandlers[index].UserData, 0); CallWaitHandler;
end else end else
if retVal = WAIT_OBJECT_0 + FWaitHandleCount then if retVal = WAIT_OBJECT_0 + FWaitHandleCount then
begin begin
@ -366,7 +379,7 @@ end;
------------------------------------------------------------------------------} ------------------------------------------------------------------------------}
procedure TWin32WidgetSet.AppWaitMessage; procedure TWin32WidgetSet.AppWaitMessage;
var var
timeout: DWord; retVal, timeout: DWord;
pHandles: Windows.LPHANDLE; pHandles: Windows.LPHANDLE;
begin begin
RedrawMenus; RedrawMenus;
@ -379,8 +392,10 @@ begin
pHandles := @FWaitHandles[0] pHandles := @FWaitHandles[0]
else else
pHandles := nil; pHandles := nil;
Windows.MsgWaitForMultipleObjects(FWaitHandleCount, pHandles, retVal := Windows.MsgWaitForMultipleObjects(FWaitHandleCount, pHandles,
false, timeout, QS_ALLINPUT); false, timeout, QS_ALLINPUT);
if (WAIT_OBJECT_0 <= retVal) and (retVal < WAIT_OBJECT_0 + FWaitHandleCount) then
FPendingWaitHandlerIndex := retVal-WAIT_OBJECT_0;
Assert(False,'Trace:Leave wait message'); Assert(False,'Trace:Leave wait message');
end; end;