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 6

Chapter 03 - Project Exceptions1

Project Structure

Exceptions1.dpr
program Exceptions1;

uses
  Forms,
  Except1F in 'Except1F.pas' {Form1};

{$R *.RES}

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

interface

uses SysUtils, Windows, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls;
type
  TForm1 = class(TForm)
    ButtonDivide1: TButton;
    ButtonDivide2: TButton;
    ButtonRaise1: TButton;
    ButtonRaise2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure ButtonDivide1Click(Sender: TObject);
    procedure ButtonDivide2Click(Sender: TObject);
    procedure ButtonRaise1Click(Sender: TObject);
    procedure ButtonRaise2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

{new type of exception}
type
  EArrayFull = class (Exception);

function DivideTwicePlusOne (A, B: Integer): Integer;
begin
  try
    // error if B equals 0
    Result := A div B;
    // do something else... skip if exception is raised
    Result := Result div B;
    Result := Result + 1;
  except
    on EDivByZero do
    begin
      Result := 0;
      MessageDlg ('Divide by zero corrected',
        mtError, [mbOK], 0);
    end;
    on E: Exception do
    begin
      Result := 0;
      MessageDlg (E.Message,
        mtError, [mbOK], 0);
    end;
  end; // end except
end;

{fake procedure: the array is always full}
procedure AddToArray (N: Integer);
begin
  raise EArrayFull.Create ('Array full');
end;

procedure TForm1.ButtonDivide1Click(Sender: TObject);
begin
  DivideTwicePlusOne (10, 0);
end;

procedure TForm1.ButtonDivide2Click(Sender: TObject);
var
  A, B, C: Integer;
begin
  A := 10;
  B := 0;
  {generates an exception, which is not handled by us}
  C := A div B;
  {we have to use the result, or the optimizer will
  remove the code and the error, too}
  Caption := IntToStr (C);
end;

procedure TForm1.ButtonRaise1Click(Sender: TObject);
begin
  try
    {this procedure raises an exception}
    AddToArray (24);
  except
    {simply ignores the exception}
    on EArrayFull do; {do nothing}
  end;
end;

procedure TForm1.ButtonRaise2Click(Sender: TObject);
begin
  {unguarded call}
  AddToArray (24);
end;

end.
Except1F.dfm
object Form1: TForm1
  Left = 166
  Top = 145
  Width = 389
  Height = 216
  ActiveControl = ButtonDivide1
  Caption = 'Exception1'
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clBlack
  Font.Height = -12
  Font.Name = 'Arial'
  Font.Style = []
  OldCreateOrder = True
  PixelsPerInch = 96
  TextHeight = 15
  object Label1: TLabel
    Left = 37
    Top = 16
    Width = 109
    Height = 15
    Caption = 'Handled exceptions'
  end
  object Label2: TLabel
    Left = 213
    Top = 16
    Width = 123
    Height = 15
    Caption = 'Unhandled exceptions'
  end
  object ButtonDivide1: TButton
    Left = 40
    Top = 48
    Width = 113
    Height = 49
    Caption = 'Divide'
    TabOrder = 0
    OnClick = ButtonDivide1Click
  end
  object ButtonDivide2: TButton
    Left = 224
    Top = 48
    Width = 113
    Height = 49
    Caption = 'Divide'
    TabOrder = 1
    OnClick = ButtonDivide2Click
  end
  object ButtonRaise1: TButton
    Left = 40
    Top = 112
    Width = 113
    Height = 49
    Caption = 'Raise'
    TabOrder = 2
    OnClick = ButtonRaise1Click
  end
  object ButtonRaise2: TButton
    Left = 224
    Top = 112
    Width = 113
    Height = 49
    Caption = 'Raise'
    TabOrder = 3
    OnClick = ButtonRaise2Click
  end
end