home *** CD-ROM | disk | FTP | other *** search
/ Delphi 4 Bible / Delphi_4_Bible_Tom_Swan_IDG_Books_1998.iso / source / MouseExcept / Main.pas < prev    next >
Pascal/Delphi Source File  |  1998-03-26  |  2KB  |  90 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls, Buttons, ExtCtrls;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     BitBtn1: TBitBtn;
  12.     Label1: TLabel;
  13.     procedure FormMouseDown(Sender: TObject;
  14.       Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  15.     procedure FormPaint(Sender: TObject);
  16.   private
  17.     { Private declarations }
  18.     procedure CheckMouseLocation(X, Y: Integer);
  19.     procedure ExitOnClick(X, Y: Integer);
  20.   public
  21.     { Public declarations }
  22.   end;
  23.  
  24. var
  25.   MainForm: TMainForm;
  26.  
  27. implementation
  28.  
  29. {$R *.DFM}
  30.  
  31. const
  32.   rLeft   = 25;
  33.   rTop    = 25;
  34.   rRight  = 100;
  35.   rBottom = 100;
  36.  
  37. type
  38.   TMouseException = class(Exception)
  39.     X, Y: Integer;
  40.     constructor Create(const Msg: string; XX, YY: Integer);
  41.   end;
  42.  
  43. constructor TMouseException.Create(const Msg: string;
  44.   XX, YY: Integer);
  45. begin
  46.   X := XX;    // Save X and Y values in object
  47.   Y := YY;
  48.   Message :=  // Create message string
  49.     Msg + ' (X=' + IntToStr(X) + ', Y=' + IntToStr(Y) + ')';
  50. end;
  51.  
  52. procedure TMainForm.CheckMouseLocation(X, Y: Integer);
  53. begin
  54.   if (X < rLeft) or (X > rRight) or
  55.      (Y < rTop)  or (Y > rBottom) then
  56.     raise
  57.       TMouseException.Create('Mouse location error', X, Y);
  58. end;
  59.  
  60. procedure TMainForm.ExitOnClick(X, Y: Integer);
  61. begin
  62.   try
  63.     CheckMouseLocation(X, Y);  // Bad values raise exception
  64.     Close;                     // Exit the program
  65.   except
  66.     on TMouseException do
  67.     begin
  68.       if MessageDlg('Mouse error. Exit anyway?',
  69.         mtError, [mbYes, mbNo], 0) = mrYes
  70.       then
  71.         Close
  72.       else
  73.         raise;
  74.     end;
  75.   end;
  76. end;
  77.  
  78. procedure TMainForm.FormMouseDown(Sender: TObject;
  79.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  80. begin
  81.   ExitOnClick(X, Y);
  82. end;
  83.  
  84. procedure TMainForm.FormPaint(Sender: TObject);
  85. begin
  86.   Canvas.Rectangle(rLeft, rTop, rRight, rBottom);
  87. end;
  88.  
  89. end.
  90.