LCL: SetTempCursor is now called on every mouse move, cursors of TControls

git-svn-id: trunk@10595 -

lcl/controls.pp

@@ -1020,6 +1020,7 @@ type
     procedure MouseEnter; virtual;
     procedure MouseLeave; virtual;
     function  DialogChar(var Message: TLMKey): boolean; virtual;
+    procedure UpdateMouseCursor(X, Y: integer);
   protected
     procedure Changed;
     function  GetPalette: HPalette; virtual;
@@ -1172,12 +1173,11 @@ type
     procedure Refresh;
     procedure Repaint; virtual;
     procedure Invalidate; virtual;
-    procedure AddControl; virtual;
     function CheckChildClassAllowed(ChildClass: TClass;
                                     ExceptionOnInvalid: boolean): boolean;
     procedure CheckNewParent(AParent: TWinControl); virtual;
     procedure SendToBack;
-    procedure SetTempCursor(Value: TCursor);
+    procedure SetTempCursor(Value: TCursor); virtual;
     procedure UpdateRolesForForm; virtual;
     procedure ActiveDefaultControlChanged(NewControl: TControl); virtual;
     function  GetTextBuf(Buffer: PChar; BufSize: Integer): Integer; virtual;
@@ -1734,11 +1734,13 @@ type
     function ControlByName(const ControlName: string): TControl;
     procedure SelectNext(CurControl: TWinControl;
                          GoForward, CheckTabStop: Boolean);
+    procedure SetTempCursor(Value: TCursor); override;
     procedure BroadCast(var ToAllMessage);
     procedure NotifyControls(Msg: Word);
     procedure DefaultHandler(var AMessage); override;
     function  GetTextLen: Integer; override;
     procedure Invalidate; override;
+    procedure AddControl; virtual;
     procedure InsertControl(AControl: TControl);
     procedure InsertControl(AControl: TControl; Index: integer); virtual;
     procedure RemoveControl(AControl: TControl);

lcl/include/control.inc

@@ -1972,14 +1972,11 @@ begin
   Result := false;
 end;
 
-{------------------------------------------------------------------------------
-  TControl AddControl
-  
-  Add Handle object to parents Handle object.
-------------------------------------------------------------------------------}
-procedure TControl.AddControl;
+procedure TControl.UpdateMouseCursor(X, Y: integer);
 begin
-  TWSControlClass(WidgetSetClass).AddControl(Self);
+  //DebugLn(['TControl.UpdateMouseCursor ',DbgSName(Self)]);
+  if not (csDesigning in ComponentState) then
+    SetTempCursor(Cursor);
 end;
 
 {------------------------------------------------------------------------------
@@ -2212,7 +2209,8 @@ end;
 ------------------------------------------------------------------------------}
 procedure TControl.SetTempCursor(Value: TCursor);
 begin
-  TWSControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Value]);
+  if Parent<>nil then
+    Parent.SetTempCursor(Value);
 end;
 
 procedure TControl.ActiveDefaultControlChanged(NewControl: TControl);
@@ -3011,49 +3009,41 @@ Begin
   end;
 end;
 
-{------------------------------------------------------------------------------}
-{  TControl SetPopupMenu                                                                 }
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
+  TControl SetPopupMenu
+------------------------------------------------------------------------------}
 procedure TControl.SetPopupMenu(Value: TPopupMenu);
 begin
   FPopupMenu :=  Value;
-{    If Value <> nil then
-  begin
-
-  end;
-}
 end;
 
-{------------------------------------------------------------------------------}
-{  TControl WMDragStart
-}
-{------------------------------------------------------------------------------}
+{------------------------------------------------------------------------------
+  TControl WMDragStart
+------------------------------------------------------------------------------}
 Procedure TControl.WMDragStart(Var Message: TLMessage);
 Begin
   //do this here?
   BeginDrag(true);
 end;
 
-
 {------------------------------------------------------------------------------
   TControl WMMouseMove
 ------------------------------------------------------------------------------}
-Procedure TControl.WMMouseMove(Var Message: TLMMouseMove);
+procedure TControl.WMMouseMove(Var Message: TLMMouseMove);
 Begin
   {$IFDEF VerboseMouseBugfix}
   DebugLn(['[TControl.WMMouseMove] ',Name,':',ClassName,' ',Message.XPos,',',Message.YPos]);
   {$ENDIF}
   DoBeforeMouseMessage;
+  UpdateMouseCursor(Message.XPos,Message.YPos);
   if not (csNoStdEvents in ControlStyle)
   then with Message do
     MouseMove(KeystoShiftState(Keys), XPos, YPos);
 End;
 
-{------------------------------------------------------------------------------}
-{  TControl MouseDown
-}
-{------------------------------------------------------------------------------}
-
+{------------------------------------------------------------------------------
+  TControl MouseDown
+------------------------------------------------------------------------------}
 Procedure TControl.MouseDown(Button: TMouseButton; Shift: TShiftState;
   X, Y: Integer);
 var
@@ -3068,7 +3058,6 @@ end;
 
 {------------------------------------------------------------------------------
   TControl MouseMove
-
 ------------------------------------------------------------------------------}
 Procedure TControl.MouseMove(Shift: TShiftState; X, Y: Integer);
 var

lcl/include/wincontrol.inc

@@ -2692,6 +2692,12 @@ begin
   if CurControl <> nil then CurControl.SetFocus;
 end;
 
+procedure TWinControl.SetTempCursor(Value: TCursor);
+begin
+  if not HandleAllocated then exit;
+  TWSWinControlClass(WidgetSetClass).SetCursor(Self, Screen.Cursors[Value]);
+end;
+
 {------------------------------------------------------------------------------
   TWinControl FindChildControl
 ------------------------------------------------------------------------------}
@@ -4072,6 +4078,16 @@ Begin
     TWSWinControlClass(WidgetSetClass).Invalidate(Self);
 end;
 
+{------------------------------------------------------------------------------
+  TWinControl AddControl
+
+  Add Handle object to parents Handle object.
+------------------------------------------------------------------------------}
+procedure TWinControl.AddControl;
+begin
+  TWSControlClass(WidgetSetClass).AddControl(Self);
+end;
+
 {------------------------------------------------------------------------------
   TWinControl Repaint
 ------------------------------------------------------------------------------}

lcl/interfaces/gtk/gtkobject.inc

@@ -3528,8 +3528,8 @@ end;
 procedure TGtkWidgetSet.SetDesigning(AComponent: TComponent);
 begin
   // change cursor
-  if AComponent is TWinControl then
-    gtkproc.SetCursor(TWinControl(AComponent), Screen.Cursors[TWinControl(AComponent).Cursor]);    
+  //if AComponent is TWinControl then
+  //  gtkproc.SetCursor(TWinControl(AComponent), Screen.Cursors[TWinControl(AComponent).Cursor]);
 end;
 
 {------------------------------------------------------------------------------

lcl/interfaces/gtk/gtkproc.inc

@@ -4668,33 +4668,13 @@ var
   AWindow: PGdkWindow;
   NewCursor: PGdkCursor;
 begin
-  {$ifdef gtk2}
-  // MWE:
-  // We seriously need to rethink the way of setting cursors.
-  // for instance a button doesn't have an own xwindow.
-  // so setting the cursor results in a cursor set for the parent (=most times form)
-  // buttons have for instance a event_window, we might be able to set a cursor
-  // for that (if an input only window allows that).
-  // using an overridden Tgtk2WSButtonPrivate.SetCursor might solve it.
-  {$note Rethink gtk2 setcursor}
-  Exit;
-  {$endif}
-
   if not ((AWinControl is TWinControl) and AWinControl.HandleAllocated)
   then exit;
   
   AWidget:= PGtkWidget(AWinControl.Handle);
 
-  {$note Move designcursor to LCL}
-  if csDesigning in AWinControl.ComponentState
-  then begin
-    AWindow:=GetControlWindow(AWidget);
-    ACursor := Screen.Cursors[crDefault];
-  end else
-  begin
   FixWidget:= GetFixedWidget(AWidget);
   AWindow:= GetControlWindow(FixWidget);
-  end;
   if AWindow = nil then exit;
 
   NewCursor := PGdkCursor(ACursor);

lcl/interfaces/gtk/gtkwscontrols.pp

@@ -83,7 +83,7 @@ type
     class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
     class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
     class procedure SetColor(const AWinControl: TWinControl); override;
-    class procedure SetCursor(const AControl: TControl; const ACursor: HCursor); override;
+    class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
     class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
     class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
     class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
@@ -352,9 +352,12 @@ begin
   end;
 end;
 
-class procedure TGtkWSWinControl.SetCursor(const AControl: TControl; const ACursor: HCursor);
+class procedure TGtkWSWinControl.SetCursor(const AWinControl: TWinControl;
+  const ACursor: HCursor);
 begin
-  GtkProc.SetCursor(AControl as TWinControl, ACursor);
+  //DebugLn(['TGtkWSWinControl.SetCursor ',DbgSName(AWinControl)]);
+  if (not AWinControl.HandleAllocated) then exit;
+  GtkProc.SetCursor(AWinControl, ACursor);
 end;
 
 class procedure TGtkWSWinControl.SetFont(const AWinControl: TWinControl;

lcl/interfaces/win32/win32wscontrols.pp

@@ -56,7 +56,6 @@ type
   private
   protected
   public
-    class procedure SetCursor(const AControl: TControl; const ACursor: HCursor); override;
   end;
 
   { TWin32WSWinControl }
@@ -76,6 +75,7 @@ type
     class procedure SetColor(const AWinControl: TWinControl); override;
     class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
     class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
+    class procedure SetCursor(const AControl: TControl; const ACursor: HCursor); override;
 
     class procedure ConstraintsChange(const AWinControl: TWinControl); override;
     class function  CreateHandle(const AWinControl: TWinControl;
@@ -273,14 +273,6 @@ begin
       BuddyWindowInfo := nil;
 end;
 
-{ TWin32WSControl }
-
-class procedure TWin32WSControl.SetCursor(const AControl: TControl; const ACursor: HCursor);
-begin
-  Windows.SetCursor(ACursor);
-  //Windows.SetCursor(Windows.LoadCursor(0, LclCursorToWin32CursorMap[ACursor]));
-end;
-
 { TWin32WSWinControl }
 
 class function TWin32WSWinControl.CreateHandle(const AWinControl: TWinControl;
@@ -437,6 +429,13 @@ Begin
 {$endif}
 End;
 
+class procedure TWin32WSWinControl.SetCursor(const AControl: TControl;
+  const ACursor: HCursor);
+begin
+  Windows.SetCursor(ACursor);
+  //Windows.SetCursor(Windows.LoadCursor(0, LclCursorToWin32CursorMap[ACursor]));
+end;
+
 class procedure TWin32WSWinControl.ConstraintsChange(const AWinControl: TWinControl);
 begin
   // TODO: implement me!

lcl/widgetset/wscontrols.pp

@@ -61,7 +61,6 @@ type
 
   TWSControl = class(TWSLCLComponent)
     class procedure AddControl(const AControl: TControl); virtual;
-    class procedure SetCursor(const AControl: TControl; const ACursor: HCursor); virtual;
   end;
 
   TWSControlClass = class of TWSControl;
@@ -87,6 +86,7 @@ type
     class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); virtual;
     class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); virtual;
     class procedure SetText(const AWinControl: TWinControl; const AText: String); virtual;
+    class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); virtual;
 
     { TODO: this procedure is only used in win32 interface }
     class procedure AdaptBounds(const AWinControl: TWinControl;
@@ -125,10 +125,6 @@ class procedure TWSControl.AddControl(const AControl: TControl);
 begin
 end;
 
-class procedure TWSControl.SetCursor(const AControl: TControl; const ACursor: HCursor);
-begin
-end;
-
 { TWSWinControl }
 
 class procedure TWSWinControl.AdaptBounds(const AWinControl: TWinControl;
@@ -195,7 +191,6 @@ end;
 
 class procedure TWSWinControl.SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer);
 begin
-
 end;
     
 class procedure TWSWinControl.SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
@@ -212,6 +207,10 @@ class procedure TWSWinControl.SetColor(const AWinControl: TWinControl);
 begin
 end;
 
+class procedure TWSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor);
+begin
+end;
+
 class procedure TWSWinControl.SetFont(const AWinControl: TWinControl; const AFont: TFont);
 begin
 end;