mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-12-03 00:17:18 +01:00
MG: implemented TIdleTimer and fixed small bugs
git-svn-id: trunk@3606 -
This commit is contained in:
lazarus
parent
27b75d80fc
commit
e27b187b18
@ -230,8 +230,7 @@ begin
|
||||
// build lcl
|
||||
Tool.Title:='Build LCL';
|
||||
Tool.WorkingDirectory:='$(LazarusDir)/lcl';
|
||||
SetMakeParams(Options.BuildComponents,Options.ExtraOptions,
|
||||
Options.TargetOS);
|
||||
SetMakeParams(Options.BuildLCL,Options.ExtraOptions,Options.TargetOS);
|
||||
Result:=ExternalTools.Run(Tool,Macros);
|
||||
if Result<>mrOk then exit;
|
||||
end;
|
||||
|
||||
@ -333,7 +333,7 @@ begin
|
||||
RegisterComponents('Misc','Calendar',[TCalendar]);
|
||||
RegisterComponents('Misc','Arrow',[TArrow]);
|
||||
|
||||
RegisterComponents('System','ExtCtrls',[TTimer]);
|
||||
RegisterComponents('System','ExtCtrls',[TTimer,TIdleTimer]);
|
||||
RegisterComponents('Dialogs','Dialogs',[TOpenDialog,TSaveDialog,
|
||||
TColorDialog,TFontDialog]);
|
||||
|
||||
@ -342,6 +342,7 @@ begin
|
||||
{$IFDEF DATABASE}
|
||||
RegisterComponents('Data Access','Db',[TDatasource,TDatabase]);
|
||||
{$ENDIF}
|
||||
|
||||
{$IFDEF INTERBASE}
|
||||
RegisterComponents('Interbase Data Access','Interbase',[TIBStoredProc,
|
||||
TIBQuery,TIBDatabase]);
|
||||
|
||||
@ -550,6 +550,17 @@ LazarusResources.Add('tibquery','XPM',[
|
||||
+' N N N ",'#10'"N N N N N N N N N N N N N ",'#10'"'
|
||||
+' N "};'#10
|
||||
]);
|
||||
LazarusResources.Add('tidletimer','XPM',[
|
||||
'/* XPM */'#10'static char * tidletimer_xpm[] = {'#10'"19 19 4 1",'#10'" '#9
|
||||
+'c None",'#10'".'#9'c #000000",'#10'"+'#9'c #AD9226",'#10'"@'#9'c #1100D6",'
|
||||
+#10'" ..... ",'#10'" ..+++++.. ",'#10'" .++@@@@@++. '
|
||||
+' ",'#10'" .+@@@@+@@@@+. ",'#10'" .+@@+@@+.@+@@+. ",'#10'" .+@@@@@@+.'
|
||||
+'@@@@@+. ",'#10'" .+@+@@@@+.@@@+@+. ",'#10'".+@@@@@@@+.@@@@@@+.",'#10'".+@@@'
|
||||
+'@@@@+.@@@@@@+.",'#10'".+@+@@@@@++++@@+@+.",'#10'".+@@@@@@@@....@@@+.",'#10
|
||||
+'".+@@@@@@@@@@@@@@@+.",'#10'" .+@+@@@@@@@@@+@+. ",'#10'" .+@@@@@@@@@@@@@+. "'
|
||||
+','#10'" .+@@+@@@@@+@@+. ",'#10'" .+@@@@+@@@@+. ",'#10'" .++@@@@@++'
|
||||
+'. ",'#10'" ..+++++.. ",'#10'" ..... "};'#10
|
||||
]);
|
||||
LazarusResources.Add('timagelist','XPM',[
|
||||
'/* XPM */'#10'static char *timagelist[]={'#10'"20 20 6 1",'#10'"# c #000000"'
|
||||
+','#10'"d c #0058c0",'#10'"c c #008000",'#10'"a c #a8dcff",'#10'"b c #ffff00'
|
||||
|
||||
@ -31,23 +31,23 @@ uses
|
||||
|
||||
type
|
||||
{ TCustomTimer }
|
||||
{
|
||||
@abstract(A free running timer.)
|
||||
Introduced and (currently) maintained by Stefan Hille (stoppok@osibisa.ms.sub.org)
|
||||
}
|
||||
TCustomTimer = class (TComponent)
|
||||
private
|
||||
FInterval : Cardinal;
|
||||
FOnStartTimer: TNotifyEvent;
|
||||
FOnStopTimer: TNotifyEvent;
|
||||
FTimerHandle : integer;
|
||||
FOnTimer : TNotifyEvent;
|
||||
FEnabled : Boolean;
|
||||
procedure UpdateTimer;
|
||||
procedure SetEnabled(Value: Boolean);
|
||||
procedure SetInterval(Value: Cardinal);
|
||||
procedure SetOnTimer(Value: TNotifyEvent);
|
||||
procedure KillTimer;
|
||||
protected
|
||||
procedure Timer (var msg); message LM_Timer;
|
||||
protected
|
||||
procedure SetEnabled(Value: Boolean); virtual;
|
||||
procedure SetInterval(Value: Cardinal); virtual;
|
||||
procedure SetOnTimer(Value: TNotifyEvent); virtual;
|
||||
procedure DoOnTimer; virtual;
|
||||
procedure UpdateTimer; virtual;
|
||||
procedure KillTimer; virtual;
|
||||
procedure Loaded; override;
|
||||
public
|
||||
constructor Create(AOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
@ -55,10 +55,14 @@ type
|
||||
property Enabled: Boolean read FEnabled write SetEnabled default True;
|
||||
property Interval: Cardinal read FInterval write SetInterval default 1000;
|
||||
property OnTimer: TNotifyEvent read FOnTimer write SetOnTimer;
|
||||
property OnStartTimer: TNotifyEvent read FOnStartTimer write FOnStartTimer;
|
||||
property OnStopTimer: TNotifyEvent read FOnStopTimer write FOnStopTimer;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
const
|
||||
cIdNoTimer = -1; { timer ID for an invalid timer }
|
||||
SNoTimers = 'No timers available';
|
||||
@ -78,7 +82,6 @@ const
|
||||
procedure TimerCBProc(Handle: HWND; message : cardinal; IDEvent: Integer;
|
||||
Time: Cardinal);
|
||||
begin
|
||||
// Cast Handle back to timer
|
||||
if (Handle<>0) then
|
||||
TCustomTimer(Handle).Timer (message);
|
||||
end;
|
||||
@ -122,13 +125,19 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomTimer.KillTimer;
|
||||
begin
|
||||
Assert(False, 'Trace:In TCustomTimer.KillTimer');
|
||||
if FTimerHandle <> cIdNoTimer then begin
|
||||
LCLLinux.KillTimer (integer(Self), 1);
|
||||
FTimerHandle := cIdNoTimer;
|
||||
if Assigned(OnStopTimer) then OnStopTimer(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TCustomTimer.Loaded;
|
||||
begin
|
||||
inherited Loaded;
|
||||
UpdateTimer;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomTimer.UpdateTimer
|
||||
Params: Nothing
|
||||
@ -139,13 +148,16 @@ end;
|
||||
procedure TCustomTimer.UpdateTimer;
|
||||
begin
|
||||
KillTimer;
|
||||
if (FEnabled) and (FInterval > 0) and Assigned (FOnTimer) then begin
|
||||
if (FEnabled) and (FInterval > 0)
|
||||
and (([csDesigning,csLoading]*ComponentState=[]))
|
||||
and Assigned (FOnTimer) then begin
|
||||
FTimerHandle := LCLLinux.SetTimer(Integer(Self), 1,
|
||||
FInterval, @TimerCBProc);
|
||||
FInterval, @TimerCBProc);
|
||||
if FTimerHandle=0 then begin
|
||||
FTimerHandle:=cIdNoTimer;
|
||||
raise EOutOfResources.Create(SNoTimers);
|
||||
end;
|
||||
if Assigned(OnStartTimer) then OnStartTimer(Self);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -158,9 +170,8 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomTimer.Timer (var msg);
|
||||
begin
|
||||
Assert(false, 'Trace:Timer received a message -TIMER');
|
||||
if Assigned (FOnTimer) and (FEnabled) and (FInterval > 0) then
|
||||
FOnTimer(Self);
|
||||
if (FEnabled) and (FInterval > 0) then
|
||||
DoOnTimer;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
@ -173,11 +184,20 @@ end;
|
||||
procedure TCustomTimer.SetOnTimer (value : TNotifyEvent);
|
||||
begin
|
||||
if Value=FOnTimer then exit;
|
||||
Assert(False, 'Trace:SETTING TIMER CALLBACK');
|
||||
FOnTimer := value;
|
||||
UpdateTimer;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
procedure TCustomTimer.DoOnTimer;
|
||||
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomTimer.DoOnTimer;
|
||||
begin
|
||||
if Assigned(FOnTimer) then
|
||||
FOnTimer(Self);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TCustomTimer.SetEnabled
|
||||
Params: value - new "enabled" state of the timer
|
||||
@ -187,7 +207,6 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomTimer.SetEnabled (value : boolean);
|
||||
begin
|
||||
Assert(False, 'Trace:In TCustomTimer.SetEnabled');
|
||||
if (Value <> FEnabled) then
|
||||
begin
|
||||
FEnabled := value;
|
||||
@ -204,7 +223,6 @@ end;
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TCustomTimer.SetInterval (value : cardinal);
|
||||
begin
|
||||
Assert(False, 'Trace:In TCustomTimer.SetInterval');
|
||||
if (value <> FInterval) then
|
||||
begin
|
||||
FInterval := value;
|
||||
|
||||
@ -18,175 +18,14 @@
|
||||
*****************************************************************************
|
||||
|
||||
}
|
||||
(*{
|
||||
TTimer Delphi compatibility:
|
||||
|
||||
nearly 100% compatible, only WndProc is missing
|
||||
|
||||
TODO: -
|
||||
|
||||
Possible improvements: -
|
||||
|
||||
Bugs: unknown
|
||||
}
|
||||
|
||||
const
|
||||
cIdNoTimer = -1; { timer ID for an invalid timer }
|
||||
SNoTimers = 'No timers available';
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TimerCBProc
|
||||
Params: handle - handle (self) of the TTimer instance
|
||||
message - should be LM_Timer, currently unused (s. Win32 API)
|
||||
IDEvent - currently unused (s. Win32 API)
|
||||
Time - currently unused (s. Win32 API)
|
||||
Returns: Nothing
|
||||
|
||||
Callback for a timer which will call TTimer.Timer. This proc will be used
|
||||
if the InterfaceObject uses a callback instead of delivering a LM_Timer
|
||||
message.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TimerCBProc(Handle: HWND; message : cardinal; IDEvent: Integer;
|
||||
Time: Cardinal);
|
||||
begin
|
||||
// Cast Handle back to timer
|
||||
if (Handle<>0) then
|
||||
TTimer(Handle).Timer (message);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.Create
|
||||
Params: AOwner: the owner of the class
|
||||
Returns: Nothing
|
||||
|
||||
Constructor for a timer.
|
||||
------------------------------------------------------------------------------}
|
||||
constructor TTimer.Create(AOwner: TComponent);
|
||||
begin
|
||||
inherited Create(AOwner);
|
||||
FInterval := 1000;
|
||||
FTimerHandle := cIdNoTimer;
|
||||
FEnabled := true;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.Destroy
|
||||
Params: Nothing
|
||||
Returns: Nothing
|
||||
|
||||
Destructor for a timer.
|
||||
------------------------------------------------------------------------------}
|
||||
destructor TTimer.Destroy;
|
||||
begin
|
||||
FOnTimer:=nil;
|
||||
FEnabled:=false;
|
||||
KillTimer;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.KillTimer
|
||||
Params: Nothing
|
||||
Returns: Nothing
|
||||
|
||||
Kills the current timer object.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TTimer.KillTimer;
|
||||
begin
|
||||
Assert(False, 'Trace:In TTimer.KillTimer');
|
||||
if FTimerHandle <> cIdNoTimer then begin
|
||||
InterfaceObject.KillTimer (integer(Self), 1);
|
||||
FTimerHandle := cIdNoTimer;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.UpdateTimer
|
||||
Params: Nothing
|
||||
Returns: Nothing
|
||||
|
||||
Updates the timer to match the current properties.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TTimer.UpdateTimer;
|
||||
begin
|
||||
KillTimer;
|
||||
if (FEnabled) and (FInterval > 0) and Assigned (FOnTimer) then
|
||||
FTimerHandle := InterfaceObject.SetTimer(Integer(Self), 1,
|
||||
FInterval, @TimerCBProc);
|
||||
if FTimerHandle=0 then begin
|
||||
FTimerHandle:=cIdNoTimer;
|
||||
raise EOutOfResources.Create(SNoTimers);
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.Timer
|
||||
Params: msg - message to be dispatched
|
||||
Returns: Nothing
|
||||
|
||||
Is called when the timer has expired and calls users OnTimer function.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TTimer.Timer (var msg);
|
||||
begin
|
||||
Assert(false, 'Trace:Timer received a message -TIMER');
|
||||
if Assigned (FOnTimer) and (FEnabled) and (FInterval > 0) then
|
||||
FOnTimer(Self);
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.SetOnTimer
|
||||
Params: value - users notification function
|
||||
Returns: Nothing
|
||||
|
||||
Assigns the users notification callback.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TTimer.SetOnTimer (value : TNotifyEvent);
|
||||
begin
|
||||
if Value=FOnTimer then exit;
|
||||
Assert(False, 'Trace:SETTING TIMER CALLBACK');
|
||||
FOnTimer := value;
|
||||
UpdateTimer;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.SetEnabled
|
||||
Params: value - new "enabled" state of the timer
|
||||
Returns: Nothing
|
||||
|
||||
En/Disables the timer
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TTimer.SetEnabled (value : boolean);
|
||||
begin
|
||||
Assert(False, 'Trace:In TTimer.SetEnabled');
|
||||
if (Value <> FEnabled) then
|
||||
begin
|
||||
FEnabled := value;
|
||||
UpdateTimer;
|
||||
end;
|
||||
end;
|
||||
|
||||
{------------------------------------------------------------------------------
|
||||
Method: TTimer.SetInterval
|
||||
Params: value - timer interval
|
||||
Returns: Nothing
|
||||
|
||||
Sets interval for the timer.
|
||||
------------------------------------------------------------------------------}
|
||||
procedure TTimer.SetInterval (value : cardinal);
|
||||
begin
|
||||
Assert(False, 'Trace:In TTimer.SetInterval');
|
||||
if (value <> FInterval) then
|
||||
begin
|
||||
FInterval := value;
|
||||
UpdateTimer;
|
||||
end;
|
||||
end;
|
||||
*)
|
||||
|
||||
// included by extctrls.pp
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2002/11/04 11:48:48 lazarus
|
||||
MG: implemented TIdleTimer and fixed small bugs
|
||||
|
||||
Revision 1.8 2002/10/24 10:27:52 lazarus
|
||||
MG: broke extctrls.pp <-> forms.pp circle
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user