123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400 |
- {
- 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.
- }
- {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
- Function InitMouse: Boolean;
- begin
- if MemL[0:$33*4] = 0 then
- exit(False);
- asm
- xor ax,ax
- push bp
- int $33
- pop bp
- cmp ax, $FFFF
- mov al, 0
- jne @@1
- inc al
- @@1:
- mov @Result, al
- end;
- end;
- Procedure ShowMouse;
- begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 1
- push bp
- int $33
- pop bp
- end;
- end;
- Procedure HideMouse;
- begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 2
- push bp
- int $33
- pop bp
- end;
- end;
- Procedure GetMouseState(var x,y,buttons:LongInt);
- begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 3
- push bp
- int $33
- pop bp
- {$if defined(FPC_MM_TINY) or defined(FPC_MM_SMALL) or defined(FPC_MM_MEDIUM)}
- mov di, x
- mov [di], cx
- mov word [di + 2], 0
- mov di, y
- mov [di], dx
- mov word [di + 2], 0
- mov di, buttons
- mov [di], bx
- mov word [di + 2], 0
- {$else}
- mov ax, ds
- lds di, x
- mov [di], cx
- mov word [di + 2], 0
- lds di, y
- mov [di], dx
- mov word [di + 2], 0
- lds di, buttons
- mov [di], bx
- mov word [di + 2], 0
- mov ds, ax
- {$endif}
- end;
- end;
- Function LPressed:Boolean;
- Begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 3
- push bp
- int $33
- pop bp
- mov ax,bx
- and ax, 1
- mov @Result, al
- end;
- end;
- Function RPressed:Boolean;
- Begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 3
- push bp
- int $33
- pop bp
- mov ax,bx
- shr ax,1
- and ax,1
- mov @Result, al
- end;
- end;
- Function MPressed:Boolean;
- Begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 3
- push bp
- int $33
- pop bp
- mov ax, bx
- shr ax, 1
- shr ax, 1
- and ax, 1
- mov @Result, al
- end;
- end;
- Procedure SetMousePos(x,y:LongInt);
- Begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 4
- mov cx, x
- mov dx, y
- push bp
- int $33
- pop bp
- End;
- End;
- Function GetLastButtonPress(Button: LongInt;var x,y:LongInt):LongInt;
- Begin
- If (Not MouseFound) Then Exit;
- GetLastButtonPress := 0;
- asm
- mov ax, 5
- mov bx, button
- shr bx, 1 {0 = left, 1 = right, 2 = middle}
- push bp
- int $33
- pop bp
- mov word ptr @Result, bx
- {$if defined(FPC_MM_TINY) or defined(FPC_MM_SMALL) or defined(FPC_MM_MEDIUM)}
- mov di, x
- mov [di], cx
- mov word [di + 2], 0
- mov di, y
- mov [di], dx
- mov word [di + 2], 0
- {$else}
- mov si, ds
- lds di, x
- mov [di], cx
- mov word [di + 2], 0
- lds di, y
- mov [di], dx
- mov word [di + 2], 0
- mov ds, si
- {$endif}
- end;
- end;
- Function GetLastButtonRelease (button : LongInt; var x,y:LongInt): LongInt;
- begin
- If (Not MouseFound) Then Exit;
- GetLastButtonRelease := 0;
- asm
- mov ax, 6
- mov bx, button
- shr bx, 1 {0 = left, 1 = right, 2 = middle}
- push bp
- int $33
- pop bp
- mov word ptr @Result, bx
- {$if defined(FPC_MM_TINY) or defined(FPC_MM_SMALL) or defined(FPC_MM_MEDIUM)}
- mov di, x
- mov [di], cx
- mov word [di + 2], 0
- mov di, y
- mov [di], dx
- mov word [di + 2], 0
- {$else}
- mov si, ds
- lds di, x
- mov [di], cx
- mov word [di + 2], 0
- lds di, y
- mov [di], dx
- mov word [di + 2], 0
- mov ds, si
- {$endif}
- end;
- end;
- Procedure SetMouseXRange (Min,Max:LongInt);
- begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 7
- mov cx, min
- mov dx, max
- push bp
- int $33
- pop bp
- end;
- end;
- Procedure SetMouseYRange (min,max:LongInt);
- begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, 8
- mov cx, min
- mov dx, max
- push bp
- int $33
- pop bp
- end;
- end;
- Procedure SetMouseWindow(x1,y1,x2,y2:LongInt);
- Begin
- If (Not MouseFound) Then Exit;
- SetMouseXRange(x1,x2);
- SetMouseYRange(y1,y2);
- End;
- Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
- Begin
- If (Not MouseFound) Then Exit;
- asm
- xor bx, bx
- mov ax, 10
- xor dx, dx
- mov dh, BackColor
- mov cl, 4
- shl dh, cl
- add dh, ForeColor
- mov dl, Ascii
- mov cx, $ffff
- push bp
- int $33
- pop bp
- End;
- End;
- Procedure SetMouseAscii(Ascii:byte);
- Begin
- If (Not MouseFound) Then Exit;
- asm
- xor bx, bx
- mov ax, 10
- mov cx, $ff00
- xor dx,dx
- mov dl, Ascii
- push bp
- int $33
- pop bp
- End;
- End;
- Procedure SetMouseHideWindow(x1,y1,x2,y2:LongInt);
- Begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, $0010
- mov cx, x1
- mov dx, y1
- mov si, x2
- mov di, y2
- push bp
- int $33
- pop bp
- end;
- End;
- Procedure SetMouseSpeed(Horizontal,Vertical:LongInt);
- Begin
- If (Not MouseFound) Then Exit;
- asm
- mov ax, $0f
- mov cx, Horizontal
- mov dx, Vertical
- push bp
- int $33
- pop bp
- end;
- End;
- Begin
- MouseFound := InitMouse;
- End.
|