Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 5

Project DATEEVT

Project Structure

DATEEVT.DPR

program DateEvt;

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
    procedure DateChange(Sender: TObject);
  end;

var
  DateForm: TDateForm;

implementation

{$R *.DFM}

procedure TDateForm.DateChange;
begin
  LabelDate.Caption := TheDay.Text;
end;

procedure TDateForm.FormCreate(Sender: TObject);
begin
  TheDay := TNewDate.Create (1998, 12, 25);
  LabelDate.Caption := TheDay.GetText;
  // assign the event handler for future changes
  TheDay.OnChange := DateChange;
end;

procedure TDateForm.BtnIncreaseClick(Sender: TObject);
begin
  TheDay.Increase;
end;

procedure TDateForm.BtnDecreaseClick(Sender: TObject);
begin
  TheDay.Decrease;
end;

procedure TDateForm.BtnAdd10Click(Sender: TObject);
begin
  TheDay.Increase (10);
end;

procedure TDateForm.BtnSubtract10Click(Sender: TObject);
begin
  TheDay.Decrease (10);
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);
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));
end;

end.

DATES.PAS

unit Dates;

interface

uses
  Classes, SysUtils;

type
  TDate = class
  private
    fDate: TDateTime;
    FOnChange: TNotifyEvent;
    function GetYear: Integer;
    function GetDay: Integer;
    function GetMonth: Integer;
    procedure SetDay(const Value: Integer);
    procedure SetMonth(const Value: Integer);
    procedure SetYear(const Value: Integer);
  protected
    procedure DoChange; dynamic;
  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;
    property OnChange: TNotifyEvent
      read FonChange write FOnChange;
  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);
  // fire the event
  DoChange;
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;
  // fire the event
  DoChange;
end;

function TDate.GetText: string;
begin
  GetText := DateToStr (fDate);
end;

procedure TDate.Decrease (NumberOfDays: Integer = 1);
begin
  fDate := fDate - NumberOfDays;
  // fire the event
  DoChange;
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;
  // fire the event
  DoChange;
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;

procedure TDate.DoChange;
begin
  if Assigned (FOnChange) then
    FOnChange (Self);
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