home *** CD-ROM | disk | FTP | other *** search
/ PC Format Collection 48 / SENT14D.ISO / tech / delphi / disk15 / dbtools.pak / DBEXCEPT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-08-24  |  2.5 KB  |  109 lines
  1. unit Dbexcept;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, SysUtils, Classes, Graphics, Forms, Controls, Buttons,
  6.   StdCtrls, ExtCtrls, Db;
  7.  
  8. type
  9.   TDbEngineErrorDlg = class(TForm)
  10.     OKBtn: TBitBtn;
  11.     Prev: TBitBtn;
  12.     Next: TBitBtn;
  13.     BDELabel: TLabel;
  14.     NativeLabel: TLabel;
  15.     ErrorLabel: TLabel;
  16.     DbMessageText: TMemo;
  17.     DbResult: TEdit;
  18.     NativeResult: TEdit;
  19.     DbCatSub: TEdit;
  20.     Label1: TLabel;
  21.     procedure FormShow(Sender: TObject);
  22.     procedure PrevClick(Sender: TObject);
  23.     procedure NextClick(Sender: TObject);
  24.     procedure FormCreate(Sender: TObject);
  25.   private
  26.     CurItem: Integer;
  27.     DbException: EDbEngineError;
  28.     FPrevOnException: TExceptionEvent;
  29.     procedure ShowError;
  30.   public
  31.     procedure ShowException(Sender: TObject; E: Exception);
  32.   end;
  33.  
  34. var
  35.   DbEngineErrorDlg: TDbEngineErrorDlg;
  36.  
  37. implementation
  38.  
  39. {$R *.DFM}
  40.  
  41. procedure TDbEngineErrorDlg.ShowException(Sender: TObject; E: Exception);
  42. begin
  43. if E is EDbEngineError then
  44.    begin
  45.    DbException := EDbEngineError (E);
  46.    ShowModal;
  47.    end
  48. else if Assigned (FPrevOnException) then
  49.    FPrevOnException (Sender, E)
  50. else
  51.    Application.ShowException (E)
  52. end;
  53.  
  54. procedure TDbEngineErrorDlg.ShowError;
  55. var
  56.   BDEError: TDbError;
  57. begin
  58.   Prev.Enabled := CurItem > 0;
  59.   Next.Enabled := CurItem < DbException.ErrorCount - 1;
  60.   BDEError := DbException.Errors [CurItem];
  61.  
  62.   { The message text is common to both BDE and native errors }
  63.  
  64.   DbMessageText.Text := BDEError.Message;
  65.  
  66.   { Fill BDE error information }
  67.  
  68.   BDELabel.Enabled := True;
  69.   DbResult.Text := IntToStr (BDEError.ErrorCode);
  70.   DbCatSub.Text := Format ('[$%s] [$%s]',
  71.                            [IntToHex (BDEError.Category, 2),
  72.                             IntToHex (BDEError.SubCode, 2)]);
  73.  
  74.   { Fill native error information }
  75.  
  76.   NativeLabel.Enabled := BDEError.NativeError <> 0;
  77.   if NativeLabel.Enabled then
  78.      NativeResult.Text := IntToStr (BDEError.NativeError)
  79.   else { This entry has no server error }
  80.      NativeResult.Clear
  81. end;
  82.  
  83. procedure TDbEngineErrorDlg.FormShow(Sender: TObject);
  84. begin
  85.   CurItem := 0;
  86.   DbMessageText.Text := DbException.Message;
  87.   ShowError;
  88. end;
  89.  
  90. procedure TDbEngineErrorDlg.PrevClick(Sender: TObject);
  91. begin
  92.   Dec (CurItem);
  93.   ShowError;
  94. end;
  95.  
  96. procedure TDbEngineErrorDlg.NextClick(Sender: TObject);
  97. begin
  98.   Inc (CurItem);
  99.   ShowError;
  100. end;
  101.  
  102. procedure TDbEngineErrorDlg.FormCreate(Sender: TObject);
  103. begin
  104.   FPrevOnException := Application.OnException;
  105.   Application.OnException := ShowException;
  106. end;
  107.  
  108. end.
  109.