Главная » Delphi » Основная » Обработка ошибок приложения

Обработка ошибок приложения

14:42
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.