summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/corelib/fpg_base.pas94
-rw-r--r--src/corelib/fpg_main.pas72
-rw-r--r--src/corelib/gdi/fpg_gdi.pas19
-rw-r--r--src/corelib/gdi/fpg_interface.pas1
-rw-r--r--src/corelib/x11/fpg_interface.pas1
-rw-r--r--src/corelib/x11/fpg_x11.pas4
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;
generated by cgit v1.2.3-70-g09d2 (git 2.47.0) at 2024-10-12 02:31:06 +0000