mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 23:24:11 +02:00
* first implementation of winmouse unit
This commit is contained in:
florian
parent
dbf50c9a22
commit
75c8bdc3a2
@ -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
|
||||
#
|
||||
|
||||
@ -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
|
||||
#
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
200
rtl/win32/winmouse.pp
Normal file
200
rtl/win32/winmouse.pp
Normal file
@ -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
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user