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 5

Project VIEWDATE

Project Structure


VIEWDATE.DPR

program Viewdate;

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;
    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: TDate;
  public
    { Public declarations }
  end;

var
  DateForm: TDateForm;

implementation

{$R *.DFM}

procedure TDateForm.FormCreate(Sender: TObject);
begin
  TheDay := TDate.Create (1999, 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;
    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;
    function LeapYear: Boolean;
    procedure Increase (NumberOfDays: Integer = 1);
    procedure Decrease (NumberOfDays: Integer = 1);
    function GetText: string;
  end;

implementation

uses
  SysUtils;

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;

end.

DATEF.DFM

object DateForm: TDateForm
  Left = 225
  Top = 114
  Width = 257
  Height = 265
  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 = 32
    Alignment = taCenter
    AutoSize = False
    Caption = 'date'
    Font.Charset = ANSI_CHARSET
    Font.Color = clBlack
    Font.Height = -27
    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