GDI: Fixed the rubbish timer implementation.

I was clearly smoking something that day! Anyway, the GDI timer is now
correctly implemented, and doesn't push up the CPU load any more. No matter
how long the timer runs for. The timer is much more accurate/consistent in
firing as well. :-)

1 files changed, 40 insertions, 15 deletions

diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index bbe52180..77d476ab 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.pas
@@ -303,6 +303,12 @@ type
   { TfpgGDITimer }
 
   TfpgGDITimer = class(TfpgBaseTimer)
+  private
+    FHandle: THandle;
+  protected
+    procedure   SetEnabled(const AValue: boolean); override;
+  public
+    constructor Create(AInterval: integer); override;
   end;
 
 
@@ -337,6 +343,7 @@ const
   WS_POPUPWINDOW = 0;
   WS_EX_APPWINDOW = 0;
 
+
 // From Lazarus wince\winext.pas:
 function GET_X_LPARAM(lp : Windows.LParam) : longint;
 begin
@@ -1283,24 +1290,12 @@ end;
 procedure TfpgGDIApplication.DoWaitWindowMessage(atimeoutms: integer);
 var
   Msg: TMsg;
-  timerid: longword;
-  ltimerWnd: HWND;
   mp: boolean;
 begin
-  timerid  := 0;
-  if Assigned(wapplication.MainForm) then
-    ltimerWnd := TfpgGDIWindow(wapplication.MainForm).WinHandle
-  else
-    ltimerWnd := 0;
-
   if (atimeoutms >= 0) and (not MessagesPending) then
   begin
     if Assigned(FOnIdle) then
       OnIdle(self);
-    if atimeoutms > 0 then
-      timerid := Windows.SetTimer(ltimerWnd, 1, atimeoutms, nil)
-    else
-      Exit;  // handling waiting timeout
   end;
 
   {$IFDEF WinCE}
@@ -1314,9 +1309,6 @@ begin
   {$ENDIF}
 
   Windows.DispatchMessage(@msg);
-
-  if timerid <> 0 then
-    Windows.KillTimer(ltimerWnd, 1);  // same IDEvent as used in SetTimer
 end;
 
 procedure TfpgGDIApplication.DoFlush;
@@ -3022,6 +3014,39 @@ begin
   ActiveX.RevokeDragDrop(TfpgWidget(FDropTarget).WinHandle);
 end;
 
+procedure TimerCallBackProc(window_hwnd : hwnd; msg : DWORD; idEvent: UINT; dwTime: DWORD); stdcall;
+begin
+  { idEvent contains the handle to the timer that got triggered }
+  fpgCheckTimers;
+end;
+
+{ TfpgGDITimer }
+
+procedure TfpgGDITimer.SetEnabled(const AValue: boolean);
+begin
+  inherited SetEnabled(AValue);
+  if FEnabled then
+  begin
+//    FHandle := Windows.SetTimer(0, 0, Interval, nil);
+    FHandle := Windows.SetTimer(0, 0, Interval, @TimerCallBackProc);
+  end
+  else
+  begin
+    if FHandle <> 0 then
+    begin
+      Windows.KillTimer(FHandle, 0);
+      FHandle := 0;
+    end;
+  end;
+end;
+
+constructor TfpgGDITimer.Create(AInterval: integer);
+begin
+  inherited Create(AInterval);
+  FHandle := 0;
+end;
+
+
 initialization
   wapplication   := nil;
   MouseFocusedWH := 0;