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
Left = 1162
Left = 1050
Height = 264
Top = 272
Top = 186
Width = 437
BorderIcons = [biSystemMenu, biMinimize]
BorderStyle = bsSingle
@ -59,6 +59,7 @@ object mainform: Tmainform
ClientHeight = 158
ClientWidth = 180
TabOrder = 4
OnClick = crp_SetTimerClick
object Label1: TLabel
Left = 16
Height = 15
@ -146,13 +147,28 @@ object mainform: Tmainform
end
end
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
OnTimer = LongTimer1Timer
OnStartTimer = LongTimer1StartTimer
OnStopTimer = LongTimer1StopTimer
IntervalType = lt3Monthly
Daily24Hour = 10
Daily24Hour = 0
WeeklyDay = lt3Wednesday
OnSample = LongTimer1Sample
left = 8
top = 8
end

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

@ -1,174 +1,185 @@
unit umainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms,
Buttons, StdCtrls, uLongTimer;
{ Tmainform }
type
Tmainform = class(TForm)
cmb_Daily24Hour: TComboBox;
cmb_IntervalType: TComboBox;
cmb_weekordate: TComboBox;
cmd_Close: TBitBtn;
cmd_StopTimer: TButton;
cmd_StartTimer: TButton;
cmb_SampleInterval: TComboBox;
crp_SetTimer: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
LongTimer1: TLongTimer;
memo_ReportTimerEvent: TMemo;
procedure cmb_SampleIntervalChange(Sender: TObject);
procedure cmd_StopTimerClick(Sender: TObject);
procedure cmd_StartTimerClick(Sender: TObject);
procedure cmb_Daily24HourChange(Sender: TObject);
procedure cmb_IntervalTypeChange(Sender: TObject);
procedure cmb_weekordateChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LongTimer1StartTimer(Sender: TObject);
procedure LongTimer1StopTimer(Sender: TObject);
procedure LongTimer1Timer(Sender: TObject);
private
{ private declarations }
procedure PopulateWeekOrDate(Const i:Integer);
public
{ public declarations }
end;
var
mainform: Tmainform;
implementation
{$R *.lfm}
{ Tmainform }
procedure Tmainform.LongTimer1Timer(Sender: TObject);
begin
// memo_ReportTimerEvent.Lines.Add('LastFired at ' + FormatDateTime('hh:nn:ss', LongTimer1.LastFired));
memo_ReportTimerEvent.Lines.Add('Fired at ' + FormatDateTime('hh:nn:ss', Now));
end;
procedure Tmainform.FormCreate(Sender: TObject);
Var i:Integer;
begin
Caption:=Application.Title;
memo_ReportTimerEvent.Clear;
cmb_Daily24Hour.Clear;
cmb_Daily24Hour.Items.Add('Midnight');
For i:=1 to 23 do
cmb_Daily24Hour.Items.Add(Format('%2.d:00',[i]));
LongTimer1.IntervalType:=lt1Daily;
LongTimer1.Daily24Hour:=0;
LongTimer1.Enabled:=FALSE;
cmb_Daily24Hour.ItemIndex:=0;
cmb_SampleInterval.Clear;
cmb_SampleInterval.Items.Add('Every minute');
cmb_SampleInterval.Items.Add('Every 5 minutes');
cmb_SampleInterval.Items.Add('Every 10 minutes');
cmb_SampleInterval.Items.Add('Every 30 minutes');
cmb_SampleInterval.Items.Add('Every 45 minutes');
memo_ReportTimerEvent.Lines.Add('Timer initially disabled');
cmb_SampleInterval.ItemIndex:=2;
end;
procedure Tmainform.LongTimer1StartTimer(Sender: TObject);
begin
// memo_ReportTimerEvent.Lines.Add('Timer running');
end;
procedure Tmainform.LongTimer1StopTimer(Sender: TObject);
begin
// memo_ReportTimerEvent.Lines.Add('Timer stopped');
end;
procedure Tmainform.cmd_StopTimerClick(Sender: TObject);
begin
LongTimer1.Enabled:=FALSE;
memo_ReportTimerEvent.Lines.Add('Timer disabled');
end;
procedure Tmainform.cmb_SampleIntervalChange(Sender: TObject);
begin
LongTimer1.SampleInterval:=TSampleInterval(cmb_SampleInterval.ItemIndex);
end;
procedure Tmainform.cmd_StartTimerClick(Sender: TObject);
begin
LongTimer1.Enabled:=TRUE;
memo_ReportTimerEvent.Lines.Add('Timer enabled');
end;
procedure Tmainform.cmb_Daily24HourChange(Sender: TObject);
begin
LongTimer1.Daily24Hour:=cmb_Daily24Hour.ItemIndex;
end;
procedure Tmainform.PopulateWeekOrDate(Const i:Integer);
// 0=Weekly, 1=Monthly
Var iMonthDay:Integer;
begin
cmb_weekordate.Clear;
Case i of
0:begin
cmb_weekordate.Items.Add('Monday');
cmb_weekordate.Items.Add('Tuesday');
cmb_weekordate.Items.Add('Wednesday');
cmb_weekordate.Items.Add('Thursday');
cmb_weekordate.Items.Add('Friday');
cmb_weekordate.Items.Add('Saturday');
cmb_weekordate.Items.Add('Sunday');
end;
1:begin
For iMonthDay := 1 to 31 do
cmb_weekordate.Items.Add(Format('%2.d',[iMonthDay]));
end;
end;
cmb_weekordate.ItemIndex:=0;
end;
procedure Tmainform.cmb_IntervalTypeChange(Sender: TObject);
begin
cmd_StopTimer.Click;
Case cmb_IntervalType.ItemIndex of
0:
begin
LongTimer1.IntervalType:=lt1Daily;
cmb_weekordate.Enabled:=FALSE;
end;
1:
begin
LongTimer1.IntervalType:=lt2Weekly;
PopulateWeekOrDate(0);
cmb_weekordate.Enabled:=TRUE;
end;
2:
begin
LongTimer1.IntervalType:=lt3Monthly;
PopulateWeekOrDate(1);
cmb_weekordate.Enabled:=TRUE;
end;
end;
end;
procedure Tmainform.cmb_weekordateChange(Sender: TObject);
begin
Case LongTimer1.IntervalType of
lt2Weekly:LongTimer1.WeeklyDay:=TDay(cmb_weekordate.ItemIndex);
lt3Monthly:LongTimer1.MonthlyDate:=(cmb_weekordate.ItemIndex+1);
end;
end;
end.
unit umainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms,
Buttons, StdCtrls, uLongTimer;
{ Tmainform }
type
Tmainform = class(TForm)
cmb_Daily24Hour: TComboBox;
cmb_IntervalType: TComboBox;
cmb_weekordate: TComboBox;
cmd_Close: TBitBtn;
cmd_StopTimer: TButton;
cmd_StartTimer: TButton;
cmb_SampleInterval: TComboBox;
crp_SetTimer: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
LongTimer1: TLongTimer;
memo_ReportTimerEvent: TMemo;
procedure cmb_SampleIntervalChange(Sender: TObject);
procedure cmd_StopTimerClick(Sender: TObject);
procedure cmd_StartTimerClick(Sender: TObject);
procedure cmb_Daily24HourChange(Sender: TObject);
procedure cmb_IntervalTypeChange(Sender: TObject);
procedure cmb_weekordateChange(Sender: TObject);
procedure crp_SetTimerClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure LongTimer1Sample(Sender: TObject);
procedure LongTimer1StartTimer(Sender: TObject);
procedure LongTimer1StopTimer(Sender: TObject);
procedure LongTimer1Timer(Sender: TObject);
private
{ private declarations }
procedure PopulateWeekOrDate(Const i:Integer);
public
{ public declarations }
end;
var
mainform: Tmainform;
implementation
{$R *.lfm}
{ Tmainform }
procedure Tmainform.LongTimer1Timer(Sender: TObject);
begin
// 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));
end;
procedure Tmainform.FormCreate(Sender: TObject);
Var i:Integer;
begin
Caption:=Application.Title;
memo_ReportTimerEvent.Clear;
cmb_Daily24Hour.Clear;
cmb_Daily24Hour.Items.Add('Midnight');
For i:=1 to 23 do
cmb_Daily24Hour.Items.Add(Format('%2.d:00',[i]));
LongTimer1.IntervalType:=lt1Daily;
LongTimer1.Daily24Hour:=0;
LongTimer1.Enabled:=FALSE;
cmb_Daily24Hour.ItemIndex:=0;
cmb_SampleInterval.Clear;
cmb_SampleInterval.Items.Add('Every minute');
cmb_SampleInterval.Items.Add('Every 5 minutes');
cmb_SampleInterval.Items.Add('Every 10 minutes');
cmb_SampleInterval.Items.Add('Every 30 minutes');
cmb_SampleInterval.Items.Add('Every 45 minutes');
memo_ReportTimerEvent.Lines.Add('Timer initially disabled');
cmb_SampleInterval.ItemIndex:=2;
end;
procedure Tmainform.LongTimer1Sample(Sender: TObject);
begin
memo_ReportTimerEvent.Lines.Add('Sampled at ' + FormatDateTime('hh:nn:ss',Now));
end;
procedure Tmainform.LongTimer1StartTimer(Sender: TObject);
begin
Self.Caption:='Timer was started at ' + FormatDateTime('dd/mm/yyyy hh:nn:ss',Now);
end;
procedure Tmainform.LongTimer1StopTimer(Sender: TObject);
begin
Self.Caption:=Application.Title;
end;
procedure Tmainform.cmd_StopTimerClick(Sender: TObject);
begin
LongTimer1.Enabled:=FALSE;
memo_ReportTimerEvent.Lines.Add('Timer disabled');
end;
procedure Tmainform.cmb_SampleIntervalChange(Sender: TObject);
begin
LongTimer1.SampleInterval:=TSampleInterval(cmb_SampleInterval.ItemIndex);
end;
procedure Tmainform.cmd_StartTimerClick(Sender: TObject);
begin
LongTimer1.Enabled:=TRUE;
memo_ReportTimerEvent.Lines.Add('Timer enabled');
end;
procedure Tmainform.cmb_Daily24HourChange(Sender: TObject);
begin
LongTimer1.Daily24Hour:=cmb_Daily24Hour.ItemIndex;
end;
procedure Tmainform.PopulateWeekOrDate(const i: Integer);
// 0=Weekly, 1=Monthly
Var iMonthDay:Integer;
begin
cmb_weekordate.Clear;
Case i of
0:begin
cmb_weekordate.Items.Add('Monday');
cmb_weekordate.Items.Add('Tuesday');
cmb_weekordate.Items.Add('Wednesday');
cmb_weekordate.Items.Add('Thursday');
cmb_weekordate.Items.Add('Friday');
cmb_weekordate.Items.Add('Saturday');
cmb_weekordate.Items.Add('Sunday');
end;
1:begin
For iMonthDay := 1 to 31 do
cmb_weekordate.Items.Add(Format('%2.d',[iMonthDay]));
end;
end;
cmb_weekordate.ItemIndex:=0;
end;
procedure Tmainform.cmb_IntervalTypeChange(Sender: TObject);
begin
cmd_StopTimer.Click;
Case cmb_IntervalType.ItemIndex of
0:
begin
LongTimer1.IntervalType:=lt1Daily;
cmb_weekordate.Enabled:=FALSE;
end;
1:
begin
LongTimer1.IntervalType:=lt2Weekly;
PopulateWeekOrDate(0);
cmb_weekordate.Enabled:=TRUE;
end;
2:
begin
LongTimer1.IntervalType:=lt3Monthly;
PopulateWeekOrDate(1);
cmb_weekordate.Enabled:=TRUE;
end;
end;
end;
procedure Tmainform.cmb_weekordateChange(Sender: TObject);
begin
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>
<Package Version="4">
<PathDelim Value="\"/>
@ -17,10 +17,10 @@
<CompilerPath Value="$(CompPath)"/>
</Other>
</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 "/>
<License Value="LGPLv2"/>
<Version Release="1"/>
<License Value="LGPL"/>
<Version Release="2"/>
<Files Count="2">
<Item1>
<Filename Value="ulongtimer.pas"/>
@ -35,7 +35,7 @@ It is intended for TTrayIcon applications. DailyHour is a 24-hour clock (16 = 4
</Files>
<i18n>
<EnableI18N Value="True"/>
<OutDir Value="lang_longtimer"/>
<OutDir Value="locale"/>
<EnableI18NForLFM Value="True"/>
</i18n>
<Type Value="RunAndDesignTime"/>

599
components/longtimer/ulongtimer.pas
View File

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