[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]
unit mouse3;
{-------------------------------------------------------------------------
Reference Table
M1 M2 M3 M4
1 0 0 0 = Turn Mouse on with cursor.
2 0 0 0 = Turn Mouse Off.
3 ? ? ? = To see if buttons are pressed.
Test registers with logical AND (M2 is BX register)
M2 and 1 = Left Button
M2 and 2 = Right Button
M2 and 3 = Left and Right Buttons
M2 and 4 = Middle Button
M2 and 5 = Left and Middle Buttons
M2 and 6 = Right and Middle Buttons
M2 and 7 = Left, Middle and Right Buttons
3 0 X Y = Get Mouse Cursor position.
M3 (CX) will return Mouse X coordinates. ( 0 = left wall)
M4 (DX) will return Mouse Y coordinates. ( 632 = right wall)
Divide by 8 and add 1 for Turbo Pascal XY position.
4 0 X Y = Set Mouse Cursor position.
M3 (CX) set for Mouse X coordinate. ( 0 = left wall)
M4 (DX) set for Mouse Y coordinate. ( 632 = right wall)
6 ? 0 0 = Mouse Button Release Status. M2 (BX) set if True
}
interface
USES dos,crt;
TYPE
xMouseFuncs = record
bFunction : function : boolean;
end;
VAR
M1,M2,M3,M4 : word;
Regs : Registers; { MS DOS Registers }
PROCEDURE Mouse( var M1,M2,M3,M4 : word );
PROCEDURE DeInitMouse;
PROCEDURE InitMouse;
PROCEDURE GetMousePos;
PROCEDURE GetMouseStats;
PROCEDURE SetMousePos(xM3, yM4:word);
FUNCTION MPos(wPosition : word) : word;
FUNCTION LeftButton : Boolean;
FUNCTION LeftAndRightButtons : Boolean;
FUNCTION LeftAndMiddleButtons : Boolean;
FUNCTION RightAndMiddleButtons : Boolean;
FUNCTION LeftMidAndRightButtons : Boolean;
FUNCTION MiddleButton : Boolean;
FUNCTION RightButton : Boolean;
FUNCTION MouseRelease : boolean;
const
MouseButton : array[1..7] of xMouseFuncs =
(
(bFunction : LeftButton),
(bFunction : RightButton),
(bFunction : LeftAndRightButtons),
(bFunction : MiddleButton),
(bFunction : LeftAndMiddleButtons),
(bFunction : RightAndMiddleButtons),
(bFunction : LeftMidAndRightButtons)
);
MOUSE_REST = 0;
MOUSE_L = 1;
MOUSE_R = 2;
MOUSE_L_R = 3;
MOUSE_M = 4;
MOUSE_L_M = 5;
MOUSE_R_M = 6;
MOUSE_L_M_R = 7;
implementation
FUNCTION MPos(wPosition : word) : word;
begin
MPos := (wPosition div 8)+1;
end;
FUNCTION LeftButton : Boolean;
begin
LeftButton := FALSE;
if (M2 and 1) <> MOUSE_REST then
begin { if left button pressed }
LeftButton := TRUE;
end;
end;
FUNCTION RightButton : Boolean;
begin
RightButton := FALSE;
if (M2 and 2) <> MOUSE_REST then
begin { if right button pressed }
RightButton := TRUE;
end;
end;
FUNCTION LeftAndRightButtons : Boolean;
begin
LeftAndRightButtons := FALSE;
if (M2 and 3) = 3 then
begin
LeftAndRightButtons := TRUE;
end;
end;
FUNCTION MiddleButton : Boolean;
begin
MiddleButton := FALSE;
if (M2 and 4) <> MOUSE_REST then
begin
MiddleButton := TRUE;
end;
end;
FUNCTION LeftAndMiddleButtons : Boolean;
begin
LeftAndMiddleButtons := FALSE;
if (M2 and 5) = MOUSE_L_M then
begin
LeftAndMiddleButtons := TRUE;
end;
end;
FUNCTION RightAndMiddleButtons : Boolean;
begin
RightAndMiddleButtons := FALSE;
if (M2 and 6) = MOUSE_R_M then
begin
RightAndMiddleButtons := TRUE;
end;
end;
FUNCTION LeftMidAndRightButtons : Boolean;
begin
LeftMidandRightButtons := FALSE;
if (M2 and 7) = MOUSE_L_M_R then
begin
LeftMidAndRightButtons := TRUE;
end;
end;
FUNCTION MouseRelease : boolean;
begin
MouseRelease := FALSE;
M1 := 6;
Mouse( M1,M2,M3,M4 ); { Set mouse cursor ON }
if MOUSE_REST <> M2 then
begin
MouseRelease := TRUE;
end;
end;
PROCEDURE Mouse( var M1,M2,M3,M4 : word );
begin
With Regs DO
begin
AX := M1;
BX := M2;
CX := M3;
DX := M4;
end;
intr($33,Regs); { Interrupt $33, the mouse interrupt }
With Regs DO
begin
M1 := AX;
M2 := BX;
M3 := CX;
M4 := DX;
end;
end;
PROCEDURE InitMouse;
begin
M1 := 1;
Mouse( M1,M2,M3,M4 ); { Set mouse cursor ON }
end;
PROCEDURE DeInitMouse;
begin
M1 := 2;
Mouse( M1,M2,M3,M4 ); { Set mouse cursor OFF }
end;
PROCEDURE GetMousePos;
begin
M1 := 3;
Mouse(M1, M2, M3, M4);
end;
PROCEDURE GetMouseStats;
begin
M1 := 3;
M2 := 0;
M3 := 0;
m4 := 0;
Mouse(M1, M2, M3, M4);
end;
PROCEDURE SetMousePos(xM3, yM4:word);
begin
M1 := 4;
Mouse(M1, M2, xM3, yM4);
end;
begin
initmouse; {Take this out if you do not wish mouse to auto initialize}
end.
{----------------------------- DEMO PROGRAM ---------------------}
USES dos, crt, mouse3, Frame2;
VAR
satisfied : boolean; { if mouse pos and button are together }
CONST
Menu_ClrScr = 'C';
Menu_Quit = 'Q';
PROCEDURE DO_Mssg;
begin
gotoxy(1,24);
writeln('Push Middle Button or L/R buttons together for menu');
write('XY Coordinates totalling 40 will produce beep');
end;
FUNCTION MenuHit(cChar : char) : Boolean;
begin
GetMousePos;
MenuHit := FALSE;
if (27 = MPos(M3)) and (MouseButton[MOUSE_L].bFunction) then
begin
if (Menu_ClrScr = cChar) and (11 = MPos(M4)) then
begin
MenuHit := TRUE;
ClrScr;
Do_Mssg;
exit;
end;
if (Menu_Quit = cChar) and (12 = MPos(M4)) then
begin
MenuHit := TRUE;
exit;
end;
end;
end;
BEGIN
satisfied := false;
textcolor(7); { Grey }
ClrScr;
Do_Mssg;
while not keypressed do { until KEYBOARD key is pressed }
begin
GetMouseStats;
gotoxy(1,1);
write('M3 =',MPos(M3):2,
' M4 =',MPos(M4):2);
if (MPos(M3)+MPos(M4) = 40) then
begin
write(#7);
end;
if MouseButton[MOUSE_L].bFunction then
begin
gotoxy(16,1);
write('Left Button');
clreol;
end;
if MouseButton[MOUSE_R].bFunction then
begin
gotoxy(16,1);
write('Right Button');
clreol;
end;
if (MouseButton[MOUSE_M].bFunction= TRUE) or {Middle Button}
(MouseButton[MOUSE_L_R].bFunction = TRUE) then {Left & Right}
begin
SetMousePos(30*8, 11*8); { Sets MCursor out of way }
Frame(1,25,10,39,13);
gotoxy(26,11);
textcolor(14);
write(' ',Menu_ClrScr);
textcolor(07);
write('learscreen');
gotoxy(26,12);
textcolor(14);
write(' ',Menu_Quit);
textcolor(07);
write('uit');
repeat
if MenuHit(Menu_ClrScr) = TRUE then
begin
satisfied := true;
SetMousePos(0,0); {Sets MCursor out of way }
end;
gotoxy(1,1);
write('M3 =',MPos(M3):2,
' M4 =',MPos(M4):2);
clreol;
if MenuHit(Menu_Quit) = TRUE then
begin
satisfied := true;
DeInitMouse;
ClrScr;
halt;
end;
until satisfied = true;
{ClrScr;}
end;
satisfied := false;
end;
DeInitMouse; { Turn Mouse Off }
ClrScr;
END.
{ ------------------ UNIT FOR DEMO ABOVE -------------------- }
unit frame2;
interface
uses crt;
CONST
DtDs = 1;
StSs = 2;
DtSs = 3;
StDs = 4;
xSides : array[1..4, 1..6] of char = {xSides:array[1..4,1..6]of char =}
( { (}
(#201,#205,#187,#186,#200,#188), { ('É','Í','»','º','È','¼'),}
(#218,#196,#191,#179,#192,#217), { ('Ú','Ä','¿','³','À','Ù'),}
(#213,#205,#184,#179,#212,#190), { ('Õ','Í','¸','³','Ô','¾'),}
(#214,#196,#183,#186,#211,#189) { ('Ö','Ä','·','º','Ó','½')}
); { );}
procedure Frame(
iSideType,
iUpperLeftX,
iUpperLeftY,
iLowerRightX,
iLowerRightY : Integer);
implementation
procedure Frame(
iSideType,
iUpperLeftX,
iUpperLeftY,
iLowerRightX,
iLowerRightY : Integer);
var
i: Integer;
begin
GotoXY(iUpperLeftX, iUpperLeftY);
Write(xSides[iSideType][1]);
for i:= iUpperLeftX+1 to iLowerRightX-1 do
begin
Write(xSides[iSideType][2]);
end;
Write(xSides[iSideType][3]);
for i:= iUpperLeftY+1 to iLowerRightY-1 do
begin
GotoXY(iUpperLeftX , i);
Write(xSides[iSideType][4]);
GotoXY(iLowerRightX, i);
Write(xSides[iSideType][4]);
end;
GotoXY(iUpperLeftX, iLowerRightY);
Write(xSides[iSideType][5]);
for i:= iUpperLeftX+1 to iLowerRightX-1 do
begin
Write(xSides[iSideType][2]);
end;
Write(xSides[iSideType][6]);
end;
end.
[Back to MOUSE SWAG index] [Back to Main SWAG index] [Original]