Marco's Web Center

Menu for Development

Site Menu
Object Pascal Handbook
Delphi Handbooks Collection
Mastering Borland Delphi 2005
(Old) White Papers
(Old)Tools
(Old) Conferences

My Other Sites
Italian Site (www.marcocantu.it)
the delphi search

Spirit of delphi

Advertising
Home My Blog Books Object Pascal Marco

Home: Code Repository: Mastering Delphi 6

Chapter 03 - Project NewDate

Project Structure

NewDate.dpr
program NewDate;

uses
  Forms,
  DateF in 'DateF.pas' {DateForm},
  Dates in 'Dates.pas';

{$R *.RES}

begin
  Application.Initialize;
  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;
    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);
  private
    TheDay: TNewDate;
  public
    { Public declarations }
  end;

var
  DateForm: TDateForm;

implementation

{$R *.DFM}

procedure TDateForm.FormCreate(Sender: TObject);
begin
  TheDay := TNewDate.Create (2001, 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;

end.
Dates.pas
unit Dates;

interface

type
  TDate = class
  private
    fDate: TDateTime;
    procedure SetDay(const Value: Integer);
    procedure SetMonth(const Value: Integer);
    procedure SetYear(const Value: Integer);
    function GetDay: Integer;
    function GetMonth: Integer;
    function GetYear: Integer;
  public
    constructor Create; overload;
    constructor Create (y, m, d: Integer); overload;
    procedure SetValue (y, m, d: Integer); overload;
    procedure SetValue (NewDate: TDateTime); overload;
    procedure Assign(Source: TDate);

    function LeapYear: Boolean;
    procedure Increase (NumberOfDays: Integer = 1);
    procedure Decrease (NumberOfDays: Integer = 1);
    function GetText: string;

    property Year: Integer read GetYear write SetYear;
    property Month: Integer read GetMonth write SetMonth;
    property Day: Integer read GetDay write SetDay;
  end;

  TNewDate = class (TDate)
  public
     function GetText: string;
  end;

implementation

uses
  SysUtils, DateUtils;

procedure TDate.Assign (Source: TDate);
begin
  fDate := Source.fDate;
end;

procedure TDate.SetValue (y, m, d: Integer);
begin
  fDate := EncodeDate (y, m, d);
end;

function TDate.LeapYear: Boolean;
begin
  Result := IsInLeapYear(fDate);
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;

procedure TDate.SetValue(NewDate: TDateTime);
begin
  fDate := NewDate;
end;

procedure TDate.SetDay(const Value: Integer);
begin
  fDate := RecodeDay (fDate, Value);
end;

procedure TDate.SetMonth(const Value: Integer);
begin
  fDate := RecodeMonth (fDate, Value);
end;

procedure TDate.SetYear(const Value: Integer);
begin
  fDate := RecodeYear (fDate, Value);
end;

function TDate.GetDay: Integer;
begin
  Result := DayOf (fDate);
end;

function TDate.GetMonth: Integer;
begin
  Result := MonthOf (fDate);
end;

function TDate.GetYear: Integer;
begin
  Result := YearOf (fDate);
end;

{ TNewDate }

function TNewDate.GetText: string;
begin
  GetText := FormatDateTime ('dddddd', fDate);
end;

end.
DateF.dfm
object DateForm: TDateForm
  Left = 225
  Top = 114
  Width = 260
  Height = 265
  ActiveControl = BtnIncrease
  Caption = 'NewDate'
  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 = 3
    Top = 16
    Width = 248
    Height = 22
    Alignment = taCenter
    AutoSize = False
    Caption = 'date'
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -16
    Font.Name = 'Arial'
    Font.Style = [fsBold]
    ParentFont = False
  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
end