diff --git a/lcl/controls.pp b/lcl/controls.pp index efbd5d73cd..8c8ab991dd 100644 --- a/lcl/controls.pp +++ b/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); diff --git a/lcl/include/control.inc b/lcl/include/control.inc index 3961c98b49..809d819238 100644 --- a/lcl/include/control.inc +++ b/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 diff --git a/lcl/include/wincontrol.inc b/lcl/include/wincontrol.inc index 40dd4590ca..43a649e310 100644 --- a/lcl/include/wincontrol.inc +++ b/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 ------------------------------------------------------------------------------} diff --git a/lcl/interfaces/gtk/gtkobject.inc b/lcl/interfaces/gtk/gtkobject.inc index d62d2baab9..8f48569647 100644 --- a/lcl/interfaces/gtk/gtkobject.inc +++ b/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; {------------------------------------------------------------------------------ diff --git a/lcl/interfaces/gtk/gtkproc.inc b/lcl/interfaces/gtk/gtkproc.inc index 30bf451375..948d3d663e 100644 --- a/lcl/interfaces/gtk/gtkproc.inc +++ b/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; + FixWidget:= GetFixedWidget(AWidget); + AWindow:= GetControlWindow(FixWidget); if AWindow = nil then exit; NewCursor := PGdkCursor(ACursor); diff --git a/lcl/interfaces/gtk/gtkwscontrols.pp b/lcl/interfaces/gtk/gtkwscontrols.pp index 1a193e3ef8..9b138f88d9 100644 --- a/lcl/interfaces/gtk/gtkwscontrols.pp +++ b/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; diff --git a/lcl/interfaces/win32/win32wscontrols.pp b/lcl/interfaces/win32/win32wscontrols.pp index 1d3f48a370..f3193bd778 100644 --- a/lcl/interfaces/win32/win32wscontrols.pp +++ b/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! diff --git a/lcl/widgetset/wscontrols.pp b/lcl/widgetset/wscontrols.pp index fa8a7537f7..677154fc05 100644 --- a/lcl/widgetset/wscontrols.pp +++ b/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;