Code:

unit DateType;

{©Drkb v.3(2007): www.drkb.ru}

interface

uses Windows, SysUtils;

type

TYear = Integer;

TMonth = 1..12;

TDay = 1..31;

EInvalidDateFormat = class(Exception);

TDate = record

private

   FValue: Integer;

   function GetText: string;

   procedure SetText(const Value: string);

   procedure SetValue(const Value: Integer);

   function GetDay: TDay;

   function GetMonth: TMonth;

   function GetYear: TYear;

   procedure SetDay(const NewDay: TDay);

   procedure SetMonth(const NewMonth: TMonth);

   procedure SetYear(const NewYear: TYear);

   function GetISODate: string;

   procedure SetISODate(const Value: string);

   property Value: Integer read FValue write SetValue;

public

   class function Today: TDate; static;

   class function FromString(const S, FmtStr: string): TDate; static;

   class function ToString(Date: TDate; const FmtStr: string): string; static;

   function Format(const FmtStr: string): string;

   property Year: TYear read GetYear write SetYear;

   property Month: TMonth read GetMonth write SetMonth;

   property Day: TDay read GetDay write SetDay;

   property Text: string read GetText write SetText;

   property ISODate: string read GetISODate write SetISODate;

public

   class operator Add(a: TDate; b: Integer): TDate; inline;

   class operator Subtract(a: TDate; b: Integer): TDate; inline;

   class operator Subtract(a: TDate; b: TDate): Integer; inline;

   class operator Implicit(a: Integer): TDate; inline;

   class operator Implicit(a: TDate): Integer; inline;

   class operator Implicit(a: TDateTime): TDate; inline;

   class operator Implicit(a: TDate): TDateTime; inline;

   class operator Inc(a: TDate): TDate; inline;

   class operator Dec(a: TDate): TDate; inline;

   class operator Equal(a, b: TDate): Boolean; inline;

   class operator NotEqual(a, b: TDate): Boolean; inline;

   class operator GreaterThan(a, b: TDate): Boolean; inline;

   class operator GreaterThanOrEqual(a, b: TDate): Boolean; inline;

   class operator LessThan(a, b: TDate): Boolean; inline;

   class operator LessThanOrEqual(a, b: TDate): Boolean; inline;

end;

const

January   : TMonth = 1;

February  : TMonth = 2;

March     : TMonth = 3;

April     : TMonth = 4;

May       : TMonth = 5;

June      : TMonth = 6;

July      : TMonth = 7;

August    : TMonth = 8;

September : TMonth = 9;

October   : TMonth = 10;

November  : TMonth = 11;

December  : TMonth = 12;

var

EraStr: array[Boolean] of string = (' i.y.', ' ai i.y.');

DefaultDateFormat: string = 'DD.MM.YYYYE';

implementation

resourcestring

SInvalidDateFormat = 'Invalid date format ''%s''';

type

TSetOfChar = set of Char;

function IntToStr(const Value: Integer; L: Integer): string; overload;

begin

Result := SysUtils.IntToStr(Value);

if Length(Result) < L then

   Result := StringOfChar('0', L - Length(Result)) + Result;

end;

procedure DivMod(Dividend: Integer; Divisor: Integer;  var Result, Remainder: Integer); inline;

begin

Result := Dividend div Divisor;

Remainder := Dividend mod Divisor;

end;

function ScanChars(var P: PChar; Chars: TSetOfChar): Integer; inline;

begin

Result := 0;

while P^ in Chars do

begin

   Inc(Result);

   Inc(P);

end;

end;

function ScanNum(var P: PChar; var Value: Integer): Boolean; inline;

begin

Result := False;

Value := 0;

while P^ in ['0'..'9'] do

begin

   Value := (Value * 10) + Ord(P^) - Ord('0');

   Inc(P);

   Result := True;

end;

end;

function ScanText(var P: PChar; Text: array of string; var Index: Integer): Boolean;

var

I: Integer;

begin

for I := Low(Text) to High(Text) do

   if AnsiSameText(Text[I], Copy(string(P), 1, Length(Text[I]))) then

   begin

     Index := I;

     Result := True;

     Exit;

   end;

Result := False;

end;

function EncodeDate(Year: TYear; Month: TMonth; Day: TDay): Integer; inline;

var

I, D: Integer;

DayTable: PDayTable;

begin

DayTable := @MonthDays[IsLeapYear(Year)];

if Year >= 0 then

begin

   D := Day;

   for I := 1 to Month - 1 do

     Inc(D, DayTable^[I]);

   I := Year - 1;

end

else

begin

   D := Day - DayTable^[Month];

   for I := 12 downto Month + 1 do

     Dec(D, DayTable^[I]);

   I := Year + 1;

end;

Result := I * 365 + I div 4 - I div 100 + I div 400 + D;

end;

procedure DecodeDate(Date: Integer; var Year: TYear; var Month: TMonth; var Day: TDay); inline;

const

D1 = 365;

D4 = D1 * 4 + 1;

D100 = D4 * 25 - 1;

D400 = D100 * 4 + 1;

var

Y, M, D, I: Integer;

DayTable: PDayTable;

T: Integer;

begin

if Date = 0 then

begin

   Year := -1;

   Month := 12;

   Day := 31;

   Exit;

end

else if Date < 0 then

   T := -Date + 1

else

   T := Date;

Dec(T);

Y := 1;

while T >= D400 do

begin

   Dec(T, D400);

   Inc(Y, 400);

end;

DivMod(T, D100, I, D);

if I = 4 then

begin

   Dec(I);

   Inc(D, D100);

end;

Inc(Y, I * 100);

DivMod(D, D4, I, D);

Inc(Y, I * 4);

DivMod(D, D1, I, D);

if I = 4 then

begin

   Dec(I);

   Inc(D, D1);

end;

Inc(Y, I);

DayTable := @MonthDays[IsLeapYear(Y)];

if Date < 0 then

begin

   M := 1;

   if IsLeapYear(Y) then

     D := 365 - D

   else

     D := 364 - D;

   while True do

   begin

     I := DayTable^[M];

     if D < I then Break;

     Dec(D, I);

     Inc(M);

   end;

   Y := -Y;

end

else

begin

   M := 1;

   while True do

   begin

     I := DayTable^[M];

     if D < I then Break;

     Dec(D, I);

     Inc(M);

   end;

end;

Year := Y;

Month := M;

Day := D + 1;

end;

{ TDate }

class operator TDate.Implicit(a: TDateTime): TDate;

var

Y, M, D: Word;

begin

SysUtils.DecodeDate(a, Y, M, D);

Result.FValue := EncodeDate(Y, M, D);

end;

class operator TDate.Implicit(a: TDate): TDateTime;

var

Y: TYear;

M: TMonth;

D: TDay;

begin

DecodeDate(a.FValue, Y, M, D);

Result := SysUtils.EncodeDate(Y, M, D);

end;

class operator TDate.Implicit(a: Integer): TDate;

begin

Result.FValue := a;

end;

class operator TDate.Implicit(a: TDate): Integer;

begin

Result := a.FValue;

end;

class operator TDate.Inc(a: TDate): TDate;

begin

Result.FValue := a.FValue + 1;

end;

class operator TDate.Dec(a: TDate): TDate;

begin

Result.FValue := a.FValue - 1;

end;

class operator TDate.Equal(a, b: TDate): Boolean;

begin

Result := a.FValue = b.FValue;

end;

class operator TDate.NotEqual(a, b: TDate): Boolean;

begin

Result := a.FValue <> b.FValue;

end;

class operator TDate.GreaterThan(a, b: TDate): Boolean;

begin

Result := a.FValue > b.FValue;

end;

class operator TDate.GreaterThanOrEqual(a, b: TDate): Boolean;

begin

Result := a.FValue >= b.FValue;

end;

class operator TDate.LessThan(a, b: TDate): Boolean;

begin

Result := a.FValue < b.FValue;

end;

class operator TDate.LessThanOrEqual(a, b: TDate): Boolean;

begin

Result := a.FValue <= b.FValue;

end;

class operator TDate.Add(a: TDate; b: Integer): TDate;

begin

Result.FValue := a.FValue + b;

end;

class operator TDate.Subtract(a, b: TDate): Integer;

begin

Result := a.FValue - b.FValue;

end;

class operator TDate.Subtract(a: TDate; b: Integer): TDate;

begin

Result.FValue := a.FValue - b;

end;

class function TDate.Today: TDate;

var

SystemTime: TSystemTime;

begin

GetLocalTime(SystemTime);

with SystemTime do

   Result.FValue := EncodeDate(wYear, wMonth, wDay);

end;

class function TDate.FromString(const S, FmtStr: string): TDate;

procedure Error;

begin

   raise EInvalidDateFormat.CreateResFmt(@SInvalidDateFormat, [S]);

end;

var

Fmt, Src: PChar;

Y, M, D, E, L: Integer;

HasY, HasM, HasD: Boolean;

begin

E := 1;

Fmt := PChar(FmtStr);

Src := PChar(S);

HasY := False;

HasM := False;

HasD := False;

while (Fmt^ <> #0) and (Src^ <> #0) do

begin

   case Fmt^ of

   'Y', 'y':

     begin

       ScanChars(Fmt, ['Y', 'y']);

       if not ScanNum(Src, Y) then Error;

       HasY := True;

     end;

   'M', 'm':

     begin

       L := ScanChars(Fmt, ['M', 'm']);

       case L of

       1, 2: if not ScanNum(Src, M) then Error;

       3:    if not ScanText(Src, ShortMonthNames, M) then Error;

       else

         if not ScanText(Src, LongMonthNames, M) then Error;

       end;

       HasM := True;

     end;

   'D', 'd':

     begin

       ScanChars(Fmt, ['D', 'd']);

       if not ScanNum(Src, D) then Error;

       HasD := True;

     end;

   'E', 'e':

     begin

       ScanChars(Fmt, ['E', 'e']);

       if ScanText(Src, EraStr, E) then

         if E = 1 then

           E := -1;

     end;

   else

     Inc(Fmt);

     Inc(Src);

   end;

end;

if not (HasY and HasM and HasD) then Error;

Result := EncodeDate(Y * E, M, D);

end;

class function TDate.ToString(Date: TDate; const FmtStr: string): string;

var

Y: TYear;

M: TMonth;

D: TDay;

P: PChar;

L: Integer;

begin

Result := '';

DecodeDate(Date.Value, Y, M, D);

P := PChar(FmtStr);

while P^ <> #0 do

begin

   case P^ of

   'E', 'e':

     begin

       L := ScanChars(P, ['E', 'e']);

       if (L > 1) or (Y < 0) then

         Result := Result + EraStr[Y < 0];

     end;

   'Y', 'y':

     begin

       L := ScanChars(P, ['Y', 'y']);

       Result := Result + IntToStr(Abs(Y), L);

     end;

   'M', 'm':

     begin

       L := ScanChars(P, ['M', 'm']);

       case L of

       1, 2: Result := Result + IntToStr(M, L);

       3: Result := Result + ShortMonthNames[M];

       else

         Result := Result + LongMonthNames[M];

       end;

     end;

   'D', 'd':

     begin

       L := ScanChars(P, ['D', 'd']);

       Result := Result + IntToStr(D, L);

     end;

   else

     begin

       Result := Result + P^;

       Inc(P);

     end;

   end;

end;

end;

function TDate.Format(const FmtStr: string): string;

begin

Result := TDate.ToString(Self, FmtStr);

end;

function TDate.GetText: string;

begin

Result := Format(DefaultDateFormat);

end;

procedure TDate.SetText(const Value: string);

begin

Self.Value := FromString(Value, DefaultDateFormat);

end;

function TDate.GetDay: TDay;

var

Y: TYear;

M: TMonth;

begin

DecodeDate(FValue, Y, M, Result);

end;

function TDate.GetISODate: string;

begin

Result := Format('YYYY-MM-DD');

end;

function TDate.GetMonth: TMonth;

var

Y: TYear;

D: TDay;

begin

DecodeDate(FValue, Y, Result, D);

end;

function TDate.GetYear: TYear;

var

M: TMonth;

D: TDay;

begin

DecodeDate(FValue, Result, M, D);

end;

procedure TDate.SetDay(const NewDay: TDay);

var

Y: TYear;

M: TMonth;

D: TDay;

begin

DecodeDate(Value, Y, M, D);

Value := EncodeDate(Y, M, NewDay);

end;

procedure TDate.SetISODate(const Value: string);

begin

Self.Value := TDate.FromString(Value, 'YYYY-MM-DD');

end;

procedure TDate.SetMonth(const NewMonth: TMonth);

var

Y: TYear;

M: TMonth;

D: TDay;

begin

DecodeDate(Value, Y, M, D);

Value := EncodeDate(Y, NewMonth, D);

end;

procedure TDate.SetValue(const Value: Integer);

begin

FValue := Value;

end;

procedure TDate.SetYear(const NewYear: TYear);

var

Y: TYear;

M: TMonth;

D: TDay;

begin

DecodeDate(Value, Y, M, D);

Value := EncodeDate(NewYear, M, D);

end;

end.

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

Date: TDate;

begin

Label1.Caption := Date.Text;

Date := TDate.Today;

Label2.Caption := Date.Text;

Dec(Date);

Label3.Caption := Date.Text;

Label4.Caption := IntToStr(TDate.Today - Date);

Date := Now;

Label5.Caption := Date.Format('DD MMM YYYY');

Date := MaxInt;

Label6.Caption := Date.Text;

Date.ISODate := '2009-11-25';

Label7.Caption := Date.Text;

Date.Year := 1993;

Label8.Caption := Date.Text;

end;