myerror.pas

来自「一个自定义应用程序异常的类 delphi控件」· PAS 代码 · 共 93 行

{*******************************************************}
//   单元: MyError.pas
//   作者: 雲飛揚兮 - [e-mail]
//   日期: 2008-05-12
//   说明: 一个覆盖系统异常的类
//   版权所有 (C) 2008 
//   公司名 中天軟件工作室
{*******************************************************}
unit MyError;

interface

uses
  SysUtils, Classes, ActnList, MsgShowUnt, Forms;

type
  TMyError = class(TComponent)
  private
    { Private declarations }
    FDlgTimeout: Integer;
    FErr : Exception;
    FOnExcept: TExceptionEvent;
  protected
    { Protected declarations }
  public
    { Public declarations }
    oldErr: TExceptionEvent;
    //    SelfErr : TExceptionEvent;
    procedure MyErr(sender: TObject; E: Exception);
    constructor create(AOwner: TComponent); override;
  published
    { Published declarations }                         
    procedure ShowErr(sError : string; timeout : Integer = -1);
    property DlgTimeout: Integer read FDlgTimeout write FDlgTimeout default -1;
 
    property OnExcept: TExceptionEvent read FOnExcept write FOnExcept;
  end;

procedure Register;

var
  MyErr: TMyError;

implementation

procedure Register;
begin
  RegisterComponents('Standard', [TMyError]);
end;

{ TMyError }

constructor TMyError.create(AOwner: TComponent);
begin
  inherited;
  FDlgTimeout := -1;
 
  oldErr := Application.OnException;
  Application.OnException := MyErr;
end;

procedure TMyError.MyErr(sender: TObject; E: Exception);
begin
  FErr := E;
  if Assigned(olderr) then
    oldErr(sender, E);
  if Assigned(fOnexcept) then
    FOnExcept(sender, E)
  else
    ShowErrMsg(E, FDlgTimeout);
end;
    {
initialization
  Myerr := TMyError.Create(nil);

finalization
  Myerr.Free;  }
  {
}
procedure TMyError.ShowErr(sError : string; timeout : Integer= -1);
var
  ntimeOut : Integer;
begin
  if timeout = -1 then
    ntimeOut := DlgTimeout
  else
    ntimeout := timeout;
  ShowMsg(sError,SB_ErrorReport,ntimeOut,'',2,5);
end;

end.