Project Structure

• Exceptions1.dpr
• Except1F.pas
• Except1F.dfm

program Exceptions1;

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

{$R *.RES}

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

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.

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