diff --git a/components/longtimer/demo/umainform.lfm b/components/longtimer/demo/umainform.lfm index 5124e2f91..641dee9b9 100644 --- a/components/longtimer/demo/umainform.lfm +++ b/components/longtimer/demo/umainform.lfm @@ -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 diff --git a/components/longtimer/demo/umainform.pas b/components/longtimer/demo/umainform.pas index 669360cec..d933ae6c1 100644 --- a/components/longtimer/demo/umainform.pas +++ b/components/longtimer/demo/umainform.pas @@ -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. + \ No newline at end of file diff --git a/components/longtimer/lang_longtimer/aboutlongtimerunit.po b/components/longtimer/locale/aboutlongtimerunit.po similarity index 100% rename from components/longtimer/lang_longtimer/aboutlongtimerunit.po rename to components/longtimer/locale/aboutlongtimerunit.po diff --git a/components/longtimer/longtimerpackage.lpk b/components/longtimer/longtimerpackage.lpk index 65496543f..706952376 100644 --- a/components/longtimer/longtimerpackage.lpk +++ b/components/longtimer/longtimerpackage.lpk @@ -1,4 +1,4 @@ - + @@ -17,10 +17,10 @@ - - - + + @@ -35,7 +35,7 @@ It is intended for TTrayIcon applications. DailyHour is a 24-hour clock (16 = 4 - + diff --git a/components/longtimer/ulongtimer.pas b/components/longtimer/ulongtimer.pas index 26c9d5ceb..8c8b72d66 100644 --- a/components/longtimer/ulongtimer.pas +++ b/components/longtimer/ulongtimer.pas @@ -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. \ No newline at end of file