1{%mainunit gtk2wsprivate.pp} 2 3{ 4 ***************************************************************************** 5 This file is part of the Lazarus Component Library (LCL) 6 7 See the file COPYING.modifiedLGPL.txt, included in this distribution, 8 for details about the license. 9 ***************************************************************************** 10} 11 12{ TGtkPrivateWidget } 13 14class procedure TGtkPrivateWidget.UpdateCursor(AInfo: PWidgetInfo); 15var 16 Widget, FixWidget: PGtkWidget; 17 Window: PGdkWindow; 18begin 19 Widget := AInfo^.CoreWidget; 20 FixWidget := GetFixedWidget(Widget); 21 Window := GetControlWindow(FixWidget); 22 if Window = nil then Exit; 23 // always recurse windows which do not accept controls. 24 // this way we will catch all widgets with double windows 25 if not (csAcceptsControls in TControl(AInfo^.LCLObject).ControlStyle) then 26 SetWindowCursor(Window, AInfo^.ControlCursor, False, True) 27 else 28 SetCursorForWindowsWithInfo(Window, AInfo, True); 29end; 30 31class procedure TGtkPrivateWidget.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); 32var 33 Widget: PGtkWidget; 34begin 35 if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition') 36 then Exit; 37 38 Widget := GetWidgetWithWindow(AWincontrol.Handle); 39 if Widget = nil then Exit; 40 if Widget^.Window=nil then exit; 41 42 case APosition of 43 wszpBack: begin 44 gdk_window_lower(Widget^.Window); 45 end; 46 wszpFront: begin 47 gdk_window_raise(Widget^.Window); 48 end; 49 end; 50end; 51 52{ TGtkPrivatePaned } 53 54class procedure TGtkPrivatePaned.UpdateCursor(AInfo: PWidgetInfo); 55var 56 Widget: PGtkWidget; 57 Window: PGdkWindow; 58begin 59 Widget := AInfo^.CoreWidget; 60 Window := PGTkPaned(Widget)^.handle; 61 if Window = nil then Exit; 62 SetWindowCursor(Window, AInfo^.ControlCursor, False, True); 63end; 64 65 66{ TGtkPrivateEntry } 67 68class procedure TGtk2PrivateButton.UpdateCursor(AInfo: PWidgetInfo); 69var 70 Widget: PGtkWidget; 71 Window: PGdkWindow; 72begin 73 Widget := AInfo^.CoreWidget; 74 if (Widget = nil) or not GTK_IS_BUTTON(Widget) then Exit; 75 Window := PGtkButton(Widget)^.event_window; 76 if Window = nil then Exit; 77 SetWindowCursor(Window, AInfo^.ControlCursor, False, True); 78end; 79 80{ TGtk2PrivateMemo } 81 82class procedure TGtk2PrivateMemo.UpdateCursor(AInfo: PWidgetInfo); 83var 84 Widget, FixWidget: PGtkWidget; 85 Window: PGdkWindow; 86begin 87 Widget := AInfo^.CoreWidget; 88 if (Widget = nil) or not GTK_IS_TEXT_VIEW(Widget) then Exit; 89 FixWidget := GetFixedWidget(Widget); 90 Window := GetControlWindow(FixWidget); 91 if Window = nil then Exit; 92 if TControl(AInfo^.LCLObject).Cursor = crDefault then 93 SetWindowCursor(Window, 0, True, False) 94 else 95 SetWindowCursor(Window, AInfo^.ControlCursor, True, False); 96end; 97 98class procedure TGtk2PrivateNotebook.UpdateCursor(AInfo: PWidgetInfo); 99var 100 Widget: PGtkWidget; 101 Window: PGdkWindow; 102 103 procedure UpdateCursorInternal(AInfo: PWidgetInfo); 104 var 105 Widget, FixWidget: PGtkWidget; 106 Window: PGdkWindow; 107 begin 108 Widget := AInfo^.CoreWidget; 109 FixWidget := GetFixedWidget(Widget); 110 Window := GetControlWindow(FixWidget); 111 if Window = nil then Exit; 112 // always recurse windows which do not accept controls. 113 // this way we will catch all widgets with double windows 114 if not (csAcceptsControls in TControl(AInfo^.LCLObject).ControlStyle) then 115 SetWindowCursor(Window, AInfo^.ControlCursor, True, True) 116 else 117 SetCursorForWindowsWithInfo(Window, AInfo, True); 118 end; 119 120begin 121 if IsTTabControl(AInfo^.CoreWidget) then 122 begin 123 UpdateCursorInternal(AInfo); 124 exit; 125 end; 126 Widget := AInfo^.CoreWidget; 127 Window := PGTkNotebook(Widget)^.event_window; 128 if Window <> nil then 129 SetWindowCursor(Window, AInfo^.ControlCursor, False, True); 130 // do not know how to set cursor under tabs 131end; 132 133