Project DATEPROP
Project Structure
DATEPROP.DPR
program DateProp;
uses
Forms,
DateF in 'DateF.pas' {DateForm},
Dates in 'DATES.PAS';
{$R *.RES}
begin
Application.CreateForm(TDateForm, DateForm);
Application.Run;
end.
DATEF.PAS
unit DateF;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls,
Forms, Dialogs, Dates, StdCtrls;
type
TDateForm = class(TForm)
LabelDate: TLabel;
BtnIncrease: TButton;
BtnDecrease: TButton;
BtnAdd10: TButton;
BtnSubtract10: TButton;
BtnLeap: TButton;
BtnToday: TButton;
EditYear: TEdit;
EditMonth: TEdit;
EditDay: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
BtnRead: TButton;
BtnWrite: TButton;
procedure BtnIncreaseClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure BtnDecreaseClick(Sender: TObject);
procedure BtnAdd10Click(Sender: TObject);
procedure BtnSubtract10Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure BtnLeapClick(Sender: TObject);
procedure BtnTodayClick(Sender: TObject);
procedure BtnReadClick(Sender: TObject);
procedure BtnWriteClick(Sender: TObject);
private
TheDay: TNewDate;
public
{ Public declarations }
end;
var
DateForm: TDateForm;
implementation
{$R *.DFM}
procedure TDateForm.FormCreate(Sender: TObject);
begin
TheDay := TNewDate.Create (2000, 12, 25);
LabelDate.Caption := TheDay.GetText;
end;
procedure TDateForm.BtnIncreaseClick(Sender: TObject);
begin
TheDay.Increase;
LabelDate.Caption := TheDay.GetText;
end;
procedure TDateForm.BtnDecreaseClick(Sender: TObject);
begin
TheDay.Decrease;
LabelDate.Caption := TheDay.GetText;
end;
procedure TDateForm.BtnAdd10Click(Sender: TObject);
begin
TheDay.Increase (10);
LabelDate.Caption := TheDay.GetText;
end;
procedure TDateForm.BtnSubtract10Click(Sender: TObject);
begin
TheDay.Decrease (10);
LabelDate.Caption := TheDay.GetText;
end;
procedure TDateForm.FormDestroy(Sender: TObject);
begin
TheDay.Free;
end;
procedure TDateForm.BtnLeapClick(Sender: TObject);
begin
if TheDay.LeapYear then
ShowMessage ('Leap year')
else
ShowMessage ('NON Leap year');
end;
procedure TDateForm.BtnTodayClick(Sender: TObject);
begin
TheDay.SetValue (Date);
LabelDate.Caption := TheDay.GetText;
end;
procedure TDateForm.BtnReadClick(Sender: TObject);
begin
EditYear.Text := IntToStr (TheDay.Year);
EditMonth.Text := IntToStr (TheDay.Month);
EditDay.Text := IntToStr (TheDay.Day);
end;
procedure TDateForm.BtnWriteClick(Sender: TObject);
begin
// might cause problems
{TheDay.Year := StrToInt (EditYear.Text);
TheDay.Month := StrToInt (EditMonth.Text);
TheDay.Day := StrToInt (EditDay.Text);}
// better solution
TheDay.SetValue (StrToInt (EditYear.Text),
StrToInt (EditMonth.Text), StrToInt (EditDay.Text));
// update the label
LabelDate.Caption := TheDay.Text;
end;
end.
DATES.PAS
unit Dates;
interface
uses
SysUtils;
type
TDate = class
private
fDate: TDateTime;
function GetYear: Integer;
function GetDay: Integer;
function GetMonth: Integer;
procedure SetDay(const Value: Integer);
procedure SetMonth(const Value: Integer);
procedure SetYear(const Value: Integer);
public
constructor Create; overload;
constructor Create (y, m, d: Integer); overload;
procedure SetValue (y, m, d: Integer); overload;
procedure SetValue (NewDate: TDateTime); overload;
function LeapYear: Boolean;
procedure Increase (NumberOfDays: Integer = 1);
procedure Decrease (NumberOfDays: Integer = 1);
function GetText: string; virtual;
property Day: Integer read GetDay write SetDay;
property Month: Integer read GetMonth write SetMonth;
property Year: Integer read GetYear write SetYear;
property Text: string read GetText;
end;
TNewDate = class (TDate)
public
function GetText: string; override;
end;
// custom exception
EDateOutOfRange = class (Exception)
end;
implementation
procedure TDate.SetValue (y, m, d: Integer);
begin
fDate := EncodeDate (y, m, d);
end;
function TDate.LeapYear: Boolean;
begin
// compute leap years, considering "exceptions"
if (GetYear mod 4 <> 0) then
LeapYear := False
else if (GetYear mod 100 <> 0) then
LeapYear := True
else if (GetYear mod 400 <> 0) then
LeapYear := False
else
LeapYear := True;
end;
procedure TDate.Increase (NumberOfDays: Integer = 1);
begin
fDate := fDate + NumberOfDays;
end;
function TDate.GetText: string;
begin
GetText := DateToStr (fDate);
end;
procedure TDate.Decrease (NumberOfDays: Integer = 1);
begin
fDate := fDate - NumberOfDays;
end;
constructor TDate.Create (y, m, d: Integer);
begin
fDate := EncodeDate (y, m, d);
end;
constructor TDate.Create;
begin
fDate := Date;
end;
function TDate.GetYear: Integer;
var
y, m, d: Word;
begin
DecodeDate (fDate, y, m, d);
Result := y;
end;
procedure TDate.SetValue(NewDate: TDateTime);
begin
fDate := NewDate;
end;
function TDate.GetDay: Integer;
var
y, m, d: Word;
begin
DecodeDate (fDate, y, m, d);
Result := d;
end;
function TDate.GetMonth: Integer;
var
y, m, d: Word;
begin
DecodeDate (fDate, y, m, d);
Result := m;
end;
procedure TDate.SetDay(const Value: Integer);
begin
if (Value < 0) or (Value > 31) then
raise EDateOutOfRange.Create ('Invalid month');
SetValue (Year, Month, Value);
end;
procedure TDate.SetMonth(const Value: Integer);
begin
if (Value < 0) or (Value > 12) then
raise EDateOutOfRange.Create ('Invalid month');
SetValue (Year, Value, Day);
end;
procedure TDate.SetYear(const Value: Integer);
begin
SetValue (Value, Month, Day);
end;
{ TNewDate }
function TNewDate.GetText: string;
begin
GetText := FormatDateTime ('mmmm dd, yyyy', fDate);
end;
end.
DATEF.DFM
object DateForm: TDateForm
Left = 225
Top = 114
Width = 257
Height = 388
ActiveControl = BtnIncrease
Caption = 'Dates'
Color = clBtnFace
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = True
OnCreate = FormCreate
OnDestroy = FormDestroy
PixelsPerInch = 96
TextHeight = 13
object LabelDate: TLabel
Left = 16
Top = 16
Width = 217
Height = 22
Alignment = taCenter
AutoSize = False
Caption = 'date'
Font.Charset = ANSI_CHARSET
Font.Color = clBlack
Font.Height = -19
Font.Name = 'Arial'
Font.Style = [fsBold]
ParentFont = False
end
object Label1: TLabel
Left = 32
Top = 244
Width = 22
Height = 13
Caption = 'Year'
end
object Label2: TLabel
Left = 32
Top = 277
Width = 30
Height = 13
Caption = 'Month'
end
object Label3: TLabel
Left = 32
Top = 308
Width = 19
Height = 13
Caption = 'Day'
end
object BtnIncrease: TButton
Left = 32
Top = 64
Width = 81
Height = 41
Caption = '&Increase'
TabOrder = 0
OnClick = BtnIncreaseClick
end
object BtnDecrease: TButton
Left = 128
Top = 64
Width = 89
Height = 41
Caption = '&Decrease'
TabOrder = 1
OnClick = BtnDecreaseClick
end
object BtnAdd10: TButton
Left = 32
Top = 120
Width = 81
Height = 41
Caption = '&Add 10'
TabOrder = 2
OnClick = BtnAdd10Click
end
object BtnSubtract10: TButton
Left = 128
Top = 120
Width = 89
Height = 41
Caption = '&Subtract 10'
TabOrder = 3
OnClick = BtnSubtract10Click
end
object BtnLeap: TButton
Left = 32
Top = 176
Width = 81
Height = 41
Caption = '&Leap Year?'
TabOrder = 4
OnClick = BtnLeapClick
end
object BtnToday: TButton
Left = 128
Top = 176
Width = 89
Height = 41
Caption = '&Today'
TabOrder = 5
OnClick = BtnTodayClick
end
object EditYear: TEdit
Left = 72
Top = 240
Width = 65
Height = 21
TabOrder = 6
end
object EditMonth: TEdit
Left = 72
Top = 272
Width = 65
Height = 21
TabOrder = 7
end
object EditDay: TEdit
Left = 72
Top = 304
Width = 65
Height = 21
TabOrder = 8
end
object BtnRead: TButton
Left = 152
Top = 256
Width = 65
Height = 25
Caption = 'Read'
TabOrder = 9
OnClick = BtnReadClick
end
object BtnWrite: TButton
Left = 152
Top = 288
Width = 65
Height = 25
Caption = 'Write'
TabOrder = 10
OnClick = BtnWriteClick
end
end
|
