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