Marco Cantù 1998, Mastering Delphi 4

Project: OBJUSE.DPR


Project Structure


OBJUSE.DPR

program Objuse;

uses
  Forms,
  ObjUseF in 'ObjUseF.pas' {Form1},
  Dates in 'DATES.PAS';

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

OBJUSEF.PAS

unit ObjUseF;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, Dates, StdCtrls;

type
  TForm1 = class(TForm)
    ShowButton: TButton;
    ListBox1: TListBox;
    procedure ShowButtonClick(Sender: TObject);
  private
    procedure ShowInfo (Obj: TObject);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.ShowInfo (Obj: TObject);
begin
  // add class name
  ListBox1.Items.Add ('Class Name: ' + Obj.ClassName);
  // add parent class name, if any
  if Obj.ClassParent <> nil then
  begin
    ListBox1.Items.Add ('Parent Class Name: ' +
      Obj.ClassParent.ClassName);
    // add grandparent class name, if any
    if Obj.ClassParent.ClassParent <> nil then
      ListBox1.Items.Add ('Grandparent Class Name: ' +
        Obj.ClassParent.ClassParent.ClassName);
  end;
  // add the size of object and reference
  ListBox1.Items.Add ('Object Size: ' +
    IntToStr (Obj.InstanceSize));
  ListBox1.Items.Add ('Reference Size: ' +
    IntToStr (SizeOf (Obj)));
  // indicate if this is a component or not
  if Obj.InheritsFrom (TComponent) then
    ListBox1.Items.Add ('This is a component')
  else
    ListBox1.Items.Add ('This is NOT a component');
end;

procedure TForm1.ShowButtonClick(Sender: TObject);
var
  Day: TDate;
begin
  {create an instance and show some information}
  Day := TDate.Create (1998, 12, 15);
  ShowInfo (Day);
  ListBox1.Items.Add ('');

  {show the same information about
  the form and the sender, the button}
  ShowInfo (self);
  ListBox1.Items.Add ('');
  ShowInfo (Canvas);

  {free memory}
  Day.Free;

  {disable the button, to avoid a second click}
  ShowButton.Enabled := False;
end;

end.

DATES.PAS

unit Dates;

interface

uses
  Classes, SysUtils;

type
  TDate = class (TComponent)
  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; virtual;
  public
    constructor Create (AOwner: TComponent); overload; override;
    constructor Create (y, m, d: Integer); reintroduce; 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 Text: string read GetText;
  published
    property Day: Integer read GetDay write SetDay;
    property Month: Integer read GetMonth write SetMonth;
    property Year: Integer read GetYear write SetYear;
    property OnChange: TNotifyEvent
      read FonChange write FOnChange;
  end;

  // custom exception
  EDateOutOfRange = class (Exception)
  end;

procedure Register;

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 (AOwner: TComponent);
begin
  inherited Create (AOwner);
  // today...
  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;

procedure Register;
begin
  RegisterComponents ('Md4', [TDate]);
end;

end.

OBJUSEF.DFM

object Form1: TForm1
  Left = 197
  Top = 107
  Width = 413
  Height = 342
  ActiveControl = ShowButton
  Caption = 'Obj Use'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 13
  object ShowButton: TButton
    Left = 328
    Top = 16
    Width = 65
    Height = 33
    Caption = '&Show'
    TabOrder = 0
    OnClick = ShowButtonClick
  end
  object ListBox1: TListBox
    Left = 16
    Top = 16
    Width = 297
    Height = 281
    ItemHeight = 13
    TabOrder = 1
  end
end


Copyright Marco Cantù 1998