* Mouse Cursor support has been added (GDI is untested).

* TfpgEdit and TfpgMemo now change the mouse cursor correctly.
* The prototypes/fpgui2/tests/edittest project show the mouse cursor in action. A GUI example project will be created soon to show all available cursors.

3 files changed, 89 insertions, 15 deletions

diff --git a/src/corelib/gdi/gfx_gdi.pas b/src/corelib/gdi/gfx_gdi.pas
index 821d855b..2dcade7e 100644
--- a/src/corelib/gdi/gfx_gdi.pas
+++ b/src/corelib/gdi/gfx_gdi.pas
@@ -136,6 +136,7 @@ type
     function    DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override;
     //procedure MoveToScreenCenter; override;
     procedure   DoSetWindowTitle(const ATitle: string); override;
+    procedure   DoSetMouseCursor; override;
     property    WinHandle: TfpgWinHandle read FWinHandle;
   public
     constructor Create(AOwner: TComponent); override;
@@ -157,6 +158,7 @@ type
     hcr_dir_nesw: HCURSOR;
     hcr_move: HCURSOR;
     hcr_crosshair: HCURSOR;
+    hcr_wait: HCURSOR;
     FFocusedWindow: THANDLE;
     LastClickWindow: TfpgWinHandle; // double click generation
     LastWinClickTime: longword;
@@ -491,18 +493,19 @@ begin
           end;
         end;
 
-(*
+
     WM_SETCURSOR:
-    begin
-      //Writeln('Hittest: ',IntToHex((lParam and $FFFF),4));
-      if (lParam and $FFFF) <= 1 then
-      begin
-        ptkSetMouseCursor(wg.WinHandle, wg.MouseCursor);
-        result := 1;
-      end
-      else Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
-    end;
-*)
+        begin
+//          {$IFDEF DEBUG} write(w.ClassName + ': '); {$ENDIF}
+          //Writeln('Hittest: ',IntToHex((lParam and $FFFF),4));
+          if (lParam and $FFFF) <= 1 then
+          begin
+            w.DoSetMouseCursor;
+//            ptkSetMouseCursor(wg.WinHandle, wg.MouseCursor);
+          end
+//          else Result := Windows.DefWindowProc(hwnd, uMsg, wParam, lParam);
+        end;
+
 
     WM_MOUSEMOVE,
     WM_LBUTTONDOWN,
@@ -738,9 +741,10 @@ begin
   hcr_dir_ns    := LoadCursor(0, IDC_SIZENS);
   hcr_edit      := LoadCursor(0, IDC_IBEAM);
   hcr_dir_nwse  := LoadCursor(0, IDC_SIZENWSE);
-  hcr_DIR_NESW  := LoadCursor(0, IDC_SIZENESW);
-  hcr_MOVE      := LoadCursor(0, IDC_SIZEALL);
-  hcr_CROSSHAIR := LoadCursor(0, IDC_CROSS);
+  hcr_dir_nesw  := LoadCursor(0, IDC_SIZENESW);
+  hcr_move      := LoadCursor(0, IDC_SIZEALL);
+  hcr_crosshair := LoadCursor(0, IDC_CROSS);
+  hcr_wait      := LoadCursor(0, IDC_WAIT);
 
   FIsInitialized := True;
   wapplication   := TfpgApplication(self);
@@ -1050,6 +1054,29 @@ begin
   {$endif}
 end;
 
+procedure TfpgWindowImpl.DoSetMouseCursor;
+var
+  hc: HCURSOR;
+begin
+  if not HasHandle then
+    Exit; //==>
+
+  case FMouseCursor of
+    mcSizeEW:     hc := wapplication.hcr_dir_ew;
+    mcSizeNS:     hc := wapplication.hcr_dir_ns;
+    mcIBeam:      hc := wapplication.hcr_edit;
+    mcSizeNWSE:   hc := wapplication.hcr_dir_nwse;
+    mcSizeNESW:   hc := wapplication.hcr_dir_nesw;
+    mcMove:       hc := wapplication.hcr_move;
+    mcCross:      hc := wapplication.hcr_crosshair;
+    mcHourGlass:  hc := wapplication.hcr_wait;
+  else
+    hc := hcr_default;
+  end;
+
+  SetCursor(hc);
+end;
+
 constructor TfpgWindowImpl.Create(aowner: TComponent);
 begin
   inherited;
diff --git a/src/corelib/gfxbase.pas b/src/corelib/gfxbase.pas
index 1c89e774..b668277e 100644
--- a/src/corelib/gfxbase.pas
+++ b/src/corelib/gfxbase.pas
@@ -301,7 +301,9 @@ type
   TfpgWindowBase = class(TComponent)
   private
     FParent: TfpgWindowBase;
+    procedure   SetMouseCursor(const AValue: TMouseCursor);
   protected
+    FMouseCursor: TMouseCursor;
     FWindowType: TWindowType;
     FWindowAttributes: TWindowAttributes;
     FTop: TfpgCoord;
@@ -319,6 +321,7 @@ type
     procedure   DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); virtual; abstract;
     function    DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; virtual; abstract;
     procedure   DoSetWindowTitle(const ATitle: string); virtual; abstract;
+    procedure   DoSetMouseCursor; virtual; abstract;
     procedure   SetParent(const AValue: TfpgWindowBase); virtual;
     function    GetParent: TfpgWindowBase; virtual;
     function    GetCanvas: TfpgCanvasBase; virtual;
@@ -326,6 +329,7 @@ type
     procedure   ReleaseWindowHandle;
     procedure   SetWindowTitle(const ATitle: string); virtual;
   public
+    constructor Create(AOwner: TComponent); override;
     // make some setup before the window shows
     procedure   AdjustWindowStyle; virtual;    // forms modify the window creation parameters
     procedure   SetWindowParameters; virtual;  // invoked after the window is created
@@ -348,6 +352,7 @@ type
     property    MinHeight: TfpgCoord read FMinHeight write FMinHeight;
     property    Canvas: TfpgCanvasBase read GetCanvas;
     property    Parent: TfpgWindowBase read GetParent write SetParent;
+    property    MouseCursor: TMouseCursor read FMouseCursor write SetMouseCursor;
   end;
 
 
@@ -641,6 +646,14 @@ end;
 
 { TfpgWindowBase }
 
+procedure TfpgWindowBase.SetMouseCursor(const AValue: TMouseCursor);
+begin
+  if FMouseCursor = AValue then
+    Exit; //==>
+  FMouseCursor := AValue;
+  DoSetMouseCursor;
+end;
+
 procedure TfpgWindowBase.SetParent(const AValue: TfpgWindowBase);
 begin
   FParent := AValue;
@@ -675,6 +688,12 @@ begin
   DoSetWindowTitle(ATitle);
 end;
 
+constructor TfpgWindowBase.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FMouseCursor := mcDefault;
+end;
+
 procedure TfpgWindowBase.AdjustWindowStyle;
 begin
   // does nothing here
diff --git a/src/corelib/x11/gfx_x11.pas b/src/corelib/x11/gfx_x11.pas
index 85d580cc..55362421 100644
--- a/src/corelib/x11/gfx_x11.pas
+++ b/src/corelib/x11/gfx_x11.pas
@@ -139,6 +139,7 @@ type
     procedure   DoMoveWindow(const x: TfpgCoord; const y: TfpgCoord); override;
     function    DoWindowToScreen(ASource: TfpgWindowBase; const AScreenPos: TPoint): TPoint; override;
     procedure   DoUpdateWindowPosition(aleft, atop, awidth, aheight: TfpgCoord); override;
+    procedure   DoSetMouseCursor; override;
     property    WinHandle: TfpgWinHandle read FWinHandle;
   public
     constructor Create(AOwner: TComponent); override;
@@ -195,7 +196,8 @@ uses
   gui_form, // remove this!!!!!
   xatom,
   gfx_utf8utils,
-  _netlayer;
+  _netlayer,
+  cursorfont;
 
 var
   xapplication: TfpgApplication;
@@ -1102,6 +1104,32 @@ begin
     XMoveResizeWindow(xapplication.display, FWinHandle, aleft, atop, w, h);
 end;
 
+procedure TfpgWindowImpl.DoSetMouseCursor;
+var
+  xc: TCursor;
+  shape: integer;
+begin
+  if not HasHandle then
+    Exit; //==>
+    
+  case FMouseCursor of
+    mcSizeEW:     shape := XC_sb_h_double_arrow;
+    mcSizeNS:     shape := XC_sb_v_double_arrow;
+    mcIBeam:      shape := XC_xterm;
+    mcSizeNWSE:   shape := XC_sizing;
+    mcSizeNESW:   shape := XC_sizing; // ????
+    mcMove:       shape := XC_center_ptr; // ????
+    mcCross:      shape := XC_crosshair;
+    mcHourGlass:  shape := XC_watch;
+  else
+    shape := XC_left_ptr; //XC_arrow;
+  end;
+
+  xc := XCreateFontCursor(xapplication.Display, shape);
+  XDefineCursor(xapplication.Display, FWinHandle, xc);
+  XFreeCursor(xapplication.Display, xc);
+end;
+
 procedure TfpgWindowImpl.DoSetWindowTitle(const atitle: string);
 var
   //s: string;