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 CONTAIN

Project Structure


CONTAIN.DPR

program Contain;

uses
  Forms,
  ListForm in 'ListForm.pas' {Form1},
  Dates in 'Dates.pas';

{$R *.RES}

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

LISTFORM.PAS

unit ListForm;

interface

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

type
  TForm1 = class(TForm)
    ButtonAdd: TButton;
    ButtonList: TButton;
    ListBox1: TListBox;
    ButtonWrong: TButton;
    btnListStack: TButton;
    btnQueue: TButton;
    procedure ButtonAddClick(Sender: TObject);
    procedure ButtonListClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ButtonWrongClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btnListStackClick(Sender: TObject);
    procedure btnQueueClick(Sender: TObject);
  private
    ListDate: TObjectList;
    Stack: TStack;
    Queue: TQueue;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

uses
  Dates;

procedure TForm1.ButtonAddClick(Sender: TObject);
begin
  ListDate.Add (TDate.Create (
    1900 + Random (200), 1 + Random (12), 1 + Random (30)));
end;

procedure TForm1.ButtonListClick(Sender: TObject);
var
  I: Integer;
begin
  ListBox1.Clear;
  for I := 0 to ListDate.Count - 1 do
    Listbox1.Items.Add ((TObject(ListDate [I]) as TDate).Text);
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  I: Integer;
begin
  Randomize;
  ListDate := TObjectList.Create (True);
  Stack := TStack.Create;
  Queue := TQueue.Create;

  for I := 1 to 10 do
  begin
    Stack.Push (Pointer (I));
    Queue.Push (Pointer (I));
  end;
end;

procedure TForm1.ButtonWrongClick(Sender: TObject);
begin
  // add a button to the list
  ListDate.Add (Sender);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  ListDate.Free;
  Stack.Free;
  Queue.Free;
end;

procedure TForm1.btnListStackClick(Sender: TObject);
var
  Stack2: TStack;
begin
  Stack2 := TStack.Create;
  ListBox1.Clear;
  // lists removing
  while Stack.Count > 0 do
  begin
    ListBox1.Items.Add (IntToStr (Integer (Stack.Peek)));
    Stack2.Push (Stack.Pop);
  end;
  // restores
  while Stack2.Count > 0 do
    Stack.Push (Stack2.Pop);

  ShowMessage ('Removed: ' + IntToStr (Integer (Stack.Pop)));
end;

procedure TForm1.btnQueueClick(Sender: TObject);
var
  I: Integer;
begin
  ListBox1.Clear;
  for I := 0 to Queue.Count - 1 do
  begin
    ListBox1.Items.Add (IntToStr (Integer (Queue.Peek)));
    Queue.Push (Queue.Pop);
  end;
  ShowMessage ('Removed: ' + IntToStr (Integer (Queue.Pop)));
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 ('Md5', [TDate]);
end;

end.

LISTFORM.DFM

object Form1: TForm1
  Left = 237
  Top = 110
  Width = 398
  Height = 304
  Caption = 'List Demo'
  Color = clBtnFace
  Font.Charset = DEFAULT_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 ButtonAdd: TButton
    Left = 24
    Top = 24
    Width = 89
    Height = 25
    Caption = '&Add'
    TabOrder = 0
    OnClick = ButtonAddClick
  end
  object ButtonList: TButton
    Left = 24
    Top = 64
    Width = 89
    Height = 25
    Caption = '&List'
    TabOrder = 1
    OnClick = ButtonListClick
  end
  object ListBox1: TListBox
    Left = 136
    Top = 24
    Width = 225
    Height = 225
    ItemHeight = 13
    TabOrder = 2
  end
  object ButtonWrong: TButton
    Left = 24
    Top = 104
    Width = 89
    Height = 25
    Caption = 'Add &Wrong'
    TabOrder = 3
    OnClick = ButtonWrongClick
  end
  object btnListStack: TButton
    Left = 24
    Top = 184
    Width = 89
    Height = 25
    Caption = 'List &Stack'
    TabOrder = 4
    OnClick = btnListStackClick
  end
  object btnQueue: TButton
    Left = 24
    Top = 224
    Width = 89
    Height = 25
    Caption = 'List &Queue'
    TabOrder = 5
    OnClick = btnQueueClick
  end
end