unit utmadcustomfields;
{ This file defines a custom TDateTimeField to override the standard one. The
(initial) purpose is to select a DateTime from the Database - which is in UTC Time -
and use it as a Local Time value. I decided to try this approach
for the experience of overriding a registered class.
I tried reintroducing GetData() - all GetAsXXXXX methods ultimately call it -
but the Ancestor class calls still go to the Acnestor's implementation. So,
I am overriding the GetAsXXXXX methods that TDateTime overrides:
GetAsDateTime
GetAsFloat - calls GetAsDateTime - no overide necessary
GetAsString - calls GetText - copied implementation from fields.inc (with changes)
GetAsVariant - returns a TDateTime or Null
SetAsDateTime
SetAsFloat - calls SetAsDateTime - no overide necessary
SetAsString - calls StrToDateTime -
SetVarValue - calls SetAsDateTime - no overide necessary
}
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, DB, DateUtils;
type
{ TMadUtcDateTimeField }
{ This class behaves just like TDateTimeField if ShowAsLocalTime is False
(default). When ShowAsLocalTime is True, the stored data is treated as
a UTC time and is converted To/From LocalTime. }
TMadUtcDateTimeField = class(TDateTimeField)
protected
FShowAsLocalTime: Boolean;
function GetAsDateTime(): TDateTime; override;
procedure GetText(var AText: string; ADisplayText: Boolean); override;
function GetAsVariant(): variant; override;
procedure SetAsDateTime(aValue: TDateTime); override;
procedure SetAsString(const AValue: string); override;
published
{ If True, the source data is considered to be a UTC datetime value.
GetAsXXXXXXX will convert it and return a Local time.
SetAsXXXXXXX will convert the provided value and store as a UTC time. }
property ShowAsLocalTime: Boolean read FShowAsLocalTime write FShowAsLocalTime;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterClass(TMadUtcDateTimeField);
end;
{ TMadUtcDateTimeField }
{ Return the current value as a DateTime value. If SourceIsUTC is True, the value
is considered to be a UTC value and is (converted to and) returned as a Local value }
function TMadUtcDateTimeField.GetAsDateTime(): TDateTime;
begin
Result := inherited GetAsDateTime();
if (FShowAsLocalTime) then
Result := UniversalTimeToLocal(Result);
end;
{ Copied from fields.inc - with changes}
procedure TMadUtcDateTimeField.GetText(var AText: string; ADisplayText: Boolean);
var
R : TDateTime;
F : String;
begin
If Not GetData(@R,False) then
AText:=''
else
begin
// MAD - convert to Local
if (FShowAsLocalTime) then R := UniversalTimeToLocal(R);
If (ADisplayText) and (Length(Self.DisplayFormat)<>0) then
F:=Self.DisplayFormat // MAD
else
Case DataType of
ftTime : F:=DefaultFormatSettings.LongTimeFormat; // MAD
ftDate : F:=DefaultFormatSettings.ShortDateFormat; // MAD
else
F:='c'
end;
AText:=FormatDateTime(F,R);
end;
end;
{ inherited returns a TDateTime or Null. Convert if it is not Null }
function TMadUtcDateTimeField.GetAsVariant(): variant;
begin
Result := inherited GetAsVariant();
if ((FShowAsLocalTime) and (Result <> Null)) then
Result := UniversalTimeToLocal(Result);
end;
{ Set the stored value as a DateTime value. If SourceIsUTC is True, the provided
value is considered to be a Local Time and is converted to UTC. }
procedure TMadUtcDateTimeField.SetAsDateTime(aValue: TDateTime);
begin
if (FShowAsLocalTime) then
aValue := LocalTimeToUniversal(aValue);
inherited SetAsDateTime(aValue);
end;
{ inherited sets the value, then we convert the Value if FShowAsLocalTime is True }
procedure TMadUtcDateTimeField.SetAsString(const AValue: string);
begin
inherited SetAsString(AValue);
if (AValue <> '') then
if (FShowAsLocalTime) then
Self.Value := LocalTimeToUniversal(Self.Value);
end;
end.
Recent
