pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Added OnSample event. V0.0.2

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3530 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
2014-09-08 11:59:16 +00:00
parent 6b5cc615d3
commit 5279284bf0
5 changed files with 520 additions and 472 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/longtimer/demo/umainform.lfm
View File

@ -1,7 +1,7 @@
object mainform: Tmainform object mainform: Tmainform
Left = 1162 Left = 1050
Height = 264 Height = 264
Top = 272 Top = 186
Width = 437 Width = 437
BorderIcons = [biSystemMenu, biMinimize] BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle BorderStyle = bsSingle
@ -59,6 +59,7 @@ object mainform: Tmainform
ClientHeight = 158 ClientHeight = 158
ClientWidth = 180 ClientWidth = 180
TabOrder = 4 TabOrder = 4
OnClick = crp_SetTimerClick
object Label1: TLabel object Label1: TLabel
Left = 16 Left = 16
Height = 15 Height = 15
@ -146,13 +147,28 @@ object mainform: Tmainform
end end
end end
object LongTimer1: TLongTimer object LongTimer1: TLongTimer
About.Description.Strings = (
'LongTimer is a descendent of TIdleTimer'#13#10'and shares its properties and methods.'#13#10#13#10'Additional properties affect when the'#13#10'OnTimer event is fired.'#13#10#13#10'With LongTimer, the OnTimer event'#13#10'will be fired only ONCE - every time'#13#10'the interval that you set is reached.'
)
About.Title = 'About TLongTimer Component'
About.Height = 380
About.Width = 320
About.Font.Color = clNavy
About.Font.Height = -13
About.BackGroundColor = clWindow
About.Version = '0.0.1'
About.Authorname = 'Gordon Bamber'
About.Organisation = 'Public Domain'
About.AuthorEmail = 'minesadorada@charcodelvalle.com'
About.ComponentName = 'TLongTimer'
About.LicenseType = abLGPL
Enabled = False Enabled = False
OnTimer = LongTimer1Timer OnTimer = LongTimer1Timer
OnStartTimer = LongTimer1StartTimer OnStartTimer = LongTimer1StartTimer
OnStopTimer = LongTimer1StopTimer OnStopTimer = LongTimer1StopTimer
IntervalType = lt3Monthly Daily24Hour = 0
Daily24Hour = 10
WeeklyDay = lt3Wednesday WeeklyDay = lt3Wednesday
OnSample = LongTimer1Sample
left = 8 left = 8
top = 8 top = 8
end end

359
components/longtimer/demo/umainform.pas
View File

@ -1,174 +1,185 @@
unit umainform; unit umainform;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, Forms, Classes, SysUtils, Forms,
Buttons, StdCtrls, uLongTimer; Buttons, StdCtrls, uLongTimer;
{ Tmainform } { Tmainform }
type type
Tmainform = class(TForm) Tmainform = class(TForm)
cmb_Daily24Hour: TComboBox; cmb_Daily24Hour: TComboBox;
cmb_IntervalType: TComboBox; cmb_IntervalType: TComboBox;
cmb_weekordate: TComboBox; cmb_weekordate: TComboBox;
cmd_Close: TBitBtn; cmd_Close: TBitBtn;
cmd_StopTimer: TButton; cmd_StopTimer: TButton;
cmd_StartTimer: TButton; cmd_StartTimer: TButton;
cmb_SampleInterval: TComboBox; cmb_SampleInterval: TComboBox;
crp_SetTimer: TGroupBox; crp_SetTimer: TGroupBox;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
Label3: TLabel; Label3: TLabel;
Label4: TLabel; Label4: TLabel;
LongTimer1: TLongTimer; LongTimer1: TLongTimer;
memo_ReportTimerEvent: TMemo; memo_ReportTimerEvent: TMemo;
procedure cmb_SampleIntervalChange(Sender: TObject); procedure cmb_SampleIntervalChange(Sender: TObject);
procedure cmd_StopTimerClick(Sender: TObject); procedure cmd_StopTimerClick(Sender: TObject);
procedure cmd_StartTimerClick(Sender: TObject); procedure cmd_StartTimerClick(Sender: TObject);
procedure cmb_Daily24HourChange(Sender: TObject); procedure cmb_Daily24HourChange(Sender: TObject);
procedure cmb_IntervalTypeChange(Sender: TObject); procedure cmb_IntervalTypeChange(Sender: TObject);
procedure cmb_weekordateChange(Sender: TObject); procedure cmb_weekordateChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure crp_SetTimerClick(Sender: TObject);
procedure LongTimer1StartTimer(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure LongTimer1StopTimer(Sender: TObject); procedure LongTimer1Sample(Sender: TObject);
procedure LongTimer1Timer(Sender: TObject); procedure LongTimer1StartTimer(Sender: TObject);
private procedure LongTimer1StopTimer(Sender: TObject);
{ private declarations } procedure LongTimer1Timer(Sender: TObject);
procedure PopulateWeekOrDate(Const i:Integer); private
{ private declarations }
public procedure PopulateWeekOrDate(Const i:Integer);
{ public declarations }
end; public
{ public declarations }
var end;
mainform: Tmainform;
var
implementation mainform: Tmainform;
{$R *.lfm} implementation
{ Tmainform } {$R *.lfm}
procedure Tmainform.LongTimer1Timer(Sender: TObject); { Tmainform }
begin
// memo_ReportTimerEvent.Lines.Add('LastFired at ' + FormatDateTime('hh:nn:ss', LongTimer1.LastFired)); procedure Tmainform.LongTimer1Timer(Sender: TObject);
memo_ReportTimerEvent.Lines.Add('Fired at ' + FormatDateTime('hh:nn:ss', Now)); begin
end; // memo_ReportTimerEvent.Lines.Add('LastFired at ' + FormatDateTime('hh:nn:ss', LongTimer1.LastFired));
memo_ReportTimerEvent.Lines.Add('Timer fired at ' + FormatDateTime('hh:nn:ss dd-mm-yyyy', Now));
procedure Tmainform.FormCreate(Sender: TObject); end;
Var i:Integer;
begin procedure Tmainform.FormCreate(Sender: TObject);
Caption:=Application.Title; Var i:Integer;
memo_ReportTimerEvent.Clear; begin
cmb_Daily24Hour.Clear; Caption:=Application.Title;
cmb_Daily24Hour.Items.Add('Midnight'); memo_ReportTimerEvent.Clear;
For i:=1 to 23 do cmb_Daily24Hour.Clear;
cmb_Daily24Hour.Items.Add(Format('%2.d:00',[i])); cmb_Daily24Hour.Items.Add('Midnight');
LongTimer1.IntervalType:=lt1Daily; For i:=1 to 23 do
LongTimer1.Daily24Hour:=0; cmb_Daily24Hour.Items.Add(Format('%2.d:00',[i]));
LongTimer1.Enabled:=FALSE; LongTimer1.IntervalType:=lt1Daily;
cmb_Daily24Hour.ItemIndex:=0; LongTimer1.Daily24Hour:=0;
cmb_SampleInterval.Clear; LongTimer1.Enabled:=FALSE;
cmb_SampleInterval.Items.Add('Every minute'); cmb_Daily24Hour.ItemIndex:=0;
cmb_SampleInterval.Items.Add('Every 5 minutes'); cmb_SampleInterval.Clear;
cmb_SampleInterval.Items.Add('Every 10 minutes'); cmb_SampleInterval.Items.Add('Every minute');
cmb_SampleInterval.Items.Add('Every 30 minutes'); cmb_SampleInterval.Items.Add('Every 5 minutes');
cmb_SampleInterval.Items.Add('Every 45 minutes'); cmb_SampleInterval.Items.Add('Every 10 minutes');
memo_ReportTimerEvent.Lines.Add('Timer initially disabled'); cmb_SampleInterval.Items.Add('Every 30 minutes');
cmb_SampleInterval.ItemIndex:=2; cmb_SampleInterval.Items.Add('Every 45 minutes');
end; memo_ReportTimerEvent.Lines.Add('Timer initially disabled');
cmb_SampleInterval.ItemIndex:=2;
procedure Tmainform.LongTimer1StartTimer(Sender: TObject); end;
begin
// memo_ReportTimerEvent.Lines.Add('Timer running'); procedure Tmainform.LongTimer1Sample(Sender: TObject);
end; begin
memo_ReportTimerEvent.Lines.Add('Sampled at ' + FormatDateTime('hh:nn:ss',Now));
procedure Tmainform.LongTimer1StopTimer(Sender: TObject); end;
begin
// memo_ReportTimerEvent.Lines.Add('Timer stopped'); procedure Tmainform.LongTimer1StartTimer(Sender: TObject);
begin
end; Self.Caption:='Timer was started at ' + FormatDateTime('dd/mm/yyyy hh:nn:ss',Now);
end;
procedure Tmainform.cmd_StopTimerClick(Sender: TObject);
begin procedure Tmainform.LongTimer1StopTimer(Sender: TObject);
LongTimer1.Enabled:=FALSE; begin
memo_ReportTimerEvent.Lines.Add('Timer disabled'); Self.Caption:=Application.Title;
end; end;
procedure Tmainform.cmb_SampleIntervalChange(Sender: TObject); procedure Tmainform.cmd_StopTimerClick(Sender: TObject);
begin begin
LongTimer1.SampleInterval:=TSampleInterval(cmb_SampleInterval.ItemIndex); LongTimer1.Enabled:=FALSE;
end; memo_ReportTimerEvent.Lines.Add('Timer disabled');
end;
procedure Tmainform.cmd_StartTimerClick(Sender: TObject);
begin procedure Tmainform.cmb_SampleIntervalChange(Sender: TObject);
LongTimer1.Enabled:=TRUE; begin
memo_ReportTimerEvent.Lines.Add('Timer enabled'); LongTimer1.SampleInterval:=TSampleInterval(cmb_SampleInterval.ItemIndex);
end;
end;
procedure Tmainform.cmd_StartTimerClick(Sender: TObject);
procedure Tmainform.cmb_Daily24HourChange(Sender: TObject); begin
begin LongTimer1.Enabled:=TRUE;
LongTimer1.Daily24Hour:=cmb_Daily24Hour.ItemIndex; memo_ReportTimerEvent.Lines.Add('Timer enabled');
end;
procedure Tmainform.PopulateWeekOrDate(Const i:Integer); end;
// 0=Weekly, 1=Monthly
Var iMonthDay:Integer; procedure Tmainform.cmb_Daily24HourChange(Sender: TObject);
begin
begin LongTimer1.Daily24Hour:=cmb_Daily24Hour.ItemIndex;
cmb_weekordate.Clear; end;
Case i of procedure Tmainform.PopulateWeekOrDate(const i: Integer);
0:begin // 0=Weekly, 1=Monthly
cmb_weekordate.Items.Add('Monday'); Var iMonthDay:Integer;
cmb_weekordate.Items.Add('Tuesday');
cmb_weekordate.Items.Add('Wednesday'); begin
cmb_weekordate.Items.Add('Thursday'); cmb_weekordate.Clear;
cmb_weekordate.Items.Add('Friday'); Case i of
cmb_weekordate.Items.Add('Saturday'); 0:begin
cmb_weekordate.Items.Add('Sunday'); cmb_weekordate.Items.Add('Monday');
end; cmb_weekordate.Items.Add('Tuesday');
1:begin cmb_weekordate.Items.Add('Wednesday');
For iMonthDay := 1 to 31 do cmb_weekordate.Items.Add('Thursday');
cmb_weekordate.Items.Add(Format('%2.d',[iMonthDay])); cmb_weekordate.Items.Add('Friday');
end; cmb_weekordate.Items.Add('Saturday');
end; cmb_weekordate.Items.Add('Sunday');
cmb_weekordate.ItemIndex:=0; end;
end; 1:begin
For iMonthDay := 1 to 31 do
procedure Tmainform.cmb_IntervalTypeChange(Sender: TObject); cmb_weekordate.Items.Add(Format('%2.d',[iMonthDay]));
begin end;
cmd_StopTimer.Click; end;
Case cmb_IntervalType.ItemIndex of cmb_weekordate.ItemIndex:=0;
0: end;
begin
LongTimer1.IntervalType:=lt1Daily; procedure Tmainform.cmb_IntervalTypeChange(Sender: TObject);
cmb_weekordate.Enabled:=FALSE; begin
end; cmd_StopTimer.Click;
1: Case cmb_IntervalType.ItemIndex of
begin 0:
LongTimer1.IntervalType:=lt2Weekly; begin
PopulateWeekOrDate(0); LongTimer1.IntervalType:=lt1Daily;
cmb_weekordate.Enabled:=TRUE; cmb_weekordate.Enabled:=FALSE;
end; end;
2: 1:
begin begin
LongTimer1.IntervalType:=lt3Monthly; LongTimer1.IntervalType:=lt2Weekly;
PopulateWeekOrDate(1); PopulateWeekOrDate(0);
cmb_weekordate.Enabled:=TRUE; cmb_weekordate.Enabled:=TRUE;
end; end;
end; 2:
end; begin
LongTimer1.IntervalType:=lt3Monthly;
procedure Tmainform.cmb_weekordateChange(Sender: TObject); PopulateWeekOrDate(1);
begin cmb_weekordate.Enabled:=TRUE;
Case LongTimer1.IntervalType of end;
lt2Weekly:LongTimer1.WeeklyDay:=TDay(cmb_weekordate.ItemIndex); end;
lt3Monthly:LongTimer1.MonthlyDate:=(cmb_weekordate.ItemIndex+1); end;
end;
end; procedure Tmainform.cmb_weekordateChange(Sender: TObject);
begin
end. Case LongTimer1.IntervalType of
lt2Weekly:LongTimer1.WeeklyDay:=TDay(cmb_weekordate.ItemIndex);
lt3Monthly:LongTimer1.MonthlyDate:=(cmb_weekordate.ItemIndex+1);
end;
end;
procedure Tmainform.crp_SetTimerClick(Sender: TObject);
begin
end;
end.

0
components/longtimer/lang_longtimer/aboutlongtimerunit.po → components/longtimer/locale/aboutlongtimerunit.po
View File

10
components/longtimer/longtimerpackage.lpk
View File

@ -1,4 +1,4 @@
<?xml version="1.0" encoding="UTF-8"?> <?xml version="1.0"?>
<CONFIG> <CONFIG>
<Package Version="4"> <Package Version="4">
<PathDelim Value="\"/> <PathDelim Value="\"/>
@ -17,10 +17,10 @@
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>
<Description Value="TLongTimer is a descendant of TIdleTimer that samples every 30minutes when idle. <Description Value="TLongTimer is a descendant of TIdleTimer that samples every 30minutes when idle.
It is intended for TTrayIcon applications. DailyHour is a 24-hour clock (16 = 4pm) and MonthlyDate is best &lt; 29 "/> It is intended for TTrayIcon applications. DailyHour is a 24-hour clock (16 = 4pm) and MonthlyDate is best &lt; 29 "/>
<License Value="LGPLv2"/> <License Value="LGPL"/>
<Version Release="1"/> <Version Release="2"/>
<Files Count="2"> <Files Count="2">
<Item1> <Item1>
<Filename Value="ulongtimer.pas"/> <Filename Value="ulongtimer.pas"/>
@ -35,7 +35,7 @@ It is intended for TTrayIcon applications. DailyHour is a 24-hour clock (16 = 4
</Files> </Files>
<i18n> <i18n>
<EnableI18N Value="True"/> <EnableI18N Value="True"/>
<OutDir Value="lang_longtimer"/> <OutDir Value="locale"/>
<EnableI18NForLFM Value="True"/> <EnableI18NForLFM Value="True"/>
</i18n> </i18n>
<Type Value="RunAndDesignTime"/> <Type Value="RunAndDesignTime"/>

599
components/longtimer/ulongtimer.pas
View File

@ -1,289 +1,310 @@
unit uLongTimer; unit uLongTimer;
{ TlongTimer { TlongTimer
Based on TIdleTimer component Based on TIdleTimer component
1. Set the Interval type 1. Set the Interval type
2. For all Interval Types, you can set the Hour 2. For all Interval Types, you can set the Hour
3. The OnTimer event will only be fired at the specified intervals 3. The OnTimer event will only be fired at the specified intervals
4. The underlying interval is 30 minutes (when idle) 4. The underlying interval is 30 minutes (when idle)
Copyright (C)2014 minesadorada@charcodelvalle.com Copyright (C)2014 minesadorada@charcodelvalle.com
This library is free software; you can redistribute it and/or modify it This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Library General Public License as published by under the terms of the GNU Library General Public License as published by
the Free Software Foundation; either version 2 of the License, or (at your the Free Software Foundation; either version 2 of the License, or (at your
option) any later version. option) any later version.
This program is distributed in the hope that it will be useful, but WITHOUT This program is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
for more details. for more details.
You should have received a copy of the GNU Library General Public License You should have received a copy of the GNU Library General Public License
along with this library; if not, write to the Free Software Foundation, along with this library; if not, write to the Free Software Foundation,
Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
} }
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, LResources, ExtCtrls,DateUtils,Dialogs,AboutLongTimerunit; Classes, SysUtils, LResources, ExtCtrls,DateUtils,Dialogs,AboutLongTimerunit;
type type
TIntervalType = (lt1Daily,lt2Weekly,lt3Monthly); TIntervalType = (lt1Daily,lt2Weekly,lt3Monthly);
TSampleInterval = (lt1Everyminute,lt2Every5minutes,lt3Every10Minutes,lt4Every30Minutes,lt5Every45Minutes); TSampleInterval = (lt1Everyminute,lt2Every5minutes,lt3Every10Minutes,lt4Every30Minutes,lt5Every45Minutes);
TDay = (lt1Monday,lt2Tuesday,lt3Wednesday,lt4Thursday,lt5Friday,lt6Saturday,lt7Sunday); TDay = (lt1Monday,lt2Tuesday,lt3Wednesday,lt4Thursday,lt5Friday,lt6Saturday,lt7Sunday);
TLongTimer = class(TAboutLongTimer) TLongTimer = class(TAboutLongTimer)
private private
{ Private declarations } { Private declarations }
fCurrentDateTime,fLastFiredDateTime:TDateTime; fCurrentDateTime,fLastFiredDateTime:TDateTime;
fIntervalType:TIntervalType; fIntervalType:TIntervalType;
fHour,fDay,fDate:Word; fHour,fDay,fDate:Word;
fTday:TDay; fTday:TDay;
fHourDone,fDayDone,fDateDone:Boolean; fHourDone,fDayDone,fDateDone:Boolean;
fSampleInterval:TSampleInterval; fSampleInterval:TSampleInterval;
protected fVersion:String;
{ Protected declarations } fOnSample:TNotifyEvent;
procedure DoOnIdle(Sender: TObject; var Done: Boolean); override; Procedure SetDay(aDay:TDay);
procedure DoOnIdleEnd(Sender: TObject); override; Procedure SetDailyHour(aHour:Word);
procedure DoOnTimer;override; Procedure SetMonthlyDate(ADate:Word);
Procedure SetDay(aDay:TDay); procedure SetSampleInterval(ASampleInterval:TSampleInterval);
Procedure SetDailyHour(aHour:Word); protected
Procedure SetMonthlyDate(ADate:Word); { Protected declarations }
procedure SetSampleInterval(ASampleInterval:TSampleInterval); procedure DoOnIdle(Sender: TObject; var Done: Boolean); override;
public procedure DoOnIdleEnd(Sender: TObject); override;
{ Public declarations } procedure DoOnTimer;override;
constructor Create(TheOwner: TComponent); override; public
published { Public declarations }
{ Published declarations } constructor Create(TheOwner: TComponent); override;
// Default=false // Until the first Timer event, this will be the component's creation time
property AutoEnabled; Property LastFired:TDateTime read fLastFiredDateTime;
// Same as TIdleTimer published
property AutoStartEvent; { Published declarations }
// Same as TIdleTimer // Default=false
property AutoEndEvent; property AutoEnabled;
// Same as TIdleTimer // Same as TIdleTimer
property Enabled; property AutoStartEvent;
// This is fired only at the Long Intervals you set // Same as TIdleTimer
property OnTimer; property AutoEndEvent;
// Same as TIdleTimer // Same as TIdleTimer
property OnStartTimer; property Enabled;
// Same as TIdleTimer // This is fired only at the Long Intervals you set
property OnStopTimer; property OnTimer;
// If Weekly or Monthly you can also set the Daily24Hour property // Same as TIdleTimer
property IntervalType:TIntervalType read fIntervalType write fIntervalType default lt1Daily; property OnStartTimer;
// Smaller = more accurate, larger = less CPU time // Same as TIdleTimer
property SampleInterval:TSampleInterval read fSampleInterval write SetSampleInterval default lt3Every10Minutes; property OnStopTimer;
// 0=Midnight, 4=4am, 16=4pm etc. // If Weekly or Monthly you can also set the Daily24Hour property
Property Daily24Hour:Word read fHour write SetDailyHour; property IntervalType:TIntervalType read fIntervalType write fIntervalType default lt1Daily;
// You can also set the Hour as well as the Weekday // Smaller = more accurate, larger = less CPU time
Property WeeklyDay:TDay read fTDay write SetDay; property SampleInterval:TSampleInterval read fSampleInterval write SetSampleInterval default lt3Every10Minutes;
// You can also set the hour as well as the date // 0=Midnight, 4=4am, 16=4pm etc.
property MonthlyDate:Word read fDate write SetMonthlyDate default 1; Property Daily24Hour:Word read fHour write SetDailyHour;
// Until the first Timer event, this will be the component's creation time // You can also set the Hour as well as the Weekday
Property LastFired:TDateTime read fLastFiredDateTime; Property WeeklyDay:TDay read fTDay write SetDay;
end; // You can also set the Hour as well as the date
property MonthlyDate:Word read fDate write SetMonthlyDate default 1;
procedure Register; // Version string of this component
property Version:String read fVersion;
implementation // Fired every time LongTimer samples
CONST Property OnSample:TNotifyEvent read fOnSample write fOnSample;
C_OneMinute = 60000; end;
procedure Register;
begin procedure Register;
RegisterComponents('System',[TLongTimer]);
{$I longtimer_icon.lrs} implementation
end; CONST
constructor TLongTimer.Create(TheOwner: TComponent); C_OneMinute = 60000;
Var sz:String; C_Version='0.0.2';
begin (*
inherited; V0.0.1: Initial commit
// Set About dialog properties V0.0.2: Added OnSample event
AboutBoxComponentName:='TLongTimer'; V0.0.3: ??
AboutBoxTitle:='TLongTimer Component'; *)
// AboutBoxWidth (integer) procedure Register;
AboutBoxHeight:=380; begin
sz:='LongTimer is a descendent of TIdleTimer' + LineEnding; RegisterComponents('System',[TLongTimer]);
sz+='and shares its properties and methods.' + LineEnding + LineEnding; {$I longtimer_icon.lrs}
sz+='Additional properties affect when the' + LineEnding; end;
sz+='OnTimer event is fired.' + LineEnding + LineEnding; constructor TLongTimer.Create(TheOwner: TComponent);
sz+='With LongTimer, the OnTimer event' + LineEnding; Var sz:String;
sz+='will be fired only ONCE - every time' + LineEnding; begin
sz+='the interval that you set is reached.'; inherited;
AboutBoxDescription:=sz; // Set About dialog properties
// AboutBoxBackgroundColor (TColor, like clWhite) AboutBoxComponentName:='TLongTimer';
// AboutBoxFontName (string) AboutBoxTitle:='TLongTimer Component';
// AboutBoxFontSize (integer) // AboutBoxWidth (integer)
AboutBoxVersion:='0.0.1'; AboutBoxHeight:=380;
AboutBoxAuthorname:='Gordon Bamber'; sz:='LongTimer is a descendent of TIdleTimer' + LineEnding;
// AboutBoxOrganisation (string) sz+='and shares its properties and methods.' + LineEnding + LineEnding;
AboutBoxAuthorEmail:='minesadorada@charcodelvalle.com'; sz+='Additional properties affect when the' + LineEnding;
AboutBoxLicenseType:='LGPL';// (string e.g. 'GPL', ModifiedGPL' etc sz+='OnTimer event is fired.' + LineEnding + LineEnding;
sz+='With LongTimer, the OnTimer event' + LineEnding;
fHourDone:=false; sz+='will be fired only ONCE - every time' + LineEnding;
fDayDone:=False; sz+='the interval that you set is reached.';
fDateDone:=False; AboutBoxDescription:=sz;
fCurrentDateTime:=Now; // AboutBoxBackgroundColor (TColor, like clWhite)
fLastFiredDateTime:=Now; // AboutBoxFontName (string)
fDate:=1; // AboutBoxFontSize (integer)
fSampleInterval:=lt3Every10Minutes; AboutBoxVersion:='0.0.1';
Interval:=10 * C_OneMinute; AboutBoxAuthorname:='Gordon Bamber';
fIntervalType:=lt1Daily; // AboutBoxOrganisation (string)
end; AboutBoxAuthorEmail:='minesadorada@charcodelvalle.com';
procedure TLongTimer.DoOnIdle(Sender: TObject; var Done: Boolean); AboutBoxLicenseType:='LGPL';// (string e.g. 'GPL', ModifiedGPL' etc
begin
// Do nothing special here fHourDone:=false;
inherited; fDayDone:=False;
end; fDateDone:=False;
procedure TLongTimer.DoOnIdleEnd(Sender: TObject); fCurrentDateTime:=Now;
begin fLastFiredDateTime:=Now;
// Do nothing special here
inherited; // Set defaults for properties
end; fDate:=1;
procedure TLongTimer.DoOnTimer; fSampleInterval:=lt3Every10Minutes;
// Only allow this event to fire ONCE if datetime matches the interval set Interval:=10 * C_OneMinute;
Var fIntervalType:=lt1Daily;
cDay,cD,cM,cY,cH,cMi,cS,cms:Word;
lDay,lD,lM,lY,lH,lMi,lS,lms:Word; fVersion:=C_Version;
fTempDate:Word; end;
begin procedure TLongTimer.DoOnIdle(Sender: TObject; var Done: Boolean);
// Split Current date into parts begin
fCurrentDateTime:=Now; // Do nothing special here
DecodeDate(fCurrentDateTime,cY,cM,cD); inherited;
DecodeTime(fCurrentDateTime,cH,cMi,cS,cmS); end;
cDay:=DayOfTheMonth(fCurrentDateTime); procedure TLongTimer.DoOnIdleEnd(Sender: TObject);
begin
DecodeDate(fLastFiredDateTime,lY,lM,lD); // Do nothing special here
DecodeTime(fLastFiredDateTime,lH,lMi,lS,lmS); inherited;
lDay:=DayOfTheMonth(fLastFiredDateTime); end;
procedure TLongTimer.DoOnTimer;
// New hour? // Only allow this event to fire ONCE if datetime matches the interval set
If (fIntervalType = lt1Daily) then Var
If (cH <> lH) then fHourDone:=FALSE; cDay,cD,cM,cY,cH,cMi,cS,cms:Word;
// New Day? lDay,lD,lM,lY,lH,lMi,lS,lms:Word;
If (fIntervalType = lt2Weekly) then fTempDate:Word;
If (cDay <> lDay) then begin
begin // Split Current date into parts
fDayDone:=FALSE; fCurrentDateTime:=Now;
fHourDone:=FALSE; DecodeDate(fCurrentDateTime,cY,cM,cD);
end; DecodeTime(fCurrentDateTime,cH,cMi,cS,cmS);
// New Date? cDay:=DayOfTheMonth(fCurrentDateTime);
If (fIntervalType = lt3Monthly) then
If (cD <> lD) then // Split LastFired date into parts
begin DecodeDate(fLastFiredDateTime,lY,lM,lD);
fDateDone:=FALSE; DecodeTime(fLastFiredDateTime,lH,lMi,lS,lmS);
fHourDone:=FALSE; lDay:=DayOfTheMonth(fLastFiredDateTime);
end;
// New hour?
If (fIntervalType = lt1Daily) then
// Only proceed further at specified interval in specified hour - else exit If (cH <> lH) then fHourDone:=FALSE;
If (fIntervalType = lt1Daily) and ((fHourDone = TRUE) OR (cH <> fHour)) then Exit; // New Day?
If (fIntervalType = lt2Weekly) and ((fDayDone = TRUE) OR (cH <> fHour)) then Exit; If (fIntervalType = lt2Weekly) then
If (fIntervalType = lt3Monthly) and ((fDateDone = TRUE) OR (cH <> fHour)) then Exit; If (cDay <> lDay) then
begin
// Fire the OnTimer event for the user fDayDone:=FALSE;
inherited; // Do whatever the user wants done fHourDone:=FALSE;
fLastFiredDateTime:=Now;// Record the DateTime the OnTimer was fired end;
// New Date?
// Now make sure it doesn't fire more than once when resampled If (fIntervalType = lt3Monthly) then
If (cD <> lD) then
// Deal with Months where fDate has been set to an invalid date begin
// (i.e. 31st February) fDateDone:=FALSE;
// Simply temporarily decrement the fDate until it is valid fHourDone:=FALSE;
fTempDate:=fDate; end;
If (fIntervalType = lt3Monthly) then
While NOT IsValidDate(cY,cM,fTempDate) do Dec(fTempDate); // Fire the OnSample event?
If Assigned(fOnSample) then fOnSample(Self);
// If ltDaily, then fDayDone and fDateDone are always FALSE
If (fIntervalType = lt1Daily) and (cH = fHour) then // Only proceed further at specified interval in specified hour - else exit
begin If (fIntervalType = lt1Daily) and ((fHourDone = TRUE) OR (cH <> fHour)) then Exit;
fHourDone := TRUE; If (fIntervalType = lt2Weekly) and ((fDayDone = TRUE) OR (cH <> fHour)) then Exit;
end; If (fIntervalType = lt3Monthly) and ((fDateDone = TRUE) OR (cH <> fHour)) then Exit;
// If ltWeekly, then fHourDone and fDateDone are always FALSE // Fire the OnTimer event for the user
// Set only if on Correct Weekday and at specified hour inherited; // Do whatever the user wants done
If (fIntervalType = lt2Weekly) fLastFiredDateTime:=Now;// Record the DateTime the OnTimer was fired
and ((cDay = fDay)
and (ch = fHour)) // Now make sure it doesn't fire more than once when resampled
then
begin // Deal with Months where fDate has been set to an invalid date
fDayDone := TRUE; // (i.e. 31st February)
fHourDone := TRUE; // Simply temporarily decrement the fDate until it is valid
end; fTempDate:=fDate;
If (fIntervalType = lt3Monthly) then
// If ltMonthly, then fDayDone and fHourDone are always FALSE While NOT IsValidDate(cY,cM,fTempDate) do Dec(fTempDate);
// Set only if Correct day of month and at specified hour
If (fIntervalType = lt3Monthly) and // If ltDaily, then fDayDone and fDateDone are always FALSE
((cD = fTempDate) If (fIntervalType = lt1Daily) and (cH = fHour) then
and (ch = fHour)) begin
then fHourDone := TRUE;
begin end;
fDateDone := TRUE;
fHourDone := TRUE; // If ltWeekly, then fHourDone and fDateDone are always FALSE
end; // Set only if on Correct Weekday and at specified hour
end; If (fIntervalType = lt2Weekly)
procedure TLongTimer.SetSampleInterval(ASampleInterval:TSampleInterval); and ((cDay = fDay)
Var TimerEnabled:Boolean; and (ch = fHour))
Begin then
If ASampleInterval = fSampleInterval then exit; begin
// Temporarily disable running timer? fDayDone := TRUE;
TimerEnabled:=Enabled; fHourDone := TRUE;
Enabled:=False; end;
Case ASampleInterval of
lt1Everyminute:Interval:=C_OneMinute; // If ltMonthly, then fDayDone and fHourDone are always FALSE
lt2Every5minutes:Interval:=5 * C_OneMinute; // Set only if Correct day of month and at specified hour
lt3Every10Minutes:Interval:=10 * C_OneMinute; If (fIntervalType = lt3Monthly) and
lt4Every30Minutes:Interval:=30 * C_OneMinute; ((cD = fTempDate)
lt5Every45Minutes:Interval:=45 * C_OneMinute; and (ch = fHour))
end; then
Enabled:=TimerEnabled; begin
end; fDateDone := TRUE;
fHourDone := TRUE;
Procedure TLongTimer.SetDay(aDay:TDay); end;
Var TimerEnabled:Boolean; end;
begin
If ADay = fTDay then Exit; procedure TLongTimer.SetSampleInterval(ASampleInterval:TSampleInterval);
// Temporarily disable running timer? Var TimerEnabled:Boolean;
TimerEnabled:=Enabled; Begin
Enabled:=False; If ASampleInterval = fSampleInterval then exit;
fTDay:=aDay; // Temporarily disable running timer?
fDay:=Ord(aDay)+1; TimerEnabled:=Enabled;
Enabled:=TimerEnabled; Enabled:=False;
{ Case ASampleInterval of
// ISO day numbers. lt1Everyminute:Interval:=C_OneMinute;
DayMonday = 1; lt2Every5minutes:Interval:=5 * C_OneMinute;
DayTuesday = 2; lt3Every10Minutes:Interval:=10 * C_OneMinute;
DayWednesday = 3; lt4Every30Minutes:Interval:=30 * C_OneMinute;
DayThursday = 4; lt5Every45Minutes:Interval:=45 * C_OneMinute;
DayFriday = 5; end;
DaySaturday = 6; Enabled:=TimerEnabled;
DaySunday = 7; end;
}
end; Procedure TLongTimer.SetDay(aDay:TDay);
Procedure TLongTimer.SetDailyHour(aHour:Word); Var TimerEnabled:Boolean;
Var TimerEnabled:Boolean; begin
begin If ADay = fTDay then Exit;
If fHour=aHour then Exit; // Temporarily disable running timer?
// Temporarily disable running timer? TimerEnabled:=Enabled;
TimerEnabled:=Enabled; Enabled:=False;
Enabled:=False; fTDay:=aDay;
If (aHour >= 0) AND (aHour <=24) then fHour:=aHour; fDay:=Ord(aDay)+1;
Enabled:=TimerEnabled; Enabled:=TimerEnabled;
end; {
// ISO day numbers.
Procedure TLongTimer.SetMonthlyDate(ADate:Word); DayMonday = 1;
Var TimerEnabled:Boolean; DayTuesday = 2;
begin DayWednesday = 3;
If ADate=fDate then Exit; DayThursday = 4;
// Temporarily disable running timer? DayFriday = 5;
TimerEnabled:=Enabled; DaySaturday = 6;
Enabled:=False; DaySunday = 7;
If (fDate > 0) and (fDate < 32) then fDate:=ADate; }
// Invalid dates like 31st Feb are dealt with in DoOnTimer end;
// e.g. 31 stands for the last day in any month (inc Feb in a Leap Year)
Enabled:=TimerEnabled; Procedure TLongTimer.SetDailyHour(aHour:Word);
end; Var TimerEnabled:Boolean;
begin
end. If fHour=aHour then Exit;
// Temporarily disable running timer?
TimerEnabled:=Enabled;
Enabled:=False;
If (aHour >= 0) AND (aHour <=24) then fHour:=aHour;
Enabled:=TimerEnabled;
end;
Procedure TLongTimer.SetMonthlyDate(ADate:Word);
Var TimerEnabled:Boolean;
begin
If ADate=fDate then Exit;
// Temporarily disable running timer?
TimerEnabled:=Enabled;
Enabled:=False;
If (fDate > 0) and (fDate < 32) then fDate:=ADate;
// Invalid dates like 31st Feb are dealt with in DoOnTimer
// e.g. 31 stands for the last day in any month (inc Feb in a Leap Year)
Enabled:=TimerEnabled;
end;
end.