← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to rtl/win32/winmouse.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
rtl/win32/winmouse.pp
1
 
{
2
 
    $Id: winmouse.pp,v 1.7 2005/02/14 17:13:32 peter Exp $
3
 
    This file is part of the Free Pascal run time library.
4
 
    Copyright (c) 1999-2000 by Florian Klaempfl
5
 
    member of the Free Pascal development team
6
 
 
7
 
    This is unit implements a subset of the msmouse unit functionality
8
 
    for the gui win32 graph unit implementation
9
 
 
10
 
    See the file COPYING.FPC, included in this distribution,
11
 
    for details about the copyright.
12
 
 
13
 
    This program is distributed in the hope that it will be useful,
14
 
    but WITHOUT ANY WARRANTY; without even the implied warranty of
15
 
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
16
 
 
17
 
 **********************************************************************}
18
 
unit winmouse;
19
 
 
20
 
  interface
21
 
    { initializes the mouse with the default values for the current screen mode }
22
 
    Function InitMouse:Boolean;
23
 
 
24
 
    { shows mouse pointer,text+graphics screen support }
25
 
    Procedure ShowMouse;
26
 
 
27
 
    { hides mouse pointer }
28
 
    Procedure HideMouse;
29
 
 
30
 
    { reads mouse position in pixels (divide by 8 to get text position in standard
31
 
      text mode) and reads the buttons state:
32
 
         bit 1 set -> left button pressed
33
 
         bit 2 set -> right button pressed
34
 
         bit 3 set -> middle button pressed
35
 
      Have a look at the example program in the manual to see how you can use this }
36
 
    Procedure GetMouseState(var x,y, buttons :Longint);
37
 
 
38
 
    { returns true if the left button is pressed }
39
 
    Function LPressed:Boolean;
40
 
 
41
 
    { returns true if the right button is pressed }
42
 
    Function RPressed:Boolean;
43
 
 
44
 
    { returns true if the middle button is pressed }
45
 
    Function MPressed:Boolean;
46
 
 
47
 
(*!!!!! the following functions aren't implemented yet:
48
 
    { positions the mouse pointer }
49
 
    Procedure SetMousePos(x,y:Longint);
50
 
 
51
 
    { returns at which position "button" was last pressed in x,y and returns the
52
 
      number of times this button has been pressed since the last time this
53
 
      function was called with "button" as parameter. For button you can use the
54
 
      LButton, RButton and MButton constants for resp. the left, right and middle
55
 
      button }
56
 
    Function GetLastButtonPress(button:Longint;var x,y:Longint): Longint;
57
 
 
58
 
    { returns at which position "button" was last released in x,y and returns the
59
 
      number of times this button has been re since the last time. For button
60
 
      you can use the LButton, RButton and MButton constants for resp. the left,
61
 
      right and middle button
62
 
    }
63
 
    Function GetLastButtonRelease (button : Longint; var x,y:Longint): Longint;
64
 
 
65
 
    { sets mouse's x range, with Min and Max resp. the higest and the lowest
66
 
      column (in pixels) in between which the mouse cursor can move }
67
 
    Procedure SetMouseXRange (Min,Max:Longint);
68
 
 
69
 
    { sets mouse's y range, with Min and Max resp. the higest and the lowest
70
 
      row (in pixels) in between which the mouse cursor can move}
71
 
    Procedure SetMouseYRange (Min,Max:Longint);
72
 
 
73
 
    { set the window coordinates in which the mouse cursor can move }
74
 
    Procedure SetMouseWindow(x1,y1,x2,y2:Longint);
75
 
 
76
 
    { sets the mouse shape in text mode: background and foreground color and the
77
 
      Ascii value with which the character on screen is XOR'ed when the cursor
78
 
      moves over it. Set to 0 for a "transparent" cursor}
79
 
    Procedure SetMouseShape(ForeColor,BackColor,Ascii:Byte);
80
 
 
81
 
    { sets the mouse ascii in text mode. The difference between this one and
82
 
      SetMouseShape, is that the foreground and background colors stay the same
83
 
      and that the Ascii code you enter is the character that you will get on
84
 
      screen; there's no XOR'ing }
85
 
    Procedure SetMouseAscii(Ascii:Byte);
86
 
 
87
 
    { set mouse speed in mickey's/pixel; default: horizontal: 8; vertical: 16 }
88
 
    Procedure SetMouseSpeed(Horizontal ,Vertical:Longint);
89
 
 
90
 
    { set a rectangle on screen that mouse will disappear if it is moved into }
91
 
    Procedure SetMouseHideWindow(x1,y1,x2,y2:Longint);
92
 
*)
93
 
 
94
 
    Const
95
 
       LButton = 1; { left button   }
96
 
       RButton = 2; { right button  }
97
 
       MButton = 4; { middle button }
98
 
 
99
 
    Var
100
 
       MouseFound: Boolean;
101
 
 
102
 
  implementation
103
 
 
104
 
    uses
105
 
       windows,graph;
106
 
 
107
 
    var
108
 
       oldexitproc : pointer;
109
 
       mousebuttonstate : byte;
110
 
 
111
 
    function InitMouse : boolean;
112
 
 
113
 
      begin
114
 
         InitMouse:=MouseFound;
115
 
      end;
116
 
 
117
 
    procedure ShowMouse;
118
 
 
119
 
      begin
120
 
         Windows.ShowCursor(true);
121
 
      end;
122
 
 
123
 
    procedure HideMouse;
124
 
 
125
 
      begin
126
 
         Windows.ShowCursor(false);
127
 
      end;
128
 
 
129
 
    function msghandler(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall;
130
 
 
131
 
      begin
132
 
         { we catch the double click messages here too, }
133
 
         { even if they never appear because the graph  }
134
 
         { windows doesn't have the cs_dblclks flags    }
135
 
         case amessage of
136
 
            wm_lbuttondblclk,
137
 
            wm_lbuttondown:
138
 
              mousebuttonstate:=mousebuttonstate or LButton;
139
 
            wm_rbuttondblclk,
140
 
            wm_rbuttondown:
141
 
              mousebuttonstate:=mousebuttonstate or RButton;
142
 
            wm_mbuttondblclk,
143
 
            wm_mbuttondown:
144
 
              mousebuttonstate:=mousebuttonstate or MButton;
145
 
            wm_lbuttonup:
146
 
              mousebuttonstate:=mousebuttonstate and not(LButton);
147
 
            wm_rbuttonup:
148
 
              mousebuttonstate:=mousebuttonstate and not(RButton);
149
 
            wm_mbuttonup:
150
 
              mousebuttonstate:=mousebuttonstate and not(MButton);
151
 
         end;
152
 
         msghandler:=0;
153
 
      end;
154
 
 
155
 
    Function LPressed : Boolean;
156
 
 
157
 
      begin
158
 
         LPressed:=(mousebuttonstate and LButton)<>0;
159
 
      end;
160
 
 
161
 
    Function RPressed : Boolean;
162
 
 
163
 
      begin
164
 
         RPressed:=(mousebuttonstate and RButton)<>0;
165
 
      end;
166
 
 
167
 
    Function MPressed : Boolean;
168
 
 
169
 
      begin
170
 
         MPressed:=(mousebuttonstate and MButton)<>0;
171
 
      end;
172
 
 
173
 
    Procedure GetMouseState(var x,y,buttons : Longint);
174
 
 
175
 
      var
176
 
         pos : POINT;
177
 
 
178
 
      begin
179
 
         buttons:=mousebuttonstate;
180
 
         GetCursorPos(@pos);
181
 
         ScreenToClient(GraphWindow,@pos);
182
 
         x:=pos.x;
183
 
         y:=pos.y;
184
 
      end;
185
 
 
186
 
    procedure myexitproc;
187
 
 
188
 
      begin
189
 
         exitproc:=oldexitproc;
190
 
         mousemessagehandler:=nil;
191
 
      end;
192
 
 
193
 
  begin
194
 
     mousemessagehandler:=@msghandler;
195
 
     oldexitproc:=exitproc;
196
 
     exitproc:=@myexitproc;
197
 
     mousebuttonstate:=0;
198
 
     MouseFound:=GetSystemMetrics(SM_MOUSEPRESENT)<>0;
199
 
  end.
200
 
{
201
 
  $Log: winmouse.pp,v $
202
 
  Revision 1.7  2005/02/14 17:13:32  peter
203
 
    * truncate log
204
 
 
205
 
}