mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-31 21:09:38 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			398 lines
		
	
	
		
			9.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			398 lines
		
	
	
		
			9.1 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
| {
 | |
|     $Id$
 | |
|     This file is part of the Free Pascal run time library.
 | |
|     Copyright (c) 1999-2000 by the Free Pascal development team
 | |
| 
 | |
|     Mouse unit for microsoft mouse compatible drivers
 | |
| 
 | |
|     See the file COPYING.FPC, included in this distribution,
 | |
|     for details about the copyright.
 | |
| 
 | |
|     This program is distributed in the hope that it will be useful,
 | |
|     but WITHOUT ANY WARRANTY; without even the implied warranty of
 | |
|     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 | |
| 
 | |
|  **********************************************************************
 | |
| }
 | |
| Unit MSMouse;
 | |
| Interface
 | |
| 
 | |
| {
 | |
|   Mouse support functions and procedures, with error checking: if mouse
 | |
|   isn't present then the routine ends. If you want to remove error checking,
 | |
|   remove the next define.
 | |
| }
 | |
| 
 | |
| {$DEFINE MOUSECHECK}
 | |
| 
 | |
| {initializes the mouse with the default values for the current screen mode}
 | |
|   Function InitMouse:Boolean;
 | |
| 
 | |
| {shows mouse pointer,text+graphics screen support}
 | |
|   Procedure ShowMouse;
 | |
| 
 | |
| {hides mouse pointer}
 | |
|   Procedure HideMouse;
 | |
| 
 | |
| {reads mouse position in pixels (divide by 8 to get text position in standard
 | |
|  text mode) and reads the buttons state:
 | |
|     bit 1 set -> left button pressed
 | |
|     bit 2 set -> right button pressed
 | |
|     bit 3 set -> middle button pressed
 | |
|  Have a look at the example program in the manual to see how you can use this}
 | |
|   Procedure GetMouseState(var x,y, buttons :Longint);
 | |
| 
 | |
| {returns true if the left button is pressed}
 | |
|   Function LPressed:Boolean;
 | |
| 
 | |
| {returns true if the right button is pressed}
 | |
|   Function RPressed:Boolean;
 | |
| 
 | |
| {returns true if the middle button is pressed}
 | |
|   Function MPressed:Boolean;
 | |
| 
 | |
| {positions the mouse pointer}
 | |
|   Procedure SetMousePos(x,y:Longint);
 | |
| 
 | |
| {returns at which position "button" was last pressed in x,y and returns the
 | |
|  number of times this button has been pressed since the last time this
 | |
|  function was called with "button" as parameter. For button you can use the
 | |
|  LButton, RButton and MButton constants for resp. the left, right and middle
 | |
|  button}
 | |
|   Function GetLastButtonPress(button:Longint;var x,y:Longint): Longint;
 | |
| 
 | |
| {returns at which position "button" was last released in x,y and returns the
 | |
|  number of times this button has been re since the last time. For button
 | |
|  you can use the LButton, RButton and MButton constants for resp. the left,
 | |
|  right and middle button}
 | |
| Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
 | |
| 
 | |
| {sets mouse's x range, with Min and Max resp. the higest and the lowest
 | |
|  column (in pixels) in between which the mouse cursor can move}
 | |
|   Procedure SetMouseXRange (Min,Max:Longint);
 | |
| 
 | |
| {sets mouse's y range, with Min and Max resp. the higest and the lowest
 | |
|  row (in pixels) in between which the mouse cursor can move}
 | |
|   Procedure SetMouseYRange (Min,Max:Longint);
 | |
| 
 | |
| {set the window coordinates in which the mouse cursor can move}
 | |
|   Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
 | |
| 
 | |
| {sets the mouse shape in text mode: background and foreground color and the
 | |
|  Ascii value with which the character on screen is XOR'ed when the cursor
 | |
|  moves over it. Set to 0 for a "transparent" cursor}
 | |
|   Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
 | |
| 
 | |
| {sets the mouse ascii in text mode. The difference between this one and
 | |
|  SetMouseShape, is that the foreground and background colors stay the same
 | |
|  and that the Ascii code you enter is the character that you will get on
 | |
|  screen; there's no XOR'ing}
 | |
|   Procedure SetMouseAscii(Ascii:Byte);
 | |
| 
 | |
| {set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16}
 | |
|   Procedure SetMouseSpeed(Horizontal ,Vertical:Longint);
 | |
| 
 | |
| {set a rectangle on screen that mouse will disappear if it is moved into}
 | |
|   Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
 | |
| 
 | |
| Const LButton = 1; {left button}
 | |
|       RButton = 2; {right button}
 | |
|       MButton = 4; {middle button}
 | |
| 
 | |
| Var
 | |
|   MouseFound: Boolean;
 | |
| 
 | |
| Implementation
 | |
| 
 | |
| {$asmmode ATT}
 | |
| 
 | |
| Function InitMouse: Boolean;
 | |
| begin
 | |
|   asm
 | |
|         xorl    %eax,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         cmpw    $0xffff,%ax
 | |
|         setz    %al
 | |
|         movb    %al,__RESULT
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| 
 | |
| Procedure ShowMouse;
 | |
| begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $1,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Procedure HideMouse;
 | |
| begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $2,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Procedure GetMouseState(var x,y,buttons:Longint);
 | |
| begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $3,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         andl    $0xffff,%ecx
 | |
|         andl    $0xffff,%edx
 | |
|         movl    x,%eax
 | |
|         movl    %ecx,(%eax)
 | |
|         movl    y,%eax
 | |
|         movl    %edx,(%eax)
 | |
|         movl    buttons,%eax
 | |
|         movw    %bx,(%eax)
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Function LPressed:Boolean;
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $3,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         movl    %ebx,%eax
 | |
|         andl    $1,%eax
 | |
|         movb    %al,__RESULT
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Function RPressed:Boolean;
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $3,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         movl    %ebx,%eax
 | |
|         shrl    $1,%eax
 | |
|         andl    $1,%eax
 | |
|         movb    %al,__RESULT
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Function MPressed:Boolean;
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $3,%eax
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         movl    %ebx,%eax
 | |
|         shrl    $2,%eax
 | |
|         andl    $1,%eax
 | |
|         movb    %al,__RESULT
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Procedure SetMousePos(x,y:Longint);
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $4,%eax
 | |
|         movl    x,%ecx
 | |
|         movl    y,%edx
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   End;
 | |
| End;
 | |
| 
 | |
| Function GetLastButtonPress(Button: Longint;var x,y:Longint):Longint;
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $5,%eax
 | |
|         movl    button,%ebx
 | |
|         shrl    $1, %ebx        {0 = left, 1 = right, 2 = middle}
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         andl    $0xffff,%ebx
 | |
|         andl    $0xffff,%edx
 | |
|         andl    $0xffff,%ecx
 | |
|         movl    %ebx, __RESULT
 | |
|         movl    x,%eax
 | |
|         movl    %ecx,(%eax)
 | |
|         movl    y,%eax
 | |
|         movl    %edx,(%eax)
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
 | |
| begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $6,%eax
 | |
|         movl    button,%ebx
 | |
|         shrl    $1, %ebx        {0 = left, 1 = right, 2 = middle}
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|         andl    $0xffff,%ebx
 | |
|         andl    $0xffff,%ecx
 | |
|         andl    $0xffff,%edx
 | |
|         movl    %ebx,__RESULT
 | |
|         movl    x,%eax
 | |
|         movl    %ecx,(%eax)
 | |
|         movl    y,%eax
 | |
|         movl    %edx,(%eax)
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Procedure SetMouseXRange (Min,Max:Longint);
 | |
| begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $7,%eax
 | |
|         movl    min,%ecx
 | |
|         movl    max,%edx
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Procedure SetMouseYRange (min,max:Longint);
 | |
| begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $8,%eax
 | |
|         movl    min,%ecx
 | |
|         movl    max,%edx
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   end;
 | |
| end;
 | |
| 
 | |
| Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   SetMouseXRange(x1,x2);
 | |
|   SetMouseYRange(y1,y2);
 | |
| End;
 | |
| 
 | |
| Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         xorl    %ebx,%ebx
 | |
|         movl    $0xa,%eax
 | |
|         movl    $0xffff,%ecx
 | |
|         xorl    %edx,%edx
 | |
|         movb    BackColor,%dh
 | |
|         shlb    $4,%dh
 | |
|         addb    ForeColor,%dh
 | |
|         movb    Ascii,%dl
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   End;
 | |
| End;
 | |
| 
 | |
| Procedure SetMouseAscii(Ascii:byte);
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         xorl    %ebx,%ebx
 | |
|         movl    $0xa,%eax
 | |
|         movl    $0xff00,%ecx
 | |
|         xorl    %edx,%edx
 | |
|         movb    Ascii,%dl
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   End;
 | |
| End;
 | |
| 
 | |
| Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $0x0010,%eax
 | |
|         movl    x1,%ecx
 | |
|         movl    y1,%edx
 | |
|         movl    x2,%esi
 | |
|         movl    y2,%edi
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   end;
 | |
| End;
 | |
| 
 | |
| Procedure SetMouseSpeed(Horizontal,Vertical:Longint);
 | |
| Begin
 | |
| {$IFDEF MOUSECHECK}
 | |
|   If (Not MouseFound) Then Exit;
 | |
| {$ENDIF}
 | |
|   asm
 | |
|         movl    $0x0f,%eax
 | |
|         movl    Horizontal,%ecx
 | |
|         movl    Vertical,%edx
 | |
|         pushl   %ebp
 | |
|         int     $0x33
 | |
|         popl    %ebp
 | |
|   end;
 | |
| End;
 | |
| 
 | |
| Begin
 | |
|   MouseFound := InitMouse;
 | |
| End.
 | |
| {
 | |
|   $Log$
 | |
|   Revision 1.2  2000-07-13 11:33:40  michael
 | |
|   + removed logs
 | |
|  
 | |
| }
 | 
