* first implementation of winmouse unit

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
 #

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
 #

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

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
-
-}
+}

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
 }

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
+
+}