Dates.pas
上传用户:fh681027
上传日期:2022-07-23
资源大小:1959k
文件大小:3k
源码类别:

Delphi控件源码

开发平台:

Delphi

  1. unit Dates;
  2. interface
  3. uses
  4.   Classes, SysUtils;
  5. type
  6.   TDate = class (TComponent)
  7.   private
  8.     fDate: TDateTime;
  9.     FOnChange: TNotifyEvent;
  10.     function GetYear: Integer;
  11.     function GetDay: Integer;
  12.     function GetMonth: Integer;
  13.     procedure SetDay(const Value: Integer);
  14.     procedure SetMonth(const Value: Integer);
  15.     procedure SetYear(const Value: Integer);
  16.   protected
  17.     procedure DoChange; virtual;
  18.   public
  19.     constructor Create (AOwner: TComponent); overload; override;
  20.     constructor Create (y, m, d: Integer); reintroduce; overload;
  21.     procedure SetValue (y, m, d: Integer); overload;
  22.     procedure SetValue (NewDate: TDateTime); overload;
  23.     function LeapYear: Boolean;
  24.     procedure Increase (NumberOfDays: Integer = 1);
  25.     procedure Decrease (NumberOfDays: Integer = 1);
  26.     function GetText: string; virtual;
  27.     property Text: string read GetText;
  28.   published
  29.     property Day: Integer read GetDay write SetDay;
  30.     property Month: Integer read GetMonth write SetMonth;
  31.     property Year: Integer read GetYear write SetYear;
  32.     property OnChange: TNotifyEvent
  33.       read FonChange write FOnChange;
  34.   end;
  35.   // custom exception
  36.   EDateOutOfRange = class (Exception)
  37.   end;
  38. procedure Register;
  39. implementation
  40. procedure TDate.SetValue (y, m, d: Integer);
  41. begin
  42.   fDate := EncodeDate (y, m, d);
  43.   // fire the event
  44.   DoChange;
  45. end;
  46. function TDate.LeapYear: Boolean;
  47. begin
  48.   // compute leap years, considering "exceptions"
  49.   if (GetYear mod 4 <> 0) then
  50.     LeapYear := False
  51.   else if (GetYear mod 100 <> 0) then
  52.     LeapYear := True
  53.   else if (GetYear mod 400 <> 0) then
  54.     LeapYear := False
  55.   else
  56.     LeapYear := True;
  57. end;
  58. procedure TDate.Increase (NumberOfDays: Integer = 1);
  59. begin
  60.   fDate := fDate + NumberOfDays;
  61.   // fire the event
  62.   DoChange;
  63. end;
  64. function TDate.GetText: string;
  65. begin
  66.   GetText := DateToStr (fDate);
  67. end;
  68. procedure TDate.Decrease (NumberOfDays: Integer = 1);
  69. begin
  70.   fDate := fDate - NumberOfDays;
  71.   // fire the event
  72.   DoChange;
  73. end;
  74. constructor TDate.Create (y, m, d: Integer);
  75. begin
  76.   fDate := EncodeDate (y, m, d);
  77. end;
  78. constructor TDate.Create (AOwner: TComponent);
  79. begin
  80.   inherited Create (AOwner);
  81.   // today...
  82.   fDate := Date;
  83. end;
  84. function TDate.GetYear: Integer;
  85. var
  86.   y, m, d: Word;
  87. begin
  88.   DecodeDate (fDate, y, m, d);
  89.   Result := y;
  90. end;
  91. procedure TDate.SetValue(NewDate: TDateTime);
  92. begin
  93.   fDate := NewDate;
  94.   // fire the event
  95.   DoChange;
  96. end;
  97. function TDate.GetDay: Integer;
  98. var
  99.   y, m, d: Word;
  100. begin
  101.   DecodeDate (fDate, y, m, d);
  102.   Result := d;
  103. end;
  104. function TDate.GetMonth: Integer;
  105. var
  106.   y, m, d: Word;
  107. begin
  108.   DecodeDate (fDate, y, m, d);
  109.   Result := m;
  110. end;
  111. procedure TDate.SetDay(const Value: Integer);
  112. begin
  113.   if (Value < 1) or (Value > 31) then
  114.     raise EDateOutOfRange.Create ('Invalid day');
  115.   SetValue (Year, Month, Value);
  116. end;
  117. procedure TDate.SetMonth(const Value: Integer);
  118. begin
  119.   if (Value < 1) or (Value > 12) then
  120.     raise EDateOutOfRange.Create ('Invalid month');
  121.   SetValue (Year, Value, Day);
  122. end;
  123. procedure TDate.SetYear(const Value: Integer);
  124. begin
  125.   SetValue (Value, Month, Day);
  126. end;
  127. procedure TDate.DoChange;
  128. begin
  129.   if Assigned (FOnChange) then
  130.     FOnChange (Self);
  131. end;
  132. procedure Register;
  133. begin
  134.   RegisterComponents ('Md', [TDate]);
  135. end;
  136. end.