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

Source code better formatted via JEDI

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3669 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
2014-10-20 11:34:38 +00:00
parent 5b34d4b18e
commit 6aed97db26
1 changed files with 198 additions and 176 deletions
Download Patch File Download Diff File Expand all files Collapse all files

298
components/longtimer/ulongtimer.pas
View File

@ -1,4 +1,5 @@
unit uLongTimer; unit uLongTimer;
{ TlongTimer { TlongTimer
Based on TIdleTimer component Based on TIdleTimer component
@ -29,37 +30,39 @@ unit uLongTimer;
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,
TDay = (lt1Monday,lt2Tuesday,lt3Wednesday,lt4Thursday,lt5Friday,lt6Saturday,lt7Sunday); lt4Every30Minutes, lt5Every45Minutes);
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;
fVersion:String; fVersion: string;
fOnSample:TNotifyEvent; fOnSample: TNotifyEvent;
Procedure SetDay(aDay:TDay); procedure SetDay(aDay: TDay);
Procedure SetDailyHour(aHour:Word); procedure SetDailyHour(aHour: word);
Procedure SetMonthlyDate(ADate:Word); procedure SetMonthlyDate(ADate: word);
procedure SetSampleInterval(ASampleInterval:TSampleInterval); procedure SetSampleInterval(ASampleInterval: TSampleInterval);
protected protected
{ Protected declarations } { Protected declarations }
procedure DoOnIdle(Sender: TObject; var Done: Boolean); override; procedure DoOnIdle(Sender: TObject; var Done: boolean); override;
procedure DoOnIdleEnd(Sender: TObject); override; procedure DoOnIdleEnd(Sender: TObject); override;
procedure DoOnTimer;override; procedure DoOnTimer; override;
public public
{ Public declarations } { Public declarations }
constructor Create(TheOwner: TComponent); override; constructor Create(TheOwner: TComponent); override;
// Until the first Timer event, this will be the component's creation time // Until the first Timer event, this will be the component's creation time
Property LastFired:TDateTime read fLastFiredDateTime; property LastFired: TDateTime read fLastFiredDateTime;
published published
{ Published declarations } { Published declarations }
// Default=false // Default=false
@ -77,27 +80,31 @@ type
// Same as TIdleTimer // Same as TIdleTimer
property OnStopTimer; property OnStopTimer;
// If Weekly or Monthly you can also set the Daily24Hour property // If Weekly or Monthly you can also set the Daily24Hour property
property IntervalType:TIntervalType read fIntervalType write fIntervalType default lt1Daily; property IntervalType: TIntervalType
read fIntervalType write fIntervalType default lt1Daily;
// Smaller = more accurate, larger = less CPU time // Smaller = more accurate, larger = less CPU time
property SampleInterval:TSampleInterval read fSampleInterval write SetSampleInterval default lt3Every10Minutes; property SampleInterval: TSampleInterval read fSampleInterval
write SetSampleInterval default lt3Every10Minutes;
// 0=Midnight, 4=4am, 16=4pm etc. // 0=Midnight, 4=4am, 16=4pm etc.
Property Daily24Hour:Word read fHour write SetDailyHour; property Daily24Hour: word read fHour write SetDailyHour;
// You can also set the Hour as well as the Weekday // You can also set the Hour as well as the Weekday
Property WeeklyDay:TDay read fTDay write SetDay; property WeeklyDay: TDay read fTDay write SetDay;
// You can also set the Hour as well as the date // You can also set the Hour as well as the date
property MonthlyDate:Word read fDate write SetMonthlyDate default 1; property MonthlyDate: word read fDate write SetMonthlyDate default 1;
// Version string of this component // Version string of this component
property Version:String read fVersion; property Version: string read fVersion;
// Fired every time LongTimer samples // Fired every time LongTimer samples
Property OnSample:TNotifyEvent read fOnSample write fOnSample; property OnSample: TNotifyEvent read fOnSample write fOnSample;
end; end;
procedure Register; procedure Register;
implementation implementation
CONST
const
C_OneMinute = 60000; C_OneMinute = 60000;
C_Version='0.0.2'; C_Version = '0.0.2';
(* (*
V0.0.1: Initial commit V0.0.1: Initial commit
V0.0.2: Added OnSample event V0.0.2: Added OnSample event
@ -105,172 +112,181 @@ CONST
*) *)
procedure Register; procedure Register;
begin begin
RegisterComponents('System',[TLongTimer]); RegisterComponents('System', [TLongTimer]);
{$I longtimer_icon.lrs} {$I longtimer_icon.lrs}
end; end;
constructor TLongTimer.Create(TheOwner: TComponent); constructor TLongTimer.Create(TheOwner: TComponent);
Var sz:String; var
sz: string;
begin begin
inherited; inherited;
// Set About dialog properties // Set About dialog properties
AboutBoxComponentName:='TLongTimer'; AboutBoxComponentName := 'TLongTimer';
AboutBoxTitle:='TLongTimer Component'; AboutBoxTitle := 'TLongTimer Component';
// AboutBoxWidth (integer) // AboutBoxWidth (integer)
AboutBoxHeight:=380; AboutBoxHeight := 380;
sz:='LongTimer is a descendent of TIdleTimer' + LineEnding; sz := 'LongTimer is a descendent of TIdleTimer' + LineEnding;
sz+='and shares its properties and methods.' + LineEnding + LineEnding; sz += 'and shares its properties and methods.' + LineEnding + LineEnding;
sz+='Additional properties affect when the' + LineEnding; sz += 'Additional properties affect when the' + LineEnding;
sz+='OnTimer event is fired.' + LineEnding + LineEnding; sz += 'OnTimer event is fired.' + LineEnding + LineEnding;
sz+='With LongTimer, the OnTimer event' + LineEnding; sz += 'With LongTimer, the OnTimer event' + LineEnding;
sz+='will be fired only ONCE - every time' + LineEnding; sz += 'will be fired only ONCE - every time' + LineEnding;
sz+='the interval that you set is reached.'; sz += 'the interval that you set is reached.';
AboutBoxDescription:=sz; AboutBoxDescription := sz;
// AboutBoxBackgroundColor (TColor, like clWhite) // AboutBoxBackgroundColor (TColor, like clWhite)
// AboutBoxFontName (string) // AboutBoxFontName (string)
// AboutBoxFontSize (integer) // AboutBoxFontSize (integer)
AboutBoxVersion:='0.0.1'; AboutBoxVersion := '0.0.1';
AboutBoxAuthorname:='Gordon Bamber'; AboutBoxAuthorname := 'Gordon Bamber';
// AboutBoxOrganisation (string) // AboutBoxOrganisation (string)
AboutBoxAuthorEmail:='minesadorada@charcodelvalle.com'; AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
AboutBoxLicenseType:='LGPL';// (string e.g. 'GPL', ModifiedGPL' etc AboutBoxLicenseType := 'LGPL';// (string e.g. 'GPL', ModifiedGPL' etc
fHourDone:=false; fHourDone := False;
fDayDone:=False; fDayDone := False;
fDateDone:=False; fDateDone := False;
fCurrentDateTime:=Now; fCurrentDateTime := Now;
fLastFiredDateTime:=Now; fLastFiredDateTime := Now;
// Set defaults for properties // Set defaults for properties
fDate:=1; fDate := 1;
fSampleInterval:=lt3Every10Minutes; fSampleInterval := lt3Every10Minutes;
Interval:=10 * C_OneMinute; Interval := 10 * C_OneMinute;
fIntervalType:=lt1Daily; fIntervalType := lt1Daily;
fVersion:=C_Version; fVersion := C_Version;
end; end;
procedure TLongTimer.DoOnIdle(Sender: TObject; var Done: Boolean);
procedure TLongTimer.DoOnIdle(Sender: TObject; var Done: boolean);
begin begin
// Do nothing special here // Do nothing special here
inherited; inherited;
end; end;
procedure TLongTimer.DoOnIdleEnd(Sender: TObject); procedure TLongTimer.DoOnIdleEnd(Sender: TObject);
begin begin
// Do nothing special here // Do nothing special here
inherited; inherited;
end; end;
procedure TLongTimer.DoOnTimer; procedure TLongTimer.DoOnTimer;
// Only allow this event to fire ONCE if datetime matches the interval set // Only allow this event to fire ONCE if datetime matches the interval set
Var var
cDay,cD,cM,cY,cH,cMi,cS,cms:Word; cDay, cD, cM, cY, cH, cMi, cS, cms: word;
lDay,lD,lM,lY,lH,lMi,lS,lms:Word; lDay, lD, lM, lY, lH, lMi, lS, lms: word;
fTempDate:Word; fTempDate: word;
begin begin
// Split Current date into parts // Split Current date into parts
fCurrentDateTime:=Now; fCurrentDateTime := Now;
DecodeDate(fCurrentDateTime,cY,cM,cD); DecodeDate(fCurrentDateTime, cY, cM, cD);
DecodeTime(fCurrentDateTime,cH,cMi,cS,cmS); DecodeTime(fCurrentDateTime, cH, cMi, cS, cmS);
cDay:=DayOfTheMonth(fCurrentDateTime); cDay := DayOfTheMonth(fCurrentDateTime);
// Split LastFired date into parts // Split LastFired date into parts
DecodeDate(fLastFiredDateTime,lY,lM,lD); DecodeDate(fLastFiredDateTime, lY, lM, lD);
DecodeTime(fLastFiredDateTime,lH,lMi,lS,lmS); DecodeTime(fLastFiredDateTime, lH, lMi, lS, lmS);
lDay:=DayOfTheMonth(fLastFiredDateTime); lDay := DayOfTheMonth(fLastFiredDateTime);
// New hour? // New hour?
If (fIntervalType = lt1Daily) then if (fIntervalType = lt1Daily) then
If (cH <> lH) then fHourDone:=FALSE; if (cH <> lH) then
fHourDone := False;
// New Day? // New Day?
If (fIntervalType = lt2Weekly) then if (fIntervalType = lt2Weekly) then
If (cDay <> lDay) then if (cDay <> lDay) then
begin begin
fDayDone:=FALSE; fDayDone := False;
fHourDone:=FALSE; fHourDone := False;
end; end;
// New Date? // New Date?
If (fIntervalType = lt3Monthly) then if (fIntervalType = lt3Monthly) then
If (cD <> lD) then if (cD <> lD) then
begin begin
fDateDone:=FALSE; fDateDone := False;
fHourDone:=FALSE; fHourDone := False;
end; end;
// Fire the OnSample event? // Fire the OnSample event?
If Assigned(fOnSample) then fOnSample(Self); if Assigned(fOnSample) then
fOnSample(Self);
// Only proceed further at specified interval in specified hour - else exit // Only proceed further at specified interval in specified hour - else exit
If (fIntervalType = lt1Daily) and ((fHourDone = TRUE) OR (cH <> fHour)) then Exit; if (fIntervalType = lt1Daily) and ((fHourDone = True) or (cH <> fHour)) then
If (fIntervalType = lt2Weekly) and ((fDayDone = TRUE) OR (cH <> fHour)) then Exit; Exit;
If (fIntervalType = lt3Monthly) and ((fDateDone = 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 // Fire the OnTimer event for the user
inherited; // Do whatever the user wants done inherited; // Do whatever the user wants done
fLastFiredDateTime:=Now;// Record the DateTime the OnTimer was fired fLastFiredDateTime := Now;// Record the DateTime the OnTimer was fired
// Now make sure it doesn't fire more than once when resampled // Now make sure it doesn't fire more than once when resampled
// Deal with Months where fDate has been set to an invalid date // Deal with Months where fDate has been set to an invalid date
// (i.e. 31st February) // (i.e. 31st February)
// Simply temporarily decrement the fDate until it is valid // Simply temporarily decrement the fDate until it is valid
fTempDate:=fDate; fTempDate := fDate;
If (fIntervalType = lt3Monthly) then if (fIntervalType = lt3Monthly) then
While NOT IsValidDate(cY,cM,fTempDate) do Dec(fTempDate); while not IsValidDate(cY, cM, fTempDate) do
Dec(fTempDate);
// If ltDaily, then fDayDone and fDateDone are always FALSE // If ltDaily, then fDayDone and fDateDone are always FALSE
If (fIntervalType = lt1Daily) and (cH = fHour) then if (fIntervalType = lt1Daily) and (cH = fHour) then
begin begin
fHourDone := TRUE; fHourDone := True;
end; end;
// If ltWeekly, then fHourDone and fDateDone are always FALSE // If ltWeekly, then fHourDone and fDateDone are always FALSE
// Set only if on Correct Weekday and at specified hour // Set only if on Correct Weekday and at specified hour
If (fIntervalType = lt2Weekly) if (fIntervalType = lt2Weekly) and ((cDay = fDay) and (ch = fHour)) then
and ((cDay = fDay)
and (ch = fHour))
then
begin begin
fDayDone := TRUE; fDayDone := True;
fHourDone := TRUE; fHourDone := True;
end; end;
// If ltMonthly, then fDayDone and fHourDone are always FALSE // If ltMonthly, then fDayDone and fHourDone are always FALSE
// Set only if Correct day of month and at specified hour // Set only if Correct day of month and at specified hour
If (fIntervalType = lt3Monthly) and if (fIntervalType = lt3Monthly) and ((cD = fTempDate) and (ch = fHour)) then
((cD = fTempDate)
and (ch = fHour))
then
begin begin
fDateDone := TRUE; fDateDone := True;
fHourDone := TRUE; fHourDone := True;
end; end;
end; end;
procedure TLongTimer.SetSampleInterval(ASampleInterval:TSampleInterval); procedure TLongTimer.SetSampleInterval(ASampleInterval: TSampleInterval);
Var TimerEnabled:Boolean; var
Begin TimerEnabled: boolean;
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 begin
If ADay = fTDay then Exit; if ASampleInterval = fSampleInterval then
exit;
// Temporarily disable running timer? // Temporarily disable running timer?
TimerEnabled:=Enabled; TimerEnabled := Enabled;
Enabled:=False; Enabled := False;
fTDay:=aDay; case ASampleInterval of
fDay:=Ord(aDay)+1; lt1Everyminute: Interval := C_OneMinute;
Enabled:=TimerEnabled; 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. // ISO day numbers.
DayMonday = 1; DayMonday = 1;
@ -283,28 +299,34 @@ begin
} }
end; end;
Procedure TLongTimer.SetDailyHour(aHour:Word); procedure TLongTimer.SetDailyHour(aHour: word);
Var TimerEnabled:Boolean; var
TimerEnabled: boolean;
begin begin
If fHour=aHour then Exit; if fHour = aHour then
Exit;
// Temporarily disable running timer? // Temporarily disable running timer?
TimerEnabled:=Enabled; TimerEnabled := Enabled;
Enabled:=False; Enabled := False;
If (aHour >= 0) AND (aHour <=24) then fHour:=aHour; if (aHour >= 0) and (aHour <= 24) then
Enabled:=TimerEnabled; fHour := aHour;
Enabled := TimerEnabled;
end; end;
Procedure TLongTimer.SetMonthlyDate(ADate:Word); procedure TLongTimer.SetMonthlyDate(ADate: word);
Var TimerEnabled:Boolean; var
TimerEnabled: boolean;
begin begin
If ADate=fDate then Exit; if ADate = fDate then
Exit;
// Temporarily disable running timer? // Temporarily disable running timer?
TimerEnabled:=Enabled; TimerEnabled := Enabled;
Enabled:=False; Enabled := False;
If (fDate > 0) and (fDate < 32) then fDate:=ADate; if (fDate > 0) and (fDate < 32) then
fDate := ADate;
// Invalid dates like 31st Feb are dealt with in DoOnTimer // 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) // e.g. 31 stands for the last day in any month (inc Feb in a Leap Year)
Enabled:=TimerEnabled; Enabled := TimerEnabled;
end; end;
end. end.