* do not hog the CPU while waiting for an event under Win32

git-svn-id: trunk@16746 -

packages/ptc/src/win32/base/window.inc

@@ -126,7 +126,7 @@ begin
   }
 end;
 
-procedure TWin32Window.Update(AForce: Boolean = False);
+procedure TWin32Window.Update(AForce: Boolean = False; AWaitForMessage: Boolean = False);
 var
   message: MSG;
 begin
@@ -137,11 +137,18 @@ begin
     { updated to pump all window messages, and not just for our FWindow;
       this fixes keyboard layout switching and maybe other bugs and side effects...
       Seems like Windows wants everything pumped :) }
-    while PeekMessage(message, {FWindow}0, 0, 0, PM_REMOVE) do
+    if AWaitForMessage then
     begin
+      GetMessage(message, {FWindow}0, 0, 0);
       TranslateMessage(message);
       DispatchMessage(message);
-    end;
+    end
+    else
+      while PeekMessage(message, {FWindow}0, 0, 0, PM_REMOVE) do
+      begin
+        TranslateMessage(message);
+        DispatchMessage(message);
+      end;
   end
   else
     Sleep(0);

packages/ptc/src/win32/base/windowd.inc

@@ -68,7 +68,7 @@ type
     procedure Cursor(AFlag: Boolean);
     procedure ConfineCursor(AFlag: Boolean);
     procedure Resize(AWidth, AHeight: Integer);
-    procedure Update(AForce: Boolean = False);
+    procedure Update(AForce: Boolean = False; AWaitForMessage: Boolean = False);
     property Handle: HWND read FWindow;
     property Thread: DWord read GetThread;
     property Managed: Boolean read FManaged;

packages/ptc/src/win32/directx/directxconsolei.inc

@@ -496,36 +496,46 @@ begin
 end;
 
 function TDirectXConsole.NextEvent(var AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+var
+  UseGetMessage: Boolean;
 begin
   CHECK_OPEN('TDirectXConsole.NextEvent');
 //  CHECK_LOCK('TDirectXConsole.NextEvent');
 
   FreeAndNil(AEvent);
+  UseGetMessage := False;
   repeat
     FPrimary.Block;
 
     { update window }
-    FWindow.Update;
+    FWindow.Update(False, UseGetMessage);
 
     { try to find an event that matches the EventMask }
     AEvent := FEventQueue.NextEvent(AEventMask);
+    if AWait then
+      UseGetMessage := True;
   until (not AWait) or (AEvent <> nil);
   Result := AEvent <> nil;
 end;
 
 function TDirectXConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent;
+var
+  UseGetMessage: Boolean;
 begin
   CHECK_OPEN('TDirectXConsole.PeekEvent');
 //  CHECK_LOCK('TDirectXConsole.PeekEvent');
 
+  UseGetMessage := False;
   repeat
     FPrimary.Block;
 
     { update window }
-    FWindow.Update;
+    FWindow.Update(False, UseGetMessage);
 
     { try to find an event that matches the EventMask }
     Result := FEventQueue.PeekEvent(AEventMask);
+    if AWait then
+      UseGetMessage := True;
   until (not AWait) or (Result <> nil);
 end;
 

packages/ptc/src/win32/gdi/gdiconsolei.inc

@@ -484,32 +484,42 @@ begin
 end;
 
 function TGDIConsole.NextEvent(var AEvent: TPTCEvent; AWait: Boolean; const AEventMask: TPTCEventMask): Boolean;
+var
+  UseGetMessage: Boolean;
 begin
   CheckOpen('TGDIConsole.NextEvent');
 //  CheckUnlocked('TGDIConsole.NextEvent');
 
   FreeAndNil(AEvent);
+  UseGetMessage := False;
   repeat
     { update window }
-    FWindow.Update;
+    FWindow.Update(False, UseGetMessage);
 
     { try to find an event that matches the EventMask }
     AEvent := FEventQueue.NextEvent(AEventMask);
+    if AWait then
+      UseGetMessage := True;
   until (not AWait) or (AEvent <> Nil);
   Result := AEvent <> nil;
 end;
 
 function TGDIConsole.PeekEvent(AWait: Boolean; const AEventMask: TPTCEventMask): TPTCEvent;
+var
+  UseGetMessage: Boolean;
 begin
   CheckOpen('TGDIConsole.PeekEvent');
 //  CheckUnlocked('TGDIConsole.PeekEvent');
 
+  UseGetMessage := False;
   repeat
     { update window }
-    FWindow.Update;
+    FWindow.Update(False, UseGetMessage);
 
     { try to find an event that matches the EventMask }
     Result := FEventQueue.PeekEvent(AEventMask);
+    if AWait then
+      UseGetMessage := True;
   until (not AWait) or (Result <> Nil);
 end;