home *** CD-ROM | disk | FTP | other *** search
- { KMouse.Pas }
- { Copyright 1989 by Kenneth A. Hill, P.E. }
- { }
- { }
- { KeyMouse implements a mouse handler that is transparent to the application }
- { Once initialized the mouse handler stuffs the selected keystrokes into }
- { the keyboard buffer where the application reads them. }
-
- Unit KMouse;
-
- InterFace
-
- Const
- HasMouse : Boolean = False;
- { Set to True if mouse found during initialization }
- MouseVerified : Boolean = False;
- { Set to True if the mouse reset function finds the mouse }
- GoodMouse : Boolean = False;
- { Set to True if Mouse driver is Ver. 6 or higher }
-
- {Mouse Motion Masks}
- MoveRight = $01;
- MoveLeft = $02;
- MoveDown = $04;
- MoveUp = $08;
- MoveAll = $0F;
- { The default is MoveAll }
-
- {Mouse Report masks}
- MouseMoved = $01;
- MouseLBPressed = $02;
- MouseLBReleased = $04;
- MouseRBPressed = $08;
- MouseRBReleased = $10;
- MouseMBPressed = $20;
- MouseMBReleased = $40;
- { The default is MouseMoved }
-
-
- Procedure ResetMouse;
- {Performs hardware reset on the mouse, sets Mouse verified}
-
- Procedure InitMouse(Mask:Word);
-
- { InitMouse installs the mouse handler to the mouse. It must be called }
- { during program initialization, although additional calls are harmless }
- { and may be used to change the interrupt mask. }
- { Mask is the mask passed to the mouse driver to define the Mouse }
- { actions to report on. This Word is bit encoded as follows: }
- { }
- { 15 14 13 12 11 10 09 08 07 06 05 04 03 02 01 00 }
- { 0 0 0 0 0 0 0 0 0 x x x x x x x }
- { ------------------------- ^ ^ ^ ^ ^ ^ ^ }
- { ^ | | | | | | Mouse motion }
- { | | | | | | Left button pressed }
- { | | | | | Left button released }
- { | | | | Right button pressed }
- { | | | Right button released }
- { | | Mid Button pressed }
- { | Mid button released }
- { Reserved, must be 0 }
- { If the bit is set (ie, 1) the mouse calls the user installed handler }
- { when the event occurs. }
- { Utilizing the constants above for the Mask, the call }
- { InitMouse(MouseMoved+MouseLBReleased+MouseRBReleased); }
- { installs the handler and sets the mouse for motion, and L & R button }
- { releases. }
-
-
- Procedure SetMouseMotion(Direction : Byte);
- { Sets the movement directions the mouse will report on. }
- { Using the the definitions of the constants above, following the call }
- { SetMouseMotion(MoveUp+MoveDown), the mouse will report vertical motion}
- { Correspondingly, SetMouseMotion(MoveAll); establishes vertical and }
- { horizontal mouse motion. The default is MoveAll. Use this procedure }
- { to toggle mouse response from a vertical to a horizonal menu or a }
- { full screen application. }
-
- Procedure SetMouseButtons( LB,RB,MB : Word );
- { Causes the mouse buttons to return the specified scancodes. }
- { Should be called before first initialization, may be called anytime }
- { after to change the buttons returned scancodes. Each button enabled }
- { by the call mask must be > 0 }
-
- Procedure SetMouseDelay( VDelay, HDelay : Word);
- { Sets the delay count for vertical and horizontal mouse movements. The }
- { delay is read and decremented by the mouse driver and only actuated }
- { when the delay counter reaches 0. Use this Procedure to change the }
- { mouse sensitivity for menus, etc. The default is VDelay = 3, HDelay =1}
-
- Procedure SaveMouse;
- { Saves the mouse state if the mouse driver is ver. 6.0 or higher. }
-
- Procedure RestoreMouse;
- { Restores a previously saved mouse state if the mouse driver is Ver. 6.0 }
- { or higher. }
-
- { The initialization code saves the current mouse in a separate buffer and }
- { restores it during the exit process. }
- { The save/restore mouse procs may be used by a TP application before and }
- { after spawning a child process, eg. in a menuing program. }
- { These procedures require that GoodMouse be true, ie. the mouse driver }
- { must be ver 6.0 or higher. }
-
- (*****************************************************************************)
-
- Implementation
- Uses Dos; {For system calls}
-
- Const
- MouseInt = $33;
- { Key and control definition defaults }
- RKey : Word = $4D00; { Right Cursor Key Scancode }
- LKey : Word = $4B00; { Left Cursor Key Scancode }
- DKey : Word = $5000; { Down Cursor Key Scancode }
- UKey : Word = $4800; { Up Cursor Key Scancode }
- LBKey : Word = $0000; { Left Button Key Scancode }
- RBKey : Word = $0000; { Right Button Key Scancode }
- MBKey : Word = $0000; { Middle Button Key Scancode}
- VDly : Word = $0003; { Vertical Delay }
- HDly : Word = $0001; { Horizontal Delay }
- Msk : Word = MouseMoved; {Set Motion only }
- VCount : Word = $0003; { Current Vertical delay count }
- HCount : Word = $0001; { Current Horizontal delay count }
- MouseMotion : Byte = MoveAll; { Set motion to report UDRL }
-
- Type
- VecPtr = ^Byte;
-
- Var
- Regs : Registers; { Pseudo registers for mouse calls }
-
- MouseSize : Word; { Size required by mouse buffer }
-
- OldMouseState,
- OurMouseState : Array [0..511] of Byte; { Storage buffers for mouse states}
-
- NextExit : Pointer; { Exit pointer }
- MouseVec : Pointer; {Mouse Interrupt Vector}
- MousePtr : VecPtr ABSOLUTE $0000:$00CC; {mouse vector address}
- {$F+}
- {$L KeyMous}
- Procedure MousKey; External;
- { The mouse event processor }
-
- Procedure ResetMouse;
- Begin
- Regs.AX := 0; {Function 0 Reset the mouse}
- Intr(MouseInt,Regs);
- MouseVerified := Regs.AX <> 0;
- {If Regs.AX <> 0 Then MouseVerified := True else MouseVerified := false;}
- End;
-
- Procedure SetMouseMotion(Direction : Byte);
- Begin
- MouseMotion := Direction;
- End;
-
- Procedure SetMouseButtons( LB,RB,MB : Word );
- Begin
- LBKey := LB;
- RBKey := RB;
- MBKey := MB;
- End;
-
- Procedure SetMouseDelay( VDelay, HDelay : Word);
- Begin
- If VDelay > 0 Then
- Begin
- VDly := VDelay;
- VCount := VDelay;
- End;
- If HDelay > 0 Then
- Begin
- HDly := HDelay;
- HCount := HDelay;
- End;
- End;
-
- Procedure InitMouse(Mask:Word);
- Begin
- Msk := Mask;
- If MouseVerified {HasMouse} Then { Install Driver }
- Begin
- Regs.AX := 12;
- Regs.CX := Msk;
- Regs.DX := Ofs(MousKey);
- Regs.ES := Seg(MousKey);
- Intr(MouseInt,Regs);
- End;
- End; {InitMouse}
-
- Procedure SaveMouse;
- { Saves the mouse state }
- Begin
- If MouseVerified {HasMouse} Then
- If GoodMouse Then
- If MouseSize < SizeOf(OurMouseState) Then
- Begin
- Regs.AX := $16;
- Regs.DX := Ofs(OurMouseState);
- Regs.ES := Seg(OurMouseState);
- Intr(MouseInt,Regs);
- End
- Else WriteLn('Insufficient Buffer size to save mouse.');
- End;
-
- Procedure RestoreMouse;
- { Restores a previously saved mouse state }
- Begin
- If MouseVerified {HasMouse} Then
- If GoodMouse Then
- If MouseSize < SizeOf(OurMouseState) Then
- Begin
- Regs.AX := $17;
- Regs.DX := Ofs(OurMouseState);
- Regs.ES := Seg(OurMouseState);
- Intr(MouseInt,Regs);
- End
- Else WriteLn('Cannot restore Mouse. Insufficient buffer');
- End;
-
- Procedure MouseExit;
- { This is the program exit Processor }
- Begin
- If MouseVerified {HasMouse} Then
- Begin
- ResetMouse; {Clear the current mouse}
- If GoodMouse and (MouseSize < SizeOf(OldMouseState)) Then
- Begin
- Regs.AX := $17; {Restore driver state}
- Regs.DX := Ofs(OldMouseState);
- Regs.ES := Seg(OldMouseState);
- Intr(MouseInt,Regs);
- End;
- End;
- ExitProc := NextExit;
- End;
-
- Procedure SaveOldMouse;
- { Saves the mouse state during program initialization }
-
- Begin
- If MouseVerified {HasMouse} Then
- If GoodMouse Then
- If MouseSize < SizeOf(OldMouseState) Then
- Begin
- Regs.AX := $16;
- Regs.DX := Ofs(OldMouseState);
- Regs.ES := Seg(OldMouseState);
- Intr(MouseInt,Regs);
- End;
- End;
-
-
- Begin { Mouse initialization }
- { First check to see if the mouse interrupt vector points to an IRET }
- { or is NIL }
- GetIntVec(MouseInt,MouseVec);
- If (MouseVec = Nil) or (MousePtr^ = $CF) { $CF is an IRET}
- Then
- HasMouse := False
- Else
- Begin
- HasMouse := True; { lets us know we have a mouse }
- Regs.AX := $24; { Check mouse Version }
- Regs.BX := $FFFF; { Set BX to a known state }
- Intr(MouseInt,Regs); { Call mouse }
- If (Regs.BX <> $FFFF) and (Regs.BH >= 6) Then
- Begin
- GoodMouse := True; { Ver 6 Driver allows saving mouse state}
- Regs.AX := $15; { get its size }
- Intr(MouseInt,Regs);
- MouseSize := Regs.BX;
- SaveOldMouse; { save its state }
- End
- Else GoodMouse := False;
- ResetMouse; { Clear the old mouse }
- NextExit := ExitProc; { Save old Exit Proc }
- ExitProc := @MouseExit; { Establish our exit link }
- End;
- End. {KMouse.Pas}