You've already forked lazarus-ccr
Source code better formatted via JEDI
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@3669 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
gbamber
@ -1,4 +1,5 @@
|
||||
unit uLongTimer;
|
||||
|
||||
{ TlongTimer
|
||||
|
||||
Based on TIdleTimer component
|
||||
@ -33,33 +34,35 @@ uses
|
||||
|
||||
type
|
||||
TIntervalType = (lt1Daily, lt2Weekly, lt3Monthly);
|
||||
TSampleInterval = (lt1Everyminute,lt2Every5minutes,lt3Every10Minutes,lt4Every30Minutes,lt5Every45Minutes);
|
||||
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;
|
||||
fHour, fDay, fDate: word;
|
||||
fTday: TDay;
|
||||
fHourDone,fDayDone,fDateDone:Boolean;
|
||||
fHourDone, fDayDone, fDateDone: boolean;
|
||||
fSampleInterval: TSampleInterval;
|
||||
fVersion:String;
|
||||
fVersion: string;
|
||||
fOnSample: TNotifyEvent;
|
||||
Procedure SetDay(aDay:TDay);
|
||||
Procedure SetDailyHour(aHour:Word);
|
||||
Procedure SetMonthlyDate(ADate:Word);
|
||||
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 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;
|
||||
property LastFired: TDateTime read fLastFiredDateTime;
|
||||
published
|
||||
{ Published declarations }
|
||||
// Default=false
|
||||
@ -77,27 +80,31 @@ type
|
||||
// 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;
|
||||
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;
|
||||
property SampleInterval: TSampleInterval read fSampleInterval
|
||||
write SetSampleInterval default lt3Every10Minutes;
|
||||
// 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
|
||||
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
|
||||
property MonthlyDate:Word read fDate write SetMonthlyDate default 1;
|
||||
property MonthlyDate: word read fDate write SetMonthlyDate default 1;
|
||||
// Version string of this component
|
||||
property Version:String read fVersion;
|
||||
property Version: string read fVersion;
|
||||
// Fired every time LongTimer samples
|
||||
Property OnSample:TNotifyEvent read fOnSample write fOnSample;
|
||||
property OnSample: TNotifyEvent read fOnSample write fOnSample;
|
||||
end;
|
||||
|
||||
procedure Register;
|
||||
|
||||
implementation
|
||||
CONST
|
||||
|
||||
const
|
||||
C_OneMinute = 60000;
|
||||
C_Version = '0.0.2';
|
||||
|
||||
(*
|
||||
V0.0.1: Initial commit
|
||||
V0.0.2: Added OnSample event
|
||||
@ -108,8 +115,10 @@ begin
|
||||
RegisterComponents('System', [TLongTimer]);
|
||||
{$I longtimer_icon.lrs}
|
||||
end;
|
||||
|
||||
constructor TLongTimer.Create(TheOwner: TComponent);
|
||||
Var sz:String;
|
||||
var
|
||||
sz: string;
|
||||
begin
|
||||
inherited;
|
||||
// Set About dialog properties
|
||||
@ -134,7 +143,7 @@ begin
|
||||
AboutBoxAuthorEmail := 'minesadorada@charcodelvalle.com';
|
||||
AboutBoxLicenseType := 'LGPL';// (string e.g. 'GPL', ModifiedGPL' etc
|
||||
|
||||
fHourDone:=false;
|
||||
fHourDone := False;
|
||||
fDayDone := False;
|
||||
fDateDone := False;
|
||||
fCurrentDateTime := Now;
|
||||
@ -148,22 +157,25 @@ begin
|
||||
|
||||
fVersion := C_Version;
|
||||
end;
|
||||
procedure TLongTimer.DoOnIdle(Sender: TObject; var Done: Boolean);
|
||||
|
||||
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;
|
||||
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;
|
||||
@ -177,30 +189,35 @@ begin
|
||||
lDay := DayOfTheMonth(fLastFiredDateTime);
|
||||
|
||||
// New hour?
|
||||
If (fIntervalType = lt1Daily) then
|
||||
If (cH <> lH) then fHourDone:=FALSE;
|
||||
if (fIntervalType = lt1Daily) then
|
||||
if (cH <> lH) then
|
||||
fHourDone := False;
|
||||
// New Day?
|
||||
If (fIntervalType = lt2Weekly) then
|
||||
If (cDay <> lDay) then
|
||||
if (fIntervalType = lt2Weekly) then
|
||||
if (cDay <> lDay) then
|
||||
begin
|
||||
fDayDone:=FALSE;
|
||||
fHourDone:=FALSE;
|
||||
fDayDone := False;
|
||||
fHourDone := False;
|
||||
end;
|
||||
// New Date?
|
||||
If (fIntervalType = lt3Monthly) then
|
||||
If (cD <> lD) then
|
||||
if (fIntervalType = lt3Monthly) then
|
||||
if (cD <> lD) then
|
||||
begin
|
||||
fDateDone:=FALSE;
|
||||
fHourDone:=FALSE;
|
||||
fDateDone := False;
|
||||
fHourDone := False;
|
||||
end;
|
||||
|
||||
// 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
|
||||
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;
|
||||
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
|
||||
@ -212,46 +229,43 @@ begin
|
||||
// (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 (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
|
||||
if (fIntervalType = lt1Daily) and (cH = fHour) then
|
||||
begin
|
||||
fHourDone := TRUE;
|
||||
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
|
||||
if (fIntervalType = lt2Weekly) and ((cDay = fDay) and (ch = fHour)) then
|
||||
begin
|
||||
fDayDone := TRUE;
|
||||
fHourDone := TRUE;
|
||||
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
|
||||
if (fIntervalType = lt3Monthly) and ((cD = fTempDate) and (ch = fHour)) then
|
||||
begin
|
||||
fDateDone := TRUE;
|
||||
fHourDone := TRUE;
|
||||
fDateDone := True;
|
||||
fHourDone := True;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TLongTimer.SetSampleInterval(ASampleInterval: TSampleInterval);
|
||||
Var TimerEnabled:Boolean;
|
||||
Begin
|
||||
If ASampleInterval = fSampleInterval then exit;
|
||||
var
|
||||
TimerEnabled: boolean;
|
||||
begin
|
||||
if ASampleInterval = fSampleInterval then
|
||||
exit;
|
||||
// Temporarily disable running timer?
|
||||
TimerEnabled := Enabled;
|
||||
Enabled := False;
|
||||
Case ASampleInterval of
|
||||
case ASampleInterval of
|
||||
lt1Everyminute: Interval := C_OneMinute;
|
||||
lt2Every5minutes: Interval := 5 * C_OneMinute;
|
||||
lt3Every10Minutes: Interval := 10 * C_OneMinute;
|
||||
@ -261,10 +275,12 @@ Begin
|
||||
Enabled := TimerEnabled;
|
||||
end;
|
||||
|
||||
Procedure TLongTimer.SetDay(aDay:TDay);
|
||||
Var TimerEnabled:Boolean;
|
||||
procedure TLongTimer.SetDay(aDay: TDay);
|
||||
var
|
||||
TimerEnabled: boolean;
|
||||
begin
|
||||
If ADay = fTDay then Exit;
|
||||
if ADay = fTDay then
|
||||
Exit;
|
||||
// Temporarily disable running timer?
|
||||
TimerEnabled := Enabled;
|
||||
Enabled := False;
|
||||
@ -283,25 +299,31 @@ begin
|
||||
}
|
||||
end;
|
||||
|
||||
Procedure TLongTimer.SetDailyHour(aHour:Word);
|
||||
Var TimerEnabled:Boolean;
|
||||
procedure TLongTimer.SetDailyHour(aHour: word);
|
||||
var
|
||||
TimerEnabled: boolean;
|
||||
begin
|
||||
If fHour=aHour then Exit;
|
||||
if fHour = aHour then
|
||||
Exit;
|
||||
// Temporarily disable running timer?
|
||||
TimerEnabled := Enabled;
|
||||
Enabled := False;
|
||||
If (aHour >= 0) AND (aHour <=24) then fHour:=aHour;
|
||||
if (aHour >= 0) and (aHour <= 24) then
|
||||
fHour := aHour;
|
||||
Enabled := TimerEnabled;
|
||||
end;
|
||||
|
||||
Procedure TLongTimer.SetMonthlyDate(ADate:Word);
|
||||
Var TimerEnabled:Boolean;
|
||||
procedure TLongTimer.SetMonthlyDate(ADate: word);
|
||||
var
|
||||
TimerEnabled: boolean;
|
||||
begin
|
||||
If ADate=fDate then Exit;
|
||||
if ADate = fDate then
|
||||
Exit;
|
||||
// Temporarily disable running timer?
|
||||
TimerEnabled := Enabled;
|
||||
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
|
||||
// e.g. 31 stands for the last day in any month (inc Feb in a Leap Year)
|
||||
Enabled := TimerEnabled;
|
||||
|
||||
Reference in New Issue
Block a user