1{ $Id$}
2{
3 *****************************************************************************
4 *                             Gtk2WSExtCtrls.pp                             *
5 *                             -----------------                             *
6 *                                                                           *
7 *                                                                           *
8 *****************************************************************************
9
10 *****************************************************************************
11  This file is part of the Lazarus Component Library (LCL)
12
13  See the file COPYING.modifiedLGPL.txt, included in this distribution,
14  for details about the license.
15 *****************************************************************************
16}
17unit Gtk2WSExtCtrls;
18
19{$I gtk2defines.inc}
20{$define UseStatusIcon} // can be used only with fpc r13008, from 2009
21
22
23{$mode objfpc}{$H+}
24
25interface
26
27uses
28  // RTL
29  GLib2, Gtk2, Gdk2, Gdk2Pixbuf,
30  Classes, SysUtils, Types,
31  // LCL
32  Gtk2Int, Gtk2Def,
33  {$ifdef UseStatusIcon}Gtk2Ext, {$endif}
34  LCLProc, ExtCtrls, Controls, Graphics, LCLType,
35  // widgetset
36  WSExtCtrls, WSLCLClasses,
37  Gtk2WSControls, Gtk2Proc, Gtk2Globals;
38
39type
40
41  { TGtk2WSPage }
42
43  TGtk2WSPage = class(TWSPage)
44  published
45  end;
46
47  { TGtk2WSNotebook }
48
49  TGtk2WSNotebook = class(TWSNotebook)
50  published
51  end;
52
53  { TGtk2WSShape }
54
55  TGtk2WSShape = class(TWSShape)
56  published
57  end;
58
59  { TGtk2WSCustomSplitter }
60
61  TGtk2WSCustomSplitter = class(TWSCustomSplitter)
62  published
63  end;
64
65  { TGtk2WSSplitter }
66
67  TGtk2WSSplitter = class(TWSSplitter)
68  published
69  end;
70
71  { TGtk2WSPaintBox }
72
73  TGtk2WSPaintBox = class(TWSPaintBox)
74  published
75  end;
76
77  { TGtk2WSCustomImage }
78
79  TGtk2WSCustomImage = class(TWSCustomImage)
80  published
81  end;
82
83  { TGtk2WSImage }
84
85  TGtk2WSImage = class(TWSImage)
86  published
87  end;
88
89  { TGtk2WSBevel }
90
91  TGtk2WSBevel = class(TWSBevel)
92  published
93  end;
94
95  { TGtk2WSCustomRadioGroup }
96
97  TGtk2WSCustomRadioGroup = class(TWSCustomRadioGroup)
98  published
99  end;
100
101  { TGtk2WSRadioGroup }
102
103  TGtk2WSRadioGroup = class(TWSRadioGroup)
104  published
105  end;
106
107  { TGtk2WSCustomCheckGroup }
108
109  TGtk2WSCustomCheckGroup = class(TWSCustomCheckGroup)
110  published
111  end;
112
113  { TGtk2WSCheckGroup }
114
115  TGtk2WSCheckGroup = class(TWSCheckGroup)
116  published
117  end;
118
119  { TGtk2WSBoundLabel }
120
121  {TGtk2WSBoundLabel = class(TWSBoundLabel)
122  private
123  protected
124  public
125  end;}
126
127  { TGtk2WSCustomLabeledEdit }
128
129  TGtk2WSCustomLabeledEdit = class(TWSCustomLabeledEdit)
130  published
131  end;
132
133  { TGtk2WSLabeledEdit }
134
135  TGtk2WSLabeledEdit = class(TWSLabeledEdit)
136  published
137  end;
138
139  { TGtk2WSCustomPanel }
140
141  TGtk2WSCustomPanel = class(TWSCustomPanel)
142  protected
143    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
144  published
145    class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
146    class function GetDefaultColor(const {%H-}AControl: TControl; const ADefaultColorType: TDefaultColorType): TColor; override;
147    class procedure SetColor(const AWinControl: TWinControl); override;
148    class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
149  end;
150
151  { TGtk2WSPanel }
152
153  TGtk2WSPanel = class(TWSPanel)
154  published
155  end;
156
157  { TGtk2WSCustomTrayIcon }
158
159  TGtk2WSCustomTrayIcon = class(TWSCustomTrayIcon)
160  published
161    class function Hide(const ATrayIcon: TCustomTrayIcon): Boolean; override;
162    class function Show(const ATrayIcon: TCustomTrayIcon): Boolean; override;
163    class procedure InternalUpdate(const ATrayIcon: TCustomTrayIcon); override;
164    class function GetPosition(const ATrayIcon: TCustomTrayIcon): TPoint; override;
165  end;
166
167implementation
168
169{$ifdef HasX}
170uses
171  {$ifdef HasGdk2X}
172    gdk2x,
173  {$endif}
174  x, xlib;
175{$endif}
176
177{ TGtk2WSCustomPanel }
178
179class procedure TGtk2WSCustomPanel.SetCallbacks(const AGtkWidget: PGtkWidget;
180  const AWidgetInfo: PWidgetInfo);
181begin
182  TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
183end;
184
185class function TGtk2WSCustomPanel.CreateHandle(const AWinControl: TWinControl;
186  const AParams: TCreateParams): TLCLIntfHandle;
187var
188  Frame, WidgetClient: PGtkWidget;
189  WidgetInfo: PWidgetInfo;
190  Allocation: TGTKAllocation;
191  Style: PGtkRCStyle;
192  BorderStyle: TBorderStyle;
193begin
194  Frame := gtk_frame_new(nil);
195  BorderStyle:=TCustomControl(AWinControl).BorderStyle;
196  gtk_frame_set_shadow_type(PGtkFrame(Frame),BorderStyleShadowMap[BorderStyle]);
197
198  Style := gtk_widget_get_modifier_style(Frame);
199  Style^.xthickness := BorderShadowWidth[BorderStyle];
200  Style^.ythickness := BorderShadowWidth[BorderStyle];
201  gtk_widget_modify_style(Frame, Style);
202
203  {$IFDEF DebugLCLComponents}
204  DebugGtkWidgets.MarkCreated(Frame, dbgsName(AWinControl));
205  {$ENDIF}
206
207  WidgetClient := CreateFixedClientWidget(True);
208
209  gtk_container_add(GTK_CONTAINER(Frame), WidgetClient);
210  GTK_WIDGET_SET_FLAGS(Frame, GTK_CAN_FOCUS);
211
212  WidgetInfo := CreateWidgetInfo(Frame, AWinControl, AParams);
213  WidgetInfo^.ClientWidget := WidgetClient;
214  WidgetInfo^.CoreWidget := Frame;
215  WidgetInfo^.LCLObject := AWinControl;
216  WidgetInfo^.Style := AParams.Style;
217  WidgetInfo^.ExStyle := AParams.ExStyle;
218  WidgetInfo^.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
219
220  g_object_set_data(PGObject(WidgetClient), 'widgetinfo', WidgetInfo);
221
222  gtk_widget_show_all(Frame);
223
224  Allocation.X := AParams.X;
225  Allocation.Y := AParams.Y;
226  Allocation.Width := AParams.Width;
227  Allocation.Height := AParams.Height;
228  gtk_widget_size_allocate(Frame, @Allocation);
229
230  //debugln(['TGtk2WSCustomPanel.CreateHandle Frame^.allocation=',dbgs(Frame^.allocation),' WidgetClient^.allocation=',dbgs(WidgetClient^.allocation)]);
231
232  Set_RC_Name(AWinControl, Frame);
233
234  // issue #23940. Hide panel if we are not visible, but before setting callbacks.
235  // so it won't trigger unnecessary events to LCL.
236  if not AWinControl.HandleObjectShouldBeVisible and not (csDesigning in AWinControl.ComponentState) then
237    gtk_widget_hide(Frame);
238
239  SetCallbacks(Frame, WidgetInfo);
240
241  Result := TLCLIntfHandle({%H-}PtrUInt(Frame));
242end;
243
244class function TGtk2WSCustomPanel.GetDefaultColor(const AControl: TControl;
245  const ADefaultColorType: TDefaultColorType): TColor;
246const
247  DefColors: array[TDefaultColorType] of TColor = (
248 { dctBrush } clBackground,
249 { dctFont } clBtnText
250  );
251begin
252  Result := DefColors[ADefaultColorType];
253end;
254
255class procedure TGtk2WSCustomPanel.SetColor(const AWinControl: TWinControl);
256var
257  MainWidget: PGtkWidget;
258begin
259  if not AWinControl.HandleAllocated then exit;
260  MainWidget:=GetFixedWidget({%H-}pGtkWidget(AWinControl.handle));
261  if MainWidget<>nil then
262  Gtk2WidgetSet.SetWidgetColor(MainWidget,
263                              AWinControl.Font.Color, AWinControl.Color,
264                              [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
265                               GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
266
267  UpdateWidgetStyleOfControl(AWinControl);
268end;
269
270class procedure TGtk2WSCustomPanel.SetBorderStyle(
271  const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
272var
273  Frame: PGtkWidget;
274  Style: PGtkRCStyle;
275begin
276  Frame := PGtkWidget(AWinControl.Handle);
277  gtk_frame_set_shadow_type(PGtkFrame(Frame), BorderStyleShadowMap[ABorderStyle]);
278
279  Style := gtk_widget_get_modifier_style(Frame);
280  Style^.xthickness := BorderShadowWidth[ABorderStyle];
281  Style^.ythickness := BorderShadowWidth[ABorderStyle];
282  gtk_widget_modify_style(Frame, Style);
283end;
284
285
286{$include gtk2trayicon.inc}
287
288end.
289