home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / DBEXCEPT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-11  |  4.3 KB  |  160 lines
  1. {*******************************************************}
  2. {                                                       }
  3. {       Borland Delphi Visual Component Library         }
  4. {                                                       }
  5. {       Copyright (c) 1995,99 Inprise Corporation       }
  6. {                                                       }
  7. {*******************************************************}
  8.  
  9. unit Dbexcept;
  10.  
  11. interface
  12.  
  13. uses Windows, SysUtils, Classes, Graphics, Forms, Controls, Buttons,
  14.   StdCtrls, ExtCtrls, Db, DBTables;
  15.  
  16. type
  17.   TDbEngineErrorDlg = class(TForm)
  18.     BasicPanel: TPanel;
  19.     DetailsPanel: TPanel;
  20.     BDELabel: TLabel;
  21.     NativeLabel: TLabel;
  22.     DbMessageText: TMemo;
  23.     DbResult: TEdit;
  24.     DbCatSub: TEdit;
  25.     NativeResult: TEdit;
  26.     BackBtn: TButton;
  27.     NextBtn: TButton;
  28.     ButtonPanel: TPanel;
  29.     DetailsBtn: TButton;
  30.     OKBtn: TButton;
  31.     IconPanel: TPanel;
  32.     IconImage: TImage;
  33.     TopPanel: TPanel;
  34.     ErrorText: TLabel;
  35.     RightPanel: TPanel;
  36.     procedure FormShow(Sender: TObject);
  37.     procedure BackClick(Sender: TObject);
  38.     procedure NextClick(Sender: TObject);
  39.     procedure FormCreate(Sender: TObject);
  40.     procedure DetailsBtnClick(Sender: TObject);
  41.     procedure FormDestroy(Sender: TObject);
  42.   private
  43.     FPrevOnException: TExceptionEvent;
  44.     FDbException: EDbEngineError;
  45.     FDetailsHeight, CurItem: Integer;
  46.     FDetails: string;
  47.     procedure HandleException(Sender: TObject; E: Exception);
  48.     procedure SwitchDetails;
  49.     procedure ShowError;
  50.   public
  51.     procedure HookExceptions;
  52.     function ShowException(Error: EDbEngineError): TModalResult;
  53.     property DbException: EDbEngineError read FDbException write FDbException;
  54.   end;
  55.  
  56. var
  57.   DbEngineErrorDlg: TDbEngineErrorDlg;
  58.  
  59. implementation
  60.  
  61. {$R *.DFM}
  62.  
  63. procedure TDbEngineErrorDlg.HandleException(Sender: TObject; E: Exception);
  64. begin
  65.   if (E is EDbEngineError) and (DbException = nil) and
  66.     not Application.Terminated then ShowException(EDbEngineError(E))
  67.   else if Assigned(FPrevOnException) then FPrevOnException(Sender, E)
  68.   else Application.ShowException(E);
  69. end;
  70.  
  71. procedure TDbEngineErrorDlg.SwitchDetails;
  72. const
  73.   DetailsOn: array [Boolean] of string = ('%s >>', '<< %s');
  74. var
  75.   DEnabling: Boolean;
  76. begin
  77.   DEnabling := not DetailsPanel.Visible;
  78.   if DEnabling then ClientHeight := FDetailsHeight
  79.   else ClientHeight := DetailsPanel.Top;
  80.   DetailsPanel.Visible := DEnabling;
  81.   ButtonPanel.Top := 0;
  82.   DetailsBtn.Caption := Format(DetailsOn[DEnabling], [FDetails]);
  83. end;
  84.  
  85. procedure TDbEngineErrorDlg.ShowError;
  86. var
  87.   BDEError: TDbError;
  88. begin
  89.   BackBtn.Enabled := CurItem > 0;
  90.   NextBtn.Enabled := CurItem < DbException.ErrorCount - 1;
  91.   BDEError := DbException.Errors[CurItem];
  92.   DbMessageText.Text := BDEError.Message;
  93.   BDELabel.Enabled := True;
  94.   DbResult.Text := IntToStr(BDEError.ErrorCode);
  95.   DbCatSub.Text := Format('[%s%2x] [%0:s%2:2x]', [HexDisplayPrefix,
  96.     BDEError.Category, BDEError.SubCode]);
  97.   NativeLabel.Enabled := BDEError.NativeError <> 0;
  98.   if NativeLabel.Enabled then NativeResult.Text := IntToStr(BDEError.NativeError)
  99.   else NativeResult.Clear
  100. end;
  101.  
  102. procedure TDbEngineErrorDlg.FormCreate(Sender: TObject);
  103. begin
  104.   FDetailsHeight := ClientHeight;
  105.   FDetails := DetailsBtn.Caption;
  106.   SwitchDetails;
  107. end;
  108.  
  109. procedure TDbEngineErrorDlg.FormDestroy(Sender: TObject);
  110. begin
  111.   if Assigned(FPrevOnException) then Application.OnException := FPrevOnException;
  112. end;
  113.  
  114. procedure TDbEngineErrorDlg.FormShow(Sender: TObject);
  115. begin
  116.   ErrorText.Caption := DbException.Message;
  117.   if DetailsPanel.Visible then
  118.   begin
  119.     CurItem := 0;
  120.     ShowError;
  121.   end;
  122. end;
  123.  
  124. procedure TDbEngineErrorDlg.BackClick(Sender: TObject);
  125. begin
  126.   Dec(CurItem);
  127.   ShowError;
  128. end;
  129.  
  130. procedure TDbEngineErrorDlg.NextClick(Sender: TObject);
  131. begin
  132.   Inc(CurItem);
  133.   ShowError;
  134. end;
  135.  
  136. procedure TDbEngineErrorDlg.DetailsBtnClick(Sender: TObject);
  137. begin
  138.   SwitchDetails;
  139.   if DetailsPanel.Visible then
  140.   begin
  141.     CurItem := 0;
  142.     ShowError;
  143.   end;
  144. end;
  145.  
  146. procedure TDbEngineErrorDlg.HookExceptions;
  147. begin
  148.   FPrevOnException := Application.OnException;
  149.   Application.OnException := HandleException;
  150. end;
  151.  
  152. function TDbEngineErrorDlg.ShowException(Error: EDbEngineError): TModalResult;
  153. begin
  154.   DbException := Error;
  155.   Result := ShowModal;
  156.   DbException := nil;
  157. end;
  158.  
  159. end.
  160.