Learn Pascal
Mouse support unit

(* Author:    Tao Yue
   Date:      May 11, 1996
   Program History:
        0.01  05/11/96  Basic mouse algorithm coded
        0.02  05/11/96  Added procedure to reset registers; doesn't lock
                          up anymore
        0.03  07/09/96  Removed the TestMouse procedures; instead, changed
                          the program into an include file for common use
                          by my future programs.
        0.04  06/27/98  Made it into a self-contained, compilable unit.
   Description:
        Basic Mouse Functions for DOS
   *** DO NOT USE THIS UNIT IN WINDOWS ***
*)

unit Mouse;

interface

uses
   Dos;

type
   ButtonType = (Left, Right, Both, None);

var
   Params : Registers;
   XRange,
   YRange,
   X,
   Y : word;
   Buttons : ButtonType;

procedure OpenMouse;
procedure CloseMouse;
procedure ShowMouse;
procedure HideMouse;
procedure GetMouseStatus (var X, Y : word; Buttons : ButtonType);
procedure SetRange (XRange, YRange : word);
procedure MoveMouse (var X, Y : word);
function InRange (X, Y, ULX, ULY, BRX, BRY : word) : Boolean;

(**************************************************************************)

implementation

procedure CallMouse (var Params : Registers);
(* Calls the mouse interrupt                                              *)

begin
   Intr ($33, Params)
end;

(**************************************************************************)

procedure ResetRegisters (var Params : Registers);

begin
   Params.AX := 0;
   Params.BX := 0;
   Params.CX := 0;
   Params.DX := 0;
   Params.BP := 0;
   Params.SI := 0;
   Params.DI := 0;
   Params.DS := 0;
   Params.ES := 0
end;

(**************************************************************************)

procedure OpenMouse;
(* Initializes the mouse, saves the trouble of calling two procedures     *)

begin
   ResetRegisters (Params);
   Params.AX := 0;
   CallMouse (Params);
   Params.AX := 1;
   CallMouse (Params)
end;

(**************************************************************************)

procedure CloseMouse;
(* Deactivates the mouse in the program                                   *)

begin
   ResetRegisters (Params);
   Params.AX := 0;
   CallMouse (Params);
   Params.AX := 2;
   CallMouse (Params)
end;

(**************************************************************************)

procedure ShowMouse;
(* Shows the mouse cursor on the screen                                   *)

begin
   Params.AX := 1;
   CallMouse (Params)
end;

(**************************************************************************)

procedure HideMouse;
(* Hides the mouse cursor on the screen                                   *)

begin
   Params.AX := 2;
   CallMouse (Params)
end;

(**************************************************************************)

procedure GetCoords (var X, Y: word);
(* Gets the current coordinates of the mouse                              *)

begin
   Params.AX := 3;
   CallMouse (Params);
   X := Params.CX;
   Y := Params.DX
end;

(**************************************************************************)
   
procedure GetButtons (var Buttons : ButtonType);
(* Gets which mouse buttons are down                                      *)

var
   Number : word;            (* A temporary number                        *)

begin
   Params.AX := 3;
   CallMouse (Params);
   Number := Params.BX;
   case Number of
     1:         Buttons := Left;
     2:         Buttons := Right;
     3:         Buttons := Both;
     else       Buttons := None;
   end  
end;

(**************************************************************************)
     
procedure GetMouseStatus (var X, Y : word; Buttons : ButtonType);    
(* Get the status of the mouse                                            *)

begin
   GetCoords (X, Y);
   GetButtons (Buttons)
end;

(**************************************************************************)

procedure SetRange (XRange, YRange : word);
(* Set the high extents of the mouse, useful if you want to get more or   *)
(* less precise measurements from the mouse driver                        *)

begin
   
                             (* First set column range                    *)
   Params.AX := 7;
   Params.CX := 0;
   Params.DX := XRange;
   CallMouse (Params);
                             (* Then set row range                        *)
   Params.AX := 8;
   Params.CX := 0;
   Params.DX := YRange;
   CallMouse (Params);
end;

(**************************************************************************)
     
procedure MoveMouse (var X, Y : word);
(* Moves the mouse to a given location                                    *)

begin
   Params.AX := 5;
   Params.CX := X;
   Params.DX := Y;
   CallMouse (Params)
end;

(**************************************************************************)
     
function InRange (X, Y, ULX, ULY, BRX, BRY : word) : Boolean;
(* Returns true if the coordinates given are in the range given           *)

var
   junk : Boolean;           (* Temporary variable                        *)

begin
   junk := false;
   if (X > (ULX - 1)) and (X < (BRX + 1)) and
      (Y > (ULY - 1)) and (Y < (ULY + 1)) then
      junk := true;
   InRange := junk
end;

(**************************************************************************)

end.    (* of unit *)




taoyue@mit.edu
Copyright © 1997-2001 Tao Yue. All rights reserved.