home *** CD-ROM | disk | FTP | other *** search
/ Chip 1998 March / Chip_1998-03_cd.bin / zkuste / delphi / ruzkomp / BDEERROR.ZIP / DBENGINE.PAS < prev    next >
Pascal/Delphi Source File  |  1996-03-15  |  7KB  |  218 lines
  1. unit dbengine;
  2. // Delphi 2 Database error handling example
  3. // Borland International 1996
  4. // Simply include this unit in your uses clause and call the HandleException
  5. //   method when necessary.
  6.  
  7. interface
  8.  
  9. uses
  10.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  11.   StdCtrls, ExtCtrls, Buttons;
  12.  
  13. type
  14.   TDBError = class(TForm)
  15.     Panel1: TPanel;
  16.     Error1: TLabel;
  17.     Error2: TLabel;
  18.     Error3: TLabel;
  19.     Error4: TLabel;
  20.     Panel2: TPanel;
  21.     NativeCode: TLabel;
  22.     DoneBtn: TBitBtn;
  23.     NatBtn: TBitBtn;
  24.     procedure Button1Click(Sender: TObject);
  25.     procedure SizeErrorDialog(MaxStringSize: integer; Errors: word);
  26.     procedure NatBtnClick(Sender: TObject);
  27.   private
  28.     { Private declarations }
  29.     procedure ResetControls(Title: string);
  30.     procedure CreateDBEngineError(E: EDBEngineError);
  31.     procedure ShowEDatabaseError(E: EDatabaseError);
  32.     procedure EnableErrorBox(Count: integer; Enable, Visible: boolean);
  33.   public
  34.     { Public declarations }
  35.     procedure HandleException(E: Exception);
  36.   end;
  37.  
  38. var
  39.   DBError: TDBError;
  40.  
  41. implementation
  42.  
  43. {$R *.DFM}
  44.  
  45. // Reset controls to default state.
  46. procedure TDBError.ResetControls(Title: string);
  47. begin
  48.   Error1.Visible := False;
  49.   Error2.Visible := False;
  50.   Error3.Visible := False;
  51.   Error4.Visible := False;
  52.   Error1.AutoSize := True;
  53.   Error2.AutoSize := True;
  54.   Error3.AutoSize := True;
  55.   Error4.AutoSize := True;
  56.   NatBtn.Enabled := False;
  57.   Caption := Title;
  58. end;
  59.  
  60. // This procedure is called when a EDatabaseError has occurred.  Simply
  61. //   display the message in the error dialog.
  62. procedure TDBError.ShowEDatabaseError(E: EDatabaseError);
  63. var
  64.   StringSize: integer;
  65.  
  66. begin
  67.   ResetControls('an EDatabase Error has occured');
  68.   Error1.Caption := E.Message + '.';
  69.   StringSize := Canvas.TextWidth(Error1.Caption);
  70.   SizeErrorDialog(StringSize, 1);
  71.   EnableErrorBox(1, True, False);
  72. end;
  73.  
  74. // Determine what type of exception was raised and call the appropriate method.
  75. procedure TDBError.HandleException(E: Exception);
  76. begin
  77.   if E is EDBEngineError then
  78.     DBError.CreateDBEngineError(EDBEngineError(E))
  79.   else
  80.     if E is EDatabaseError then
  81.       ShowEDatabaseError(EDatabaseError(E))
  82.     else
  83.       Application.ShowException(E);
  84. end;
  85.  
  86. // Setup and display the error dialog box.
  87. procedure TDBError.EnableErrorBox(Count: integer; Enable, Visible: boolean);
  88. begin
  89.   Error1.AutoSize := False;
  90.   Error2.AutoSize := False;
  91.   Error3.AutoSize := False;
  92.   Error4.AutoSize := False;
  93.   Error1.Height := 13;
  94.   Error2.Height := 13;
  95.   Error3.Height := 13;
  96.   Error4.Height := 13;
  97.   if Count >= 1 then
  98.     Error1.Visible := True;
  99.   if Count >= 2 then
  100.     Error2.Visible := True;
  101.   if Count >= 3 then
  102.     Error3.Visible := True;
  103.   if Count >= 4 then
  104.     Error4.Visible := True;
  105.   NatBtn.Enabled := Enable;
  106.   NatBtn.Visible := Visible;
  107.   ShowModal;
  108. end;
  109.  
  110. // Make the size of the dialog box just big enough to show the message string.
  111. procedure TDBError.SizeErrorDialog(MaxStringSize: integer; Errors: word);
  112. begin
  113.   NativeCode.Width := 0;
  114.   Panel1.Width := MaxStringSize + 16;
  115.   Width := MaxStringSize + 30;
  116.   case Errors of
  117.     1: Panel1.Height := 30;
  118.     2: Panel1.Height := 44;
  119.     3: Panel1.Height := 58;
  120.     4: Panel1.Height := 72;
  121.   end;
  122.   Height := Panel1.Height + 63;
  123.   DoneBtn.Top := Height - 53;
  124.   NatBtn.Top := DoneBtn.Top;
  125. end;
  126.  
  127. // Create the error messages for the EDBEngineError exception.
  128. procedure TDBError.CreateDBEngineError(E: EDBEngineError);
  129. var
  130.   StringSize: Integer;
  131.   ButtonEnable: boolean;
  132.  
  133. begin
  134.   ResetControls('an EDBEngine Error has occured');
  135.   ButtonEnable := False;
  136.   Error1.Visible := False;
  137.   Error2.Visible := False;
  138.   Error3.Visible := False;
  139.   Error4.Visible := False;
  140.   NatBtn.Enabled := False;
  141.   StringSize := 0;
  142.   NativeCode.Caption := 'Native Error Code(s) ';
  143.   if E.ErrorCount >= 1 then
  144.   begin
  145.     Error1.Caption := Format('Entry: 0,  Error Number: %d,  %s',
  146.                       [E.Errors[0].ErrorCode, E.Errors[0].Message]);
  147.     StringSize := Canvas.TextWidth(Error1.Caption);
  148.     if E.Errors[0].NativeError <> 0 then
  149.     begin
  150.       ButtonEnable := True;
  151.       NativeCode.Caption := Format('%s  %d, %s',
  152.            [NativeCode.Caption, E.Errors[0].NativeError, E.Errors[0].Message]);
  153.     end;
  154.   end;
  155.   if E.ErrorCount >= 2 then
  156.   begin
  157.     Error2.Caption := Format('Entry: 1,  Error Number: %d,  %s',
  158.                       [E.Errors[1].ErrorCode, E.Errors[1].Message]);
  159.     if Canvas.TextWidth(Error2.Caption) > StringSize then
  160.       StringSize := Canvas.TextWidth(Error2.Caption);
  161.     if E.Errors[1].NativeError <> 0 then
  162.     begin
  163.       ButtonEnable := True;
  164.       NativeCode.Caption := Format('%s  %d, %s',
  165.            [NativeCode.Caption, E.Errors[1].NativeError, E.Errors[1].Message]);
  166.     end;
  167.   end;
  168.   if E.ErrorCount >= 3 then
  169.   begin
  170.     Error3.Caption := Format('Entry: 2,  Error Number: %d,  %s',
  171.                       [E.Errors[2].ErrorCode, E.Errors[2].Message]);
  172.     if Canvas.TextWidth(Error3.Caption) > StringSize then
  173.       StringSize := Canvas.TextWidth(Error3.Caption);
  174.     if E.Errors[2].NativeError <> 0 then
  175.     begin
  176.       ButtonEnable := True;
  177.       NativeCode.Caption := Format('%s  %d,  %s',
  178.            [NativeCode.Caption, E.Errors[2].NativeError, E.Errors[2].Message]);
  179.     end;
  180.   end;
  181.   if E.ErrorCount >= 4 then
  182.   begin
  183.     Error4.Caption := Format('Entry: 3,  Error Number: %d,  %s',
  184.                       [E.Errors[3].ErrorCode, E.Errors[3].Message]);
  185.     if Canvas.TextWidth(Error4.Caption) > StringSize then
  186.       StringSize := Canvas.TextWidth(Error4.Caption);
  187.     if E.Errors[3].NativeError <> 0 then
  188.     begin
  189.       ButtonEnable := True;
  190.       NativeCode.Caption := Format('%s  %d,  %s',
  191.            [NativeCode.Caption, E.Errors[3].NativeError, E.Errors[3].Message]);
  192.     end;
  193.   end;
  194.   SizeErrorDialog(StringSize, E.ErrorCount);
  195.   EnableErrorBox(E.ErrorCount, ButtonEnable, True);
  196. end;
  197.  
  198. // If the user wants to display the native message, size the dialog box.
  199. procedure TDBError.NatBtnClick(Sender: TObject);
  200. begin
  201.   NatBtn.Enabled := False;
  202.   Panel2.Top := DoneBtn.Top + 31;
  203.   Panel2.Width := Panel1.Width;
  204.   Height := Height + 43;
  205.   NativeCode.Width := Panel2.Width - 15;
  206. end;
  207.  
  208. // Close the error dialog.
  209. procedure TDBError.Button1Click(Sender: TObject);
  210. begin
  211.   Close;
  212. end;
  213.  
  214. initialization
  215.   // Create the dialog box.
  216.   DBError := TDBError.Create(Application);
  217. end.
  218.