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