Главная » 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.