Marco Web Center

[an error occurred while processing this directive]

Home: Code Repository: Mastering Delphi 6

Chapter 02 - 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)
    BtnIncrease: 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 FormDestroy(Sender: TObject);
    procedure BtnReadClick(Sender: TObject);
    procedure BtnWriteClick(Sender: TObject);
  private
    TheDay: TDate;
  public
    { Public declarations }
  end;

var
  DateForm: TDateForm;

implementation

{$R *.DFM}

procedure TDateForm.FormCreate(Sender: TObject);
begin
  TheDay := TDate.Create;
  TheDay.SetValue (2001, 12, 25);
end;

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

procedure TDateForm.FormDestroy(Sender: TObject);
begin
  TheDay.Free;
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
  TheDay.SetValue (StrToInt (EditYear.Text),
    StrToInt (EditMonth.Text), StrToInt (EditDay.Text));
end;

end.
DATES.PAS
unit Dates;

interface

uses
  SysUtils;

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
    procedure SetValue (y, m, d: Integer); overload;
    procedure SetValue (NewDate: TDateTime); overload;
    function LeapYear: Boolean;
    function GetText: string;
    procedure Increase;
    property Year: Integer read GetYear write SetYear;
    property Month: Integer read GetMonth write SetMonth;
    property Day: Integer read GetDay write SetDay;
  end;

implementation

uses
  DateUtils;

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

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

procedure TDate.Increase;
begin
  fDate := fDate + 1;
end;

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

end.
DateF.dfm
object DateForm: TDateForm
  Left = 225
  Top = 114
  Width = 257
  Height = 149
  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 Label1: TLabel
    Left = 24
    Top = 20
    Width = 22
    Height = 13
    Caption = 'Year'
  end
  object Label2: TLabel
    Left = 24
    Top = 53
    Width = 30
    Height = 13
    Caption = 'Month'
  end
  object Label3: TLabel
    Left = 24
    Top = 84
    Width = 19
    Height = 13
    Caption = 'Day'
  end
  object BtnIncrease: TButton
    Left = 158
    Top = 13
    Width = 65
    Height = 25
    Caption = '&Increase'
    TabOrder = 0
    OnClick = BtnIncreaseClick
  end
  object EditYear: TEdit
    Left = 64
    Top = 16
    Width = 65
    Height = 21
    Color = clWindow
    TabOrder = 1
  end
  object EditMonth: TEdit
    Left = 64
    Top = 48
    Width = 65
    Height = 21
    Color = clWindow
    TabOrder = 2
  end
  object EditDay: TEdit
    Left = 64
    Top = 80
    Width = 65
    Height = 21
    Color = clWindow
    TabOrder = 3
  end
  object BtnRead: TButton
    Left = 158
    Top = 45
    Width = 65
    Height = 25
    Caption = 'Read'
    TabOrder = 4
    OnClick = BtnReadClick
  end
  object BtnWrite: TButton
    Left = 158
    Top = 77
    Width = 65
    Height = 25
    Caption = 'Write'
    TabOrder = 5
    OnClick = BtnWriteClick
  end
end