From 75c8bdc3a2bc6990730620fd88c095d1a02fb5b2 Mon Sep 17 00:00:00 2001 From: florian Date: Mon, 29 Nov 1999 22:03:39 +0000 Subject: [PATCH] * first implementation of winmouse unit --- rtl/win32/Makefile | 8 +- rtl/win32/Makefile.fpc | 6 +- rtl/win32/graph.inc | 28 +++++- rtl/win32/graphh.inc | 58 +++++++----- rtl/win32/wincrt.pp | 7 +- rtl/win32/winmouse.pp | 200 +++++++++++++++++++++++++++++++++++++++++ 6 files changed, 278 insertions(+), 29 deletions(-) create mode 100644 rtl/win32/winmouse.pp diff --git a/rtl/win32/Makefile b/rtl/win32/Makefile index 6c37b1d693..a9c0eb0c9d 100644 --- a/rtl/win32/Makefile +++ b/rtl/win32/Makefile @@ -1,5 +1,5 @@ # -# Makefile generated by fpcmake v0.99.13 on 1999-11-25 23:51 +# Makefile generated by fpcmake v0.99.13 on 1999-11-29 22:54 # defaultrule: all @@ -159,7 +159,7 @@ WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) # Targets override LOADEROBJECTS+=wprt0 wdllprt0 -override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings windows ole2 opengl32 winsock sockets initc dos crt objects graph sysutils typinfo math cpu mmx getopts heaptrc +override UNITOBJECTS+=$(SYSTEMUNIT) objpas strings windows ole2 opengl32 winsock sockets initc dos crt objects graph sysutils typinfo math cpu mmx getopts heaptrc wincrt winmouse # Clean @@ -1080,6 +1080,10 @@ sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMPPU) \ initc$(PPUEXT) : initc.pp $(SYSTEMPPU) +wincrt$(PPUEXT) : wincrt.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT) + +winmouse$(PPUEXT) : winmouse.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT) + # # TP7 Compatible RTL Units # diff --git a/rtl/win32/Makefile.fpc b/rtl/win32/Makefile.fpc index 8c13ea3248..5c41fb1d23 100644 --- a/rtl/win32/Makefile.fpc +++ b/rtl/win32/Makefile.fpc @@ -9,7 +9,7 @@ units=$(SYSTEMUNIT) objpas strings \ sockets initc \ dos crt objects graph \ sysutils typinfo math \ - cpu mmx getopts heaptrc + cpu mmx getopts heaptrc wincrt winmouse [packages] rtl=0 @@ -111,6 +111,10 @@ sockets$(PPUEXT) : sockets.pp windows$(PPUEXT) winsock$(PPUEXT) $(SYSTEMPPU) \ initc$(PPUEXT) : initc.pp $(SYSTEMPPU) +wincrt$(PPUEXT) : wincrt.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT) + +winmouse$(PPUEXT) : winmouse.pp $(SYSTEMPPU) windows$(PPUEXT) graph$(PPUEXT) + # # TP7 Compatible RTL Units # diff --git a/rtl/win32/graph.inc b/rtl/win32/graph.inc index c9f37b017e..8938fa187e 100644 --- a/rtl/win32/graph.inc +++ b/rtl/win32/graph.inc @@ -37,7 +37,6 @@ var graphdrawing : tcriticalsection; bitmapdc : hdc; oldbitmap : hgdiobj; - mainwindow : HWnd; pal : ^rgbrec; SavePtr : pointer; { we don't use that pointer } MessageThreadHandle : Handle; @@ -305,6 +304,26 @@ begin WindowProc := 0; case AMessage of + wm_lbuttondown, + wm_rbuttondown, + wm_mbuttondown, + wm_lbuttonup, + wm_rbuttonup, + wm_mbuttonup, + wm_lbuttondblclk, + wm_rbuttondblclk, + wm_mbuttondblclk, + wm_nclbuttondown, + wm_ncrbuttondown, + wm_ncmbuttondown, + wm_nclbuttonup, + wm_ncrbuttonup, + wm_ncmbuttonup, + wm_nclbuttondblclk, + wm_ncrbuttondblclk, + wm_ncmbuttondblclk: + if assigned(mousemessagehandler) then + WindowProc:=mousemessagehandler(window,amessage,wparam,lparam); wm_keydown, wm_keyup, wm_char: @@ -356,7 +375,7 @@ function WinRegister: Boolean; var WindowClass: WndClass; begin - WindowClass.Style := cs_hRedraw or cs_vRedraw; + WindowClass.Style := graphwindowstyle; WindowClass.lpfnWndProc := WndProc(@WindowProc); WindowClass.cbClsExtra := 0; WindowClass.cbWndExtra := 0; @@ -521,7 +540,10 @@ function queryadapterinfo : pmodeinfo; { $Log$ - Revision 1.1 1999-11-08 11:15:22 peter + Revision 1.2 1999-11-29 22:03:39 florian + * first implementation of winmouse unit + + Revision 1.1 1999/11/08 11:15:22 peter * move graph.inc to the target dir Revision 1.1 1999/11/03 20:23:02 florian diff --git a/rtl/win32/graphh.inc b/rtl/win32/graphh.inc index 344f53d911..369c9e3b60 100644 --- a/rtl/win32/graphh.inc +++ b/rtl/win32/graphh.inc @@ -1,23 +1,39 @@ -{ - $Id$ - This file is part of the Free Pascal run time library. - Copyright (c) 1999 by Florian Klaempfl - - This file implements the win32 gui support for the graph unit - - 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. - - **********************************************************************} - - -{ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999 by Florian Klaempfl + + This file implements the win32 gui support for the graph unit + + 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. + + **********************************************************************} + + + var + { this procedure allows to hook keyboard messages } + charmessagehandler : function(Window: hwnd; AMessage, WParam, + LParam: Longint): Longint; + { this procedure allows to hook mouse messages } + mousemessagehandler : function(Window: hwnd; AMessage, WParam, + LParam: Longint): Longint; + mainwindow : HWnd; + + const + { predefined window style } + graphwindowstyle : DWord = cs_hRedraw or cs_vRedraw; + + +{ $Log$ - Revision 1.1 1999-11-08 15:01:39 peter + Revision 1.2 1999-11-29 22:03:39 florian + * first implementation of winmouse unit + + Revision 1.1 1999/11/08 15:01:39 peter * fpcmake support - -} +} diff --git a/rtl/win32/wincrt.pp b/rtl/win32/wincrt.pp index ef69dd12e7..6674e32e38 100644 --- a/rtl/win32/wincrt.pp +++ b/rtl/win32/wincrt.pp @@ -118,6 +118,7 @@ unit wincrt; begin exitproc:=oldexitproc; + charmessagehandler:=nil; DeleteCriticalSection(keyboardhandling); end; begin @@ -130,7 +131,9 @@ begin end. { $Log$ - Revision 1.1 1999-11-24 22:33:15 florian - + created from extgraph + Revision 1.2 1999-11-29 22:03:39 florian + * first implementation of winmouse unit + Revision 1.1 1999/11/24 22:33:15 florian + + created from extgraph } diff --git a/rtl/win32/winmouse.pp b/rtl/win32/winmouse.pp new file mode 100644 index 0000000000..a430890c9f --- /dev/null +++ b/rtl/win32/winmouse.pp @@ -0,0 +1,200 @@ +{ + $Id$ + This file is part of the Free Pascal run time library. + Copyright (c) 1999 by Florian Klaempfl + member of the Free Pascal development team + + This is unit implements a subset of the msmouse unit functionality + for the gui win32 graph unit implementation + + 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 winmouse; + + interface + { 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; + +(*!!!!! the following functions aren't implemented yet: + { 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 + + uses + windows,graph; + + var + oldexitproc : pointer; + mousebuttonstate : byte; + + function InitMouse : boolean; + + begin + InitMouse:=true; + end; + + procedure ShowMouse; + + begin + Windows.ShowCursor(true); + end; + + procedure HideMouse; + + begin + Windows.ShowCursor(false); + end; + + function msghandler(Window: hwnd; AMessage, WParam, + LParam: Longint): Longint; + + begin + case amessage of + wm_lbuttondown: + mousebuttonstate:=mousebuttonstate or LButton; + wm_rbuttondown: + mousebuttonstate:=mousebuttonstate or RButton; + wm_mbuttondown: + mousebuttonstate:=mousebuttonstate or MButton; + wm_lbuttonup: + mousebuttonstate:=mousebuttonstate and not(LButton); + wm_rbuttonup: + mousebuttonstate:=mousebuttonstate and not(RButton); + wm_mbuttonup: + mousebuttonstate:=mousebuttonstate and not(MButton); + end; + msghandler:=0; + end; + + Function LPressed : Boolean; + + begin + LPressed:=(mousebuttonstate and LButton)<>0; + end; + + Function RPressed : Boolean; + + begin + RPressed:=(mousebuttonstate and RButton)<>0; + end; + + Function MPressed : Boolean; + + begin + MPressed:=(mousebuttonstate and MButton)<>0; + end; + + Procedure GetMouseState(var x,y,buttons : Longint); + + var + pos : POINT; + + begin + buttons:=mousebuttonstate; + GetCursorPos(@pos); + ScreenToClient(mainwindow,@pos); + x:=pos.x; + y:=pos.y; + end; + + procedure myexitproc; + + begin + exitproc:=oldexitproc; + mousemessagehandler:=nil; + end; + + begin + mousemessagehandler:=@msghandler; + oldexitproc:=exitproc; + exitproc:=@myexitproc; + mousebuttonstate:=0; + MouseFound:=GetSystemMetrics(SM_MOUSEPRESENT)<>0; + end. +{ + $Log$ + Revision 1.1 1999-11-29 22:03:39 florian + * first implementation of winmouse unit + +}