TfpgTimer refactoring.

Refactored the TfpgTimer by introducing a TfpgBaseTimer and X11 & GDI Timer
descendants. This now allows use to add platform specific extensions to
the timer implementation.

6 files changed, 119 insertions, 72 deletions

diff --git a/src/corelib/fpg_base.pas b/src/corelib/fpg_base.pas
index 80133832..970c2fee 100644
--- a/src/corelib/fpg_base.pas
+++ b/src/corelib/fpg_base.pas
@@ -684,6 +684,7 @@ type
     property    Count: integer read GetCount;
   end;
 
+
   TfpgDragBase = class(TObject)
   protected
     FDragging: Boolean;
@@ -693,6 +694,32 @@ type
     destructor  Destroy; override;
     function    Execute(const ADropActions: TfpgDropActions; const ADefaultAction: TfpgDropAction = daCopy): TfpgDropAction; virtual; abstract;
   end;
+  
+  
+  { TfpgBaseTimer }
+
+  TfpgBaseTimer = class(TObject)
+  private
+    FNextAlarm: TDateTime;
+    FInterval: integer;
+    FOnTimer: TNotifyEvent;
+    procedure   SetInterval(const AValue: integer);
+  protected
+    FEnabled: boolean;
+    procedure   SetEnabled(const AValue: boolean); virtual;
+  public
+    constructor Create(AInterval: integer); virtual;
+    destructor  Destroy; override;
+    procedure   CheckAlarm(ACurrentTime: TDateTime);
+    procedure   Reset;
+    procedure   Pause(ASeconds: integer);
+    property    Enabled: boolean read FEnabled write SetEnabled;
+    property    NextAlarm: TDateTime read FNextAlarm;
+    { Interval is in milliseconds. }
+    property    Interval: integer read FInterval write SetInterval;
+    property    OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
+  end;
+
 
 
 
@@ -729,7 +756,8 @@ uses
   fpg_constants,
   fpg_form,  // needed for fpgApplication.CreateForms()
   typinfo,
-  process;
+  process,
+  dateutils;
 
 
 const
@@ -3017,5 +3045,69 @@ begin
 end;
 
 
+{ TfpgBaseTimer }
+
+procedure TfpgBaseTimer.SetInterval(const AValue: integer);
+begin
+  FInterval := AValue;
+  FNextAlarm := Now + (FInterval * ONE_MILISEC);
+end;
+
+procedure TfpgBaseTimer.SetEnabled(const AValue: boolean);
+begin
+  if AValue and (FInterval <= 0) then
+     Exit;
+  if (not FEnabled) and AValue then
+    FNextAlarm := now + (interval * ONE_MILISEC);
+  FEnabled := AValue;
+end;
+
+constructor TfpgBaseTimer.Create(AInterval: integer);
+begin
+  inherited Create;
+  FInterval := AInterval;
+  FEnabled  := False;
+  OnTimer   := nil;
+end;
+
+destructor TfpgBaseTimer.Destroy;
+begin
+  Enabled := False;
+  inherited Destroy;
+end;
+
+procedure TfpgBaseTimer.CheckAlarm(ACurrentTime: TDateTime);
+begin
+  if not FEnabled then
+    Exit; //==>
+
+  if FNextAlarm <= ACurrentTime then
+  begin
+    // set the next alarm point
+    if Interval > 0 then
+      while FNextAlarm <= ACurrentTime do
+        FNextAlarm += (Interval * ONE_MILISEC);
+
+    if Assigned(FOnTimer) then
+      FOnTimer(self);
+  end;
+end;
+
+procedure TfpgBaseTimer.Reset;
+begin
+  Enabled := False;
+  Enabled := True;
+end;
+
+procedure TfpgBaseTimer.Pause(ASeconds: integer);
+begin
+  if Enabled then
+  begin
+    FNextAlarm := IncSecond(Now, ASeconds);
+  end;
+end;
+
+
+
 end.
 
diff --git a/src/corelib/fpg_main.pas b/src/corelib/fpg_main.pas
index ee05655a..20e13ba0 100644
--- a/src/corelib/fpg_main.pas
+++ b/src/corelib/fpg_main.pas
@@ -295,26 +295,11 @@ type
   end;
 
 
-  TfpgTimer = class(TObject)
-  private
-    FEnabled: boolean;
-    FNextAlarm: TDateTime;
-    FInterval: integer;
-    FOnTimer: TNotifyEvent;
-    procedure   SetEnabled(const AValue: boolean);
-    procedure   SetInterval(const AValue: integer);
+  TfpgTimer = class(TfpgTimerImpl)
   public
     { AInterval is in milliseconds. }
-    constructor Create(ainterval: integer); virtual;
+    constructor Create(AInterval: integer); override;
     destructor  Destroy; override;
-    procedure   CheckAlarm(ctime: TDateTime);
-    procedure   Reset; virtual;
-    procedure   Pause(ASeconds: integer);
-    property    Enabled: boolean read FEnabled write SetEnabled;
-    property    NextAlarm: TDateTime read FNextAlarm;
-    { Interval is in milliseconds. }
-    property    Interval: integer read FInterval write SetInterval;
-    property    OnTimer: TNotifyEvent read FOnTimer write FOnTimer;
   end;
 
 
@@ -468,7 +453,6 @@ implementation
 uses
   strutils,
   math,
-  dateutils,
   fpg_imgfmt_bmp,
   fpg_stdimages,
   fpg_translations,
@@ -1071,24 +1055,9 @@ end;
 
 { TfpgTimer }
 
-procedure TfpgTimer.SetEnabled(const AValue: boolean);
-begin
-  if (not FEnabled) and AValue then
-    FNextAlarm := now + (interval * ONE_MILISEC);
-  FEnabled := AValue;
-end;
-
-procedure TfpgTimer.SetInterval(const AValue: integer);
-begin
-  FInterval := AValue;
-  FNextAlarm := now + (FInterval * ONE_MILISEC);
-end;
-
-constructor TfpgTimer.Create(ainterval: integer);
+constructor TfpgTimer.Create(AInterval: integer);
 begin
-  FInterval := ainterval;
-  OnTimer   := nil;
-  FEnabled  := False;
+  inherited Create(AInterval);
   fpgTimers.Add(self);
 end;
 
@@ -1102,36 +1071,6 @@ begin
   inherited Destroy;
 end;
 
-procedure TfpgTimer.CheckAlarm(ctime: TDateTime);
-begin
-  if not FEnabled then
-    Exit; //==>
-
-  if FNextAlarm <= ctime then
-  begin
-    // set the next alarm point
-    if interval > 0 then
-      while FNextAlarm <= ctime do
-        FNextAlarm += (interval * ONE_MILISEC);
-
-    if Assigned(FOnTimer) then
-      FOnTimer(self);
-  end;
-end;
-
-procedure TfpgTimer.Reset;
-begin
-  Enabled := False;
-  Enabled := True;
-end;
-
-procedure TfpgTimer.Pause(ASeconds: integer);
-begin
-  if Enabled then
-  begin
-    FNextAlarm := incSecond(Now, ASeconds);
-  end;
-end;
 
 function fpgApplication: TfpgApplication;
 begin
@@ -1140,6 +1079,7 @@ begin
   result := uApplication;
 end;
 
+
 function fpgClipboard: TfpgClipboard;
 begin
   if not Assigned(uClipboard) then
@@ -1147,6 +1087,7 @@ begin
   Result := uClipboard;
 end;
 
+
 function fpgColorToRGB(col: TfpgColor): TfpgColor;
 begin
   if (col and cl_BaseNamedColor) <> 0 then
@@ -1155,6 +1096,7 @@ begin
     Result := col;
 end;
 
+
 function fpgGetNamedColor(col: TfpgColor): TfpgColor;
 begin
   if fpgIsNamedColor(col) then
diff --git a/src/corelib/gdi/fpg_gdi.pas b/src/corelib/gdi/fpg_gdi.pas
index ffaefff2..bbe52180 100644
--- a/src/corelib/gdi/fpg_gdi.pas
+++ b/src/corelib/gdi/fpg_gdi.pas
@@ -300,6 +300,12 @@ type
   end;
 
 
+  { TfpgGDITimer }
+
+  TfpgGDITimer = class(TfpgBaseTimer)
+  end;
+
+
 implementation
 
 uses
@@ -333,13 +339,14 @@ const
 
 // From Lazarus wince\winext.pas:
 function GET_X_LPARAM(lp : Windows.LParam) : longint;
-  begin
-    result:=smallint(LOWORD(lp));
-  end;
+begin
+  result:=smallint(LOWORD(lp));
+end;
+
 function GET_Y_LPARAM(lp : Windows.LParam) : longint;
-  begin
-    result:=smallint(HIWORD(lp));
-  end;
+begin
+  result:=smallint(HIWORD(lp));
+end;
 
 // *** copied from Lazarus
 function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer;
diff --git a/src/corelib/gdi/fpg_interface.pas b/src/corelib/gdi/fpg_interface.pas
index ef58e46d..f4aee4e3 100644
--- a/src/corelib/gdi/fpg_interface.pas
+++ b/src/corelib/gdi/fpg_interface.pas
@@ -35,6 +35,7 @@ type
   TfpgFileListImpl      = TfpgGDIFileList;
   TfpgMimeDataImpl      = TfpgGDIMimeDataBase;
   TfpgDragImpl          = TfpgGDIDrag;
+  TfpgTimerImpl         = TfpgGDITimer;
 
 implementation
 
diff --git a/src/corelib/x11/fpg_interface.pas b/src/corelib/x11/fpg_interface.pas
index 3a1e1920..251319de 100644
--- a/src/corelib/x11/fpg_interface.pas
+++ b/src/corelib/x11/fpg_interface.pas
@@ -35,6 +35,7 @@ type
   TfpgFileListImpl      = TfpgX11FileList;
   TfpgMimeDataImpl      = TfpgX11MimeData;
   TfpgDragImpl          = TfpgX11Drag;
+  TfpgTimerImpl         = TfpgX11Timer;
 
 implementation
 
diff --git a/src/corelib/x11/fpg_x11.pas b/src/corelib/x11/fpg_x11.pas
index 264038f7..3a1e9a14 100644
--- a/src/corelib/x11/fpg_x11.pas
+++ b/src/corelib/x11/fpg_x11.pas
@@ -382,6 +382,10 @@ type
     destructor  Destroy; override;
     function    Execute(const ADropActions: TfpgDropActions; const ADefaultAction: TfpgDropAction = daCopy): TfpgDropAction; override;
   end;
+  
+  
+  TfpgX11Timer = class(TfpgBaseTimer)
+  end;
 
 
 function fpgColorToX(col: TfpgColor): longword;