Новые позможности языка в Delphi 2006
01.01.2007
В Delphi 2006 появилось много расширений языка, в том числе перегрузка операторов, "Class-like" записи. Что позволяет создавать собственные типы данных (не классы, а именно типы значения)! Для демонстрации этих возможностей я написал тип TDate для работы с датами.
unit DateType;
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.
А вот пример его использования:
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;
Взято с Vingrad.ru https://forum.vingrad.ru