K210.ORG

unit gsCatcher;

 

//**! ----------------------------------------------------------

//**! This unit is a part of GSPackage project (Gregory Sitnin's

//**! Delphi Components Package).

//**! ----------------------------------------------------------

//**! You may use or redistribute this unit for your purposes

//**! while unit's code and this copyright notice is unchanged

//**! and exists.

//**! ----------------------------------------------------------

//**! (c) Gregory Sitnin, 2001-2002. All rights reserved.

//**! ----------------------------------------------------------

 

{***} interface {***}

 

uses Classes, SysUtils, JPEG;

type

  TMyError = procedure(sender: TObject; E: Exception) of object;

type

  TgsCatcher = class(TComponent)

  private

  FMyError:TMyError;

    FEnabled: boolean;

    procedure SetEnabled(const Value: boolean);

    { Private declarations }

  protected

    { Protected declarations }

    procedure EnableCatcher;

    procedure DisableCatcher;

    procedure DoError(E: Exception);

  public

    { Public declarations }

    constructor Create(AOwner: TComponent); override;

    destructor Destroy; override;

    procedure Catcher(Sender: TObject; E: Exception);

  published

    { Published declarations }

    property Enabled: boolean read FEnabled write SetEnabled

      default False;

      property OnError: TMyError read FMyError write FMyError;

  end;

 

procedure Register;

 

{***} implementation {***}

 

uses Windows, Forms, Dialogs, Graphics;

 

procedure Register;

begin

  RegisterComponents('Samples', [TgsCatcher]);

end;

 

{ TgsCatcher }

 

constructor TgsCatcher.Create(AOwner: TComponent);

begin

  inherited;

end;

 

destructor TgsCatcher.Destroy;

begin

  DisableCatcher;

  inherited;

end;

 

procedure TgsCatcher.SetEnabled(const Value: boolean);

begin

  FEnabled := Value;

  if Enabled then

    EnableCatcher

  else

    DisableCatcher;

end;

 

procedure TgsCatcher.DisableCatcher;

begin

  Application.OnException := nil;

end;

 

procedure TgsCatcher.EnableCatcher;

begin

  Application.OnException := Catcher;

end;

 

procedure TgsCatcher.Catcher(Sender: TObject; E: Exception);

begin

  {TODO: Write some exception handling code}

  DoError(E);

end;

 

procedure TgsCatcher.DoError(E: Exception);

begin

if assigned(FMyError) then

    FMyError(self, E);

end;

 

end.