From e18f336f3f1d12ca75e91ca389a4eb082b17d079 Mon Sep 17 00:00:00 2001 From: nickysn Date: Mon, 14 Oct 2013 14:31:14 +0000 Subject: [PATCH] + added unit ptcmouse, similar to winmouse and msmouse, for use with ptcgraph and ptccrt git-svn-id: trunk@25779 - --- .gitattributes | 1 + packages/graph/fpmake.pp | 5 + packages/graph/src/ptcgraph/ptcmouse.pp | 202 ++++++++++++++++++++++++ packages/ptc/docs/CHANGES.txt | 2 + 4 files changed, 210 insertions(+) create mode 100644 packages/graph/src/ptcgraph/ptcmouse.pp diff --git a/.gitattributes b/.gitattributes index adb1477850..20dbfa25a8 100644 --- a/.gitattributes +++ b/.gitattributes @@ -3339,6 +3339,7 @@ packages/graph/src/msdos/vesa.inc svneol=native#text/plain packages/graph/src/msdos/vesah.inc svneol=native#text/plain packages/graph/src/ptcgraph/ptccrt.pp svneol=native#text/plain packages/graph/src/ptcgraph/ptcgraph.pp svneol=native#text/x-pascal +packages/graph/src/ptcgraph/ptcmouse.pp svneol=native#text/plain packages/graph/src/sdlgraph/sdlgraph.pp svneol=native#text/plain packages/graph/src/unix/ggigraph.pp svneol=native#text/plain packages/graph/src/unix/graph.pp svneol=native#text/plain diff --git a/packages/graph/fpmake.pp b/packages/graph/fpmake.pp index 958c864ed7..2c0af8c181 100644 --- a/packages/graph/fpmake.pp +++ b/packages/graph/fpmake.pp @@ -120,6 +120,11 @@ begin begin AddUnit('ptcgraph'); end; + T:=P.Targets.AddUnit('ptcmouse.pp',[win32,win64,linux]); + with T.Dependencies do + begin + AddUnit('ptcgraph'); + end; {$ifndef ALLPACKAGES} diff --git a/packages/graph/src/ptcgraph/ptcmouse.pp b/packages/graph/src/ptcgraph/ptcmouse.pp new file mode 100644 index 0000000000..65d58ca602 --- /dev/null +++ b/packages/graph/src/ptcgraph/ptcmouse.pp @@ -0,0 +1,202 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2013 by Nikolay Nikolov (nickysn@users.sourceforge.net) + Copyright (c) 1999-2000 by Florian Klaempfl + member of the Free Pascal development team + + This file implements mouse input support for ptcgraph. + It is similar to the winmouse and msmouse units. + + 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 ptcmouse; + +{$MODE objfpc} + +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 + ptcgraph, ptc, ptcwrapper; + +function InGraphMode: Boolean; +begin + Result := (PTCWrapperObject <> nil) and (PTCWrapperObject.IsOpen); +end; + +var + MouseX, MouseY: LongInt; + MouseButtonState: Byte; + +procedure GetMouseEvents; +var + ev: IPTCEvent; + MouseEv: IPTCMouseEvent; +begin + if not InGraphMode then + begin + MouseX := 0; + MouseY := 0; + MouseButtonState := 0; + exit; + end; + repeat + PTCWrapperObject.NextEvent(ev, False, [PTCMouseEvent]); + if ev <> nil then + begin + case ev.EventType of + PTCMouseEvent: + begin + MouseEv := ev as IPTCMouseEvent; + MouseX := MouseEv.X; + MouseY := MouseEv.Y; + MouseButtonState := 0; + if PTCMouseButton1 in MouseEv.ButtonState then + MouseButtonState := MouseButtonState or LButton; + if PTCMouseButton2 in MouseEv.ButtonState then + MouseButtonState := MouseButtonState or RButton; + if PTCMouseButton3 in MouseEv.ButtonState then + MouseButtonState := MouseButtonState or MButton; + end; + end; + end; + until ev = nil; +end; + +function InitMouse: Boolean; +begin + GetMouseEvents; + InitMouse := MouseFound; +end; + +procedure ShowMouse; +begin + GetMouseEvents; + if InGraphMode then + PTCWrapperObject.Option('show cursor'); +end; + +procedure HideMouse; +begin + GetMouseEvents; + if InGraphMode then + PTCWrapperObject.Option('hide cursor'); +end; + +function LPressed: Boolean; +begin + GetMouseEvents; + LPressed := (MouseButtonState and LButton) <> 0; +end; + +function RPressed: Boolean; +begin + GetMouseEvents; + RPressed := (MouseButtonState and RButton) <> 0; +end; + +function MPressed: Boolean; +begin + GetMouseEvents; + MPressed := (MouseButtonState and MButton) <> 0; +end; + +procedure GetMouseState(var x, y, buttons: LongInt); +begin + GetMouseEvents; + x := MouseX; + y := MouseY; + buttons := MouseButtonState; +end; + +begin + MouseFound := True; +end. diff --git a/packages/ptc/docs/CHANGES.txt b/packages/ptc/docs/CHANGES.txt index 38b58944e3..47b5247826 100644 --- a/packages/ptc/docs/CHANGES.txt +++ b/packages/ptc/docs/CHANGES.txt @@ -1,4 +1,6 @@ 0.99.14 + - added new unit ptcmouse for use with ptcgraph & ptccrt applications. It is + similar to the winmouse and msmouse units. - support for resizable windows extended. Your application now receives a new event IPTCResizeEvent and is allowed to call a new method called InternalResize, which adjusts the console's width and height according to