Stuck? Need help? Ask questions on our forums.

View \MOUSE.PAS

Turbo pascal development toolkit v 1.1

Submitted By: bobject
Rating: starstarstarstar (Rate It)


Unit Mouse;
{ Steven Sanderson }

INTERFACE

Uses Crt, graph;

Const ARROW = 0;
      CROSSHAIR = 1;
      MAGNIFY = 2;
      BUSY = 3;
      STRETCH = 4;
      SMILEY = 5;
      HAND = 6;
      PEN = 7;

Function LMouseDown : Boolean;
Function RMouseDown : Boolean;
Function CheckDblLClick(maxtime : Integer) : Boolean;
Function CheckDblRClick(maxtime : Integer) : Boolean;
Procedure WaitLMouseClick(maxtime : Integer);
Procedure WaitRMouseClick(maxtime : Integer);
Procedure WaitMouseClick;
Procedure WaitDoubleClick;
Function CheckDoubleClick : Boolean;

Procedure ShowMouse;
Procedure HideMouse;
Procedure LimitMouse(x1, y1, x2, y2 : Integer);
Procedure SetMouseCursor(img : Integer);
Function GetMouseX : Integer;
Function GetMouseY : Integer;
Function MouseInRect(x1, y1, x2, y2 : Integer) : Boolean;
Procedure SetMousePos(x, y : Integer);


IMPLEMENTATION

Function LMouseDown : Boolean; Assembler;
Asm
   MOV ax, 3            { Get Mouse State function }
   INT 33h              { Call MS Mouse driver }
   MOV ax, bx           { Button state in return register }
   AND ax, 1            { Clear all but left button state }
End;

Function CheckDblLClick(maxtime : Integer) : Boolean; Assembler;
Asm
   { Store original time }
   SUB sp, 2            { Allocate one word for time variable }
   MOV ax, 0            { Get clock ticks function }
   INT 1Ah              { Call clock interrupt }
   MOV [bp-2], dx       { Result in time variable }

   { Wait for mouse up }
@loop1:
   CALL @CheckTimeOut   { Check for timeout }
   CALL LMouseDown      { Determine state of left button }
   CMP ax, 1            { Is it down? }
   JE @loop1            { Loop if it is }

   { Wait for mouse down }
@loop2:
   CALL @CheckTimeOut   { Check for timeout }
   CALL LMouseDown      { Determine state of left button }
   CMP ax, 0            { Is it up? }
   JE @loop2            { Loop if it is }

   { Wait for mouse up }
@loop3:
   CALL @CheckTimeOut   { Check for timeout }
   CALL LMouseDown      { Determine state of left button }
   CMP ax, 1            { Is it down? }
   JE @loop3            { Loop if it is }

   { Return TRUE }
   ADD sp, 2            { Deallocate mem for time variable }
   MOV ax, 1            { Return value = TRUE }
   JMP @end             { Exit function }

@CheckTimeOut:
   MOV ax, 0            { Get ticks subfunction }
   INT 1Ah              { Call clock interrupt }
   MOV ax, dx           { Put new time in ax }
   MOV dx, [bp-2]       { Put time variable in dx }
   SUB ax, dx           { Difference in ax }
   MOV bx, 50           { 1 tick = 50ms }
   MUL bx               { Convert to milliseconds }
   CMP ax, maxtime      { Compare with stated maximum }
   JG @timeout          { Jump if timed out }
   RETN                 { Go back if not timed out }

@timeout:
   MOV ax, 0            { Return FALSE }
   ADD sp, 4            { Restore stack: 2 for time variable, 2 for this call}

@end:                   { Exit function }
End;


Function RMouseDown : Boolean; Assembler;
Asm
   MOV ax, 3            { Get Mouse State function }
   INT 33h              { Call MS Mouse driver }
   MOV ax, bx           { Button state in return register }
   SHR ax, 1            { Put right-button bit in least significant bit }
   AND ax, 1            { Clear all but right button state }
End;

Function CheckDblRClick(maxtime : Integer) : Boolean; Assembler;
Asm
   { Store original time }
   SUB sp, 2            { Allocate one word for time variable }
   MOV ax, 0            { Get clock ticks function }
   INT 1Ah              { Call clock interrupt }
   MOV [bp-2], dx       { Result in time variable }

   { Wait for mouse up }
@loop1:
   CALL @CheckTimeOut   { Check for timeout }
   CALL RMouseDown      { Determine state of right button }
   CMP ax, 1            { Is it down? }
   JE @loop1            { Loop if it is }

   { Wait for mouse down }
@loop2:
   CALL @CheckTimeOut   { Check for timeout }
   CALL RMouseDown      { Determine state of right button }
   CMP ax, 0            { Is it up? }
   JE @loop2            { Loop if it is }

   { Wait for mouse up }
@loop3:
   CALL @CheckTimeOut   { Check for timeout }
   CALL RMouseDown      { Determine state of right button }
   CMP ax, 1            { Is it down? }
   JE @loop3            { Loop if it is }

   { Return TRUE }
   ADD sp, 2            { Deallocate mem for time variable }
   MOV ax, 1            { Return value = TRUE }
   JMP @end             { Exit function }

@CheckTimeOut:
   MOV ax, 0            { Get ticks subfunction }
   INT 1Ah              { Call clock interrupt }
   MOV ax, dx           { Put new time in ax }
   MOV dx, [bp-2]       { Put time variable in dx }
   SUB ax, dx           { Difference in ax }
   MOV bx, 50           { 1 tick = 50ms }
   MUL bx               { Convert to milliseconds }
   CMP ax, maxtime      { Compare with stated maximum }
   JG @timeout          { Jump if timed out }
   RETN                 { Go back if not timed out }

@timeout:
   MOV ax, 0            { Return FALSE }
   ADD sp, 4            { Restore stack: 2 for time variable, 2 for this call}

@end:                   { Exit function }
End;

Procedure ShowMouse; Assembler;
Asm
   MOV ax, 1            { Show mouse function }
   INT 33h              { MS Mouse interrupt call }
End;

Procedure HideMouse; Assembler;
Asm
   MOV ax, 2            { Hide mouse function }
   INT 33h              { MS Mouse interrupt call }
End;

Procedure LimitMouse(x1, y1, x2, y2 : Integer); Assembler;
Asm
   CALL GetgraphMode    { Determine screen mode }
   CMP ax, $FFFF        { Is it text mode ? }
   JE @textmode         { Go there if it is }

   MOV cx, x1           { Min X }
   MOV dx, x2           { Max X }
   MOV ax, 7h           { Limit X function }
   INT 33h              { MS Mouse Interrupt call }

   MOV cx, y1           { Min Y }
   MOV dx, y2           { Max Y }
   MOV ax, 8h           { Limit Y function }
   INT 33h              { MS Mouse Interrupt call }

   JMP @end             { Exit now }

@textmode:
   SUB sp, 6            { Allocate 6 bytes (3 words) }

   MOV ax, x1           { Min X }
   CALL @convert        { Convert to pels }
   MOV [BP-6], ax       { Store new value }

   MOV ax, y1           { Min Y }
   CALL @convert        { Convert to pels }
   MOV [BP-4], ax       { Store new value }


   MOV ax, x2           { Min X }
   CALL @convert        { Convert to pels }
   MOV [BP-2], ax       { Store new value }

   MOV ax, y2           { Min Y }
   CALL @convert        { Convert to pels }

   MOV cx, [BP-4]       { Min X }
   MOV dx, ax           { Max Y }
   MOV ax, 08h          { Limit Y function }
   INT 33h              { MS Mouse Interrupt call }

   MOV cx, [BP-6]       { Min X }
   MOV dx, [BP-2]       { Max X }
   MOV ax, 07h          { Limit X function }
   INT 33h              { MS Mouse Interrupt call }

   ADD sp, 4            { Deallocate memory }
   JMP @end             { Exit procedure }

@convert:
   SUB ax, 1            { Make zero-based }
   SHL ax, 3            { Multiply by 8 }
   RETN                 { Go back }

@end:
End;

Procedure SetMouseCursor(img : Integer); Assembler;
Asm
   { Get pointer to selected data }
   MOV ax, img                  { AX = the image number passed }
   MOV bx, 68                   { Each cursor structure occupies 68 bytes }
   MUL bx                       { Multiply by 64 to get offset }
   LEA dx, @BitmapBase          { Location of base address in dx }
   ADD dx, ax                   { Add on offset calculated above }

   { Set up registers and call INT 33h }
   MOV ax, 09h                  { Set Graphics Cursor subfunction }
   MOV bx, dx                   { Pointer to data structure in BX }
   PUSH cs                      { Code Segment on stack... }
   POP es                       { ...and into Extra Segment }
   PUSH ds                      { Store DS for later restoration }
   PUSH cs                      { Code Segment on stack... }
   POP ds                       { ...and into Data Segment }
   MOV cx, [bx+2]               { Vertical offset of hotspot }
   MOV bx, [bx]                 { Horizontal offset of hotspot }
   POP ds                       { Restore DS }
   ADD dx, 4                    { Get past hotspot data }
   INT 33h                      { Call the MS Mouse driver }

   { Finished }
   JMP @end                     { Exit now }

@BitmapBase:
   { -------------- ARROW CURSOR ------------- }
   { Hotspot }
   DW 0, 0
   { Screen Mask }
   DW 0011111111111111B
   DW 0001111111111111B
   DW 0000111111111111B
   DW 0000011111111111B
   DW 0000001111000000B
   DW 0000000111111111B
   DW 0000000011111111B
   DW 0000000001111111B
   DW 0000000000111111B
   DW 0000000000011111B
   DW 0000000111111111B
   DW 0001000011111111B
   DW 0011000011111111B
   DW 1111100001111111B
   DW 1111100001111111B
   DW 1111110001111111B

   { Cursor Mask }
   DW 0000000000000000B
   DW 0100000000000000B
   DW 0110000000000000B
   DW 0111000000000000B
   DW 0111100000111111B
   DW 0111110000000000B
   DW 0111111000000000B
   DW 0111111100000000B
   DW 0111111110000000B
   DW 0111110000000000B
   DW 0110110000000000B
   DW 0100011000000000B
   DW 0000011000000000B
   DW 0000001100000000B
   DW 0000001100000000B
   DW 0000000000000000B

   { -------------- CROSSHAIR CURSOR ------------- }
   { Hotspot }
   DW 7, 7
   { Screen Mask }
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B
   DW 1111111111111111B


   { Cursor Mask }
   DW 0000000000000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0111111011111100B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000000000000B
   DW 0000000000000000B

   { -------------- MAGNIFY CURSOR ------------- }
   { Hotspot }
   DW 6, 6
   { Screen Mask }
   DW 1111100011111111B
   DW 1110000000111111B
   DW 1100000000011111B
   DW 1000000000001111B
   DW 1000000110001111B
   DW 0000001111000111B
   DW 0000011111000111B
   DW 0000111111000111B
   DW 0000111110000111B
   DW 1000011100000111B
   DW 1100000000000111B
   DW 1110000000000011B
   DW 1111100011000001B
   DW 1111111111100000B
   DW 1111111111110000B
   DW 1111111111111000B

   { Cursor Mask }
   DW 0000000000000000B
   DW 0000011100000000B
   DW 0001100011000000B
   DW 0010001000100000B
   DW 0010110000100000B
   DW 0100100000010000B
   DW 0101000000010000B
   DW 0100000000010000B
   DW 0010000000110000B
   DW 0010000000110000B
   DW 0001100011110000B
   DW 0000011100111000B
   DW 0000000000011100B
   DW 0000000000001110B
   DW 0000000000000110B
   DW 0000000000000000B


   { -------------- BUSY CURSOR ------------- }
   { Hotspot }
   DW 6, 6

   { Screen Mask }
   DW 1000000000000011B
   DW 1000000000000011B
   DW 1000000000000011B
   DW 1100011111000111B
   DW 1100010001000111B
   DW 1110001010001111B
   DW 1111000100011111B
   DW 1111100000111111B
   DW 1111100000111111B
   DW 1111000100011111B
   DW 1110001010001111B
   DW 1100010001000111B
   DW 1100010001000111B
   DW 1000000000000011B
   DW 1000000000000011B
   DW 1000000000000011B

   { Cursor Mask }
   DW 0000000000000000B
   DW 0011111111111000B
   DW 0000000000000000B
   DW 0001000000010000B
   DW 0001001110010000B
   DW 0000100100100000B
   DW 0000010001000000B
   DW 0000001010000000B
   DW 0000001010000000B
   DW 0000010001000000B
   DW 0000100100100000B
   DW 0001001110010000B
   DW 0001001110010000B
   DW 0000000000000000B
   DW 0011111111111000B
   DW 0000000000000000B

   { -------------- STRETCH CURSOR ------------- }
   { Hotspot }
   DW 7, 7
   { Screen Mask }
   DW 1111111011111111B
   DW 1111110001111111B
   DW 1111100000111111B
   DW 1111110001111111B
   DW 1111110001111111B
   DW 1101110001110111B
   DW 1000000000000011B
   DW 0000000000000001B
   DW 1000000000000011B
   DW 1101110001110111B
   DW 1111110001111111B
   DW 1111110001111111B
   DW 1111100000111111B
   DW 1111110001111111B
   DW 1111111011111111B
   DW 1111111111111111B

   { Cursor Mask }
   DW 0000000000000000B
   DW 0000000100000000B
   DW 0000001110000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0010000100001000B
   DW 0111111111111100B
   DW 0010000100001000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000000100000000B
   DW 0000001110000000B
   DW 0000000100000000B
   DW 0000000000000000B
   DW 0000000000000000B

   { -------------- SMILEY CURSOR ------------- }
   { Hotspot }
   DW 7, 7
   { Screen Mask }
   DW 1111111001111111B
   DW 1111100000011111B
   DW 1111000000001111B
   DW 1110000110000111B
   DW 1100000110000011B
   DW 1000000000000001B
   DW 0000000110000000B
   DW 0001001111001000B
   DW 0001110000111000B
   DW 0001110000111000B
   DW 0000100000010000B
   DW 1000000000000001B
   DW 1100000000000011B
   DW 1110000000000111B
   DW 1111000000001111B
   DW 1111100000011111B

   { Cursor Mask }
   DW 0000000000000000B
   DW 0000000110000000B
   DW 0000011001100000B
   DW 0000100000010000B
   DW 0001000000001000B
   DW 0010011001100100B
   DW 0010010000100100B
   DW 0100000110000010B
   DW 0100000110000010B
   DW 0100000110000010B
   DW 0010010000100100B
   DW 0010011111100100B
   DW 0001001111001000B
   DW 0000100000010000B
   DW 0000011111100000B
   DW 0000000000000000B

   { -------------- HAND CURSOR ------------- }
   { Hotspot }
   DW 3, 1
   { Screen Mask }
   DW 1110111111111111B
   DW 1100011111111111B
   DW 1100011111111111B
   DW 1100011111111111B
   DW 1100000011111111B
   DW 1100000000111111B
   DW 1100000000011111B
   DW 1000000000011111B
   DW 0000000000011111B
   DW 0000000000011111B
   DW 0000000000011111B
   DW 0000000000011111B
   DW 0000000000011111B
   DW 1000000000111111B
   DW 1100000000111111B
   DW 1100000000111111B

   { Cursor Mask }
   DW 0000000000000000B
   DW 0001000000000000B
   DW 0001000000000000B
   DW 0001000000000000B
   DW 0001000000000000B
   DW 0001010100000000B
   DW 0001010101000000B
   DW 0001010101000000B
   DW 0101010101000000B
   DW 0101010101000000B
   DW 0111111111000000B
   DW 0111111111000000B
   DW 0111111111000000B
   DW 0011111110000000B
   DW 0001111110000000B
   DW 0000000000000000B

   { -------------- PEN CURSOR ------------- }
   { Hotspot }
   DW 1, 1
   { Screen Mask }
   DW 0011111111111111B
   DW 0000111111111111B
   DW 1000011111111111B
   DW 1000000111111111B
   DW 1100000011111111B
   DW 1110000001111111B
   DW 1110000000111111B
   DW 1111000000011111B
   DW 1111100000001111B
   DW 1111110000000111B
   DW 1111111000000011B
   DW 1111111100000001B
   DW 1111111110000000B
   DW 1111111111000000B
   DW 1111111111100001B
   DW 1111111111110011B


   { Cursor Mask }
   DW 0000000000000000B
   DW 0100000000000000B
   DW 0011000000000000B
   DW 0011100000000000B
   DW 0001111000000000B
   DW 0000100100000000B
   DW 0000100010000000B
   DW 0000010001000000B
   DW 0000001000100000B
   DW 0000000100010000B
   DW 0000000010001000B
   DW 0000000001000100B
   DW 0000000000100010B
   DW 0000000000010010B
   DW 0000000000001100B
   DW 0000000000000000B

@end:
End;

Procedure SetMousePos(x, y : Integer); Assembler;
Asm
   CALL GetgraphMode      { Find out the gfx mode }
   MOV cx, x              { X value passed }
   MOV dx, y              { Y Value passed }
   CMP ax, $FFFF          { Are we in text mode? }
   JNE @ready             { If not in text mode, skip the next bit }

   SUB cx, 1              { X: Make zero-based }
   SHL cx, 3              { X: Multiply by 8 }
   SUB dx, 1              { Y: Make zero-based }
   SHL dx, 3              { Y: Multiply by 8 }

@ready:
   MOV ax, 4h             { Set pos subfunction }
   INT 33h                { Call MS Mouse driver }
End;

Procedure WaitLMouseClick(maxtime : Integer); Assembler;
Asm
@lbl1:
   CALL LMouseDown        { Is Left button down? }
   CMP ax, 1              { Find out if it is }
   JNE @lbl1              { If not, loop round }

   MOV ax, 0              { Get ticks function }
   INT 1Ah                { Call clock interrupt }
   PUSH dx                { Store value }

@lbl2:
   CALL LMouseDown        { Is it back up? }
   CMP ax, 1              { Is it then? }
   JE @lbl2               { If not, loop }

   MOV ax, 0              { Get ticks function }
   INT 1Ah                { Call clock interrupt }
   MOV ax, dx             { New value in AX }
   POP dx                 { Old value in DX }
   SUB ax, dx             { Find difference }
   MOV bx, 50             { 1 tick = 50ms }
   MUL bx                 { Convert to milliseconds }
   CMP ax, maxtime        { Are we within time limits? }
   JG @lbl1               { If timed out, start all over again }
End;

Procedure WaitRMouseClick(maxtime : Integer); Assembler;
Asm
@lbl1:
   CALL RMouseDown        { Is right button down? }
   CMP ax, 1              { Find out if it is }
   JNE @lbl1              { If not, loop round }

   MOV ax, 0              { Get ticks function }
   INT 1Ah                { Call clock interrupt }
   PUSH dx                { Store value }

@lbl2:
   CALL RMouseDown        { Is it back up? }
   CMP ax, 1              { Is it then? }
   JE @lbl2               { If not, loop }

   MOV ax, 0              { Get ticks function }
   INT 1Ah                { Call clock interrupt }
   MOV ax, dx             { New value in AX }
   POP dx                 { Old value in DX }
   SUB ax, dx             { Find difference }
   MOV bx, 50             { 1 tick = 50ms }
   MUL bx                 { Convert to milliseconds }
   CMP ax, maxtime        { Are we within time limits? }
   JG @lbl1               { If timed out, start all over again }
End;

Procedure WaitMouseClick; Assembler;
Asm
   PUSH 250               { Default is 250ms }
   CALL WaitLMouseClick   { Call the function }
End;

Function CheckDoubleClick : Boolean; Assembler;
Asm
   PUSH 400               { Default time 400ms }
   CALL CheckDblLClick    { Call the function }
End;

Procedure WaitDoubleClick; Assembler;
Asm
@lbl:
   CALL WaitMouseClick    { Wait for mouse down }
   CALL CheckDoubleClick  { Is there a dbl click? }
   CMP ax, 0              { Is there not? }
   JE @lbl                { Loop if not }
End;

Function GetMouseX : Integer; Assembler;
Asm
   MOV ax, 3              { Get Mouse state function }
   INT 33h                { Call MS Mouse interrupt }
   PUSH cx                { Store X pos }

   CALL GetgraphMode      { Find out gfx mode }
   CMP ax, $FFFF          { Is it text mode? }
   POP ax                 { Put X-pos back in AX }
   JNE @end               { If not, just exit }

   SHR ax, 3              { Divide by 8 }
   ADD ax, 1              { Make 1-based }

@end:
End;

Function GetMouseY : Integer; Assembler;
Asm
   MOV ax, 3              { Get Mouse state function }
   INT 33h                { Call MS Mouse interrupt }   PUSH dx                { Store Y pos }

   CALL GetgraphMode      { Find out gfx mode }
   CMP ax, $FFFF          { Is it text mode? }
   POP ax                 { Put Y-pos back in AX }
   JNE @end               { If not, just exit }

   SHR ax, 3              { Divide by 8 }
   ADD ax, 1              { Make 1-based }
@end:
End;

Function MouseInRect(x1, y1, x2, y2 : Integer) : Boolean; Assembler;
Asm
   CALL GetMouseX         { Determine X-Pos }
   CMP ax, x1             { Compare with min x }
   JL @false              { Bail out now if outside limit }
   CMP ax, x2             { Compare with max x }
   JG @false              { Bail out now if outside limit }

   CALL GetMouseY         { Determine Y-Pos }
   CMP ax, y1             { Compare with min y }
   JL @false              { Bail out now if outside limit }
   CMP ax, y2             { Compare with max y }
   JG @false              { Bail out now if outside limit }

   MOV ax, 1              { Return TRUE }
   JMP @end

@false:
   MOV ax, 0              { Return FALSE }
@end:
End;

End.

corner
© 1996-2008. All rights reserved. Reproduction in whole or in part, in any form or medium without express written permission is prohibited.
Violators of this policy may be subject to legal action. Please read our Terms Of Use and Privacy Statement for more information.
Publisher: Lars Hagelin.
bootstrapLabs Logo A bootstrapLabs project.