1{
2 *****************************************************************************
3 *                             Gtk2WSButtons.pp                              *
4 *                             ----------------                              *
5 *                                                                           *
6 *                                                                           *
7 *****************************************************************************
8
9 *****************************************************************************
10  This file is part of the Lazarus Component Library (LCL)
11
12  See the file COPYING.modifiedLGPL.txt, included in this distribution,
13  for details about the license.
14 *****************************************************************************
15}
16unit Gtk2WSButtons;
17
18{$mode objfpc}{$H+}
19
20interface
21
22uses
23  // RTL
24  Classes, glib2, gtk2, gdk2, gdk2pixbuf,
25  // LCL
26  LCLType, Controls, Buttons, Graphics, ImgList,
27  // LazUtils
28  GraphType,
29  {$IFDEF DebugLCLComponents}
30  LazLoggerBase,
31  {$ENDIF}
32  // WS
33  WSButtons, WSLCLClasses, WSProc,
34  Gtk2Def;
35
36type
37  PBitBtnWidgetInfo = ^TBitBtnWidgetInfo;
38  TBitBtnWidgetInfo = record
39    ImageWidget: Pointer;
40    LabelWidget: Pointer;
41    SetLayoutCalled: boolean;
42  end;
43
44  { TGtk2WSBitBtn }
45
46  TGtk2WSBitBtn = class(TWSBitBtn)
47  private
48    class procedure BuildWidget(ABitBtn: TCustomBitBtn; MainWidget: PGtkWidget;
49      ABitBtnInfo: PBitBtnWidgetInfo; const ACaption: String);
50    class procedure UnparentWidget(Widget: PGtkWidget);
51    class procedure UpdateImageWidget(ImageWidget: PGtkImage; Bitmap: TBitmap);
52    class procedure UpdateLabelFont(LabelWidget: PGtkWidget; Font: TFont);
53  protected
54    class function UpdateGlyph(const ABitBtn: TCustomBitBtn; BitBtnInfo: PBitBtnWidgetInfo;
55      const AValue: TButtonGlyph; const AButtonState: TButtonState): Boolean;
56    class procedure UpdateMargin(const ABitBtn: TCustomBitBtn; const AAlignWidget: PGtkAlignment; const AMargin: Integer);
57    class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
58  published
59    class function  CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
60    class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override;
61    class procedure SetLayout(const ABitBtn: TCustomBitBtn; const {%H-}AValue: TButtonLayout); override;
62    class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
63    class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue: Integer); override;
64    class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
65    class procedure SetColor(const AWinControl: TWinControl); override;
66    class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
67  end;
68  TGtk2WSBitBtnClass = class of TGtk2WSBitBtn;
69
70
71  { TGtk2WSSpeedButton }
72
73  TGtk2WSSpeedButton = class(TWSSpeedButton)
74  private
75  protected
76  public
77  end;
78
79
80implementation
81
82uses
83  Gtk2Proc, Gtk2Int, Gtk2WSStdCtrls;
84
85const
86  GtkStateToButtonState: array[GTK_STATE_NORMAL..GTK_STATE_INSENSITIVE] of TButtonState =
87  (
88{GTK_STATE_NORMAL     } bsUp,
89{GTK_STATE_ACTIVE     } bsDown,
90{GTK_STATE_PRELIGHT   } bsHot,
91{GTK_STATE_SELECTED   } bsDown,
92{GTK_STATE_INSENSITIVE} bsDisabled
93  );
94
95type
96  TCustomBitBtnAccess = class(TCustomBitBtn)
97  end;
98
99procedure GtkWSBitBtn_StateChanged(AWidget: PGtkWidget; {%H-}AState: TGtkStateType; AInfo: PWidgetInfo); cdecl;
100var
101  BitBtn: TCustomBitBtnAccess;
102begin
103  //WriteLn(Astate, ' :: ', GTK_WIDGET_STATE(AWidget));
104  BitBtn := TCustomBitBtnAccess(AInfo^.LCLObject);
105  TGtk2WSBitBtn.UpdateGlyph(BitBtn, PBitBtnWidgetInfo(AInfo^.UserData),
106    BitBtn.FButtonGlyph, GtkStateToButtonState[GTK_WIDGET_STATE(AWidget)]);
107end;
108
109{ TGtk2WSBitBtn }
110
111class procedure TGtk2WSBitBtn.BuildWidget(ABitBtn: TCustomBitBtn; MainWidget: PGtkWidget; ABitBtnInfo: PBitBtnWidgetInfo; const ACaption: String);
112var
113  AlignWidget: PGtkWidget;
114  LabelWidget: PGtkWidget;
115  ImageWidget: PGtkWidget;
116  ContentWidget: PGtkWidget;
117begin
118  ImageWidget := ABitBtnInfo^.ImageWidget;
119  // keep a temporary reference to avoid the destruction and remove ImageWidget
120  if ImageWidget <> nil then
121  begin
122    g_object_ref(ImageWidget);
123    UnparentWidget(ImageWidget);
124  end;
125  // clear the widget (will destroy the children)
126  ContentWidget := gtk_bin_get_child(PGtkBin(MainWidget));
127  if ContentWidget <> nil then
128    gtk_container_remove(PGtkContainer(MainWidget), ContentWidget);
129  ContentWidget := nil;
130  // setup label
131  LabelWidget := nil;
132  if ACaption <> '' then
133  begin
134    LabelWidget := gtk_label_new(nil);
135    GTK2WidgetSet.SetLabelCaption(PGtkLabel(LabelWidget), ACaption);
136    UpdateLabelFont(LabelWidget, ABitBtn.Font);
137  end;
138  // button with image and label
139  if (ImageWidget <> nil) and (LabelWidget <> nil) then
140  begin
141    if (ABitBtn.Layout in [blGlyphLeft, blGlyphRight]) then
142      ContentWidget := gtk_hbox_new(False, ABitBtn.Spacing)
143    else
144      ContentWidget := gtk_vbox_new(False, ABitBtn.Spacing);
145
146    if (ABitBtn.Layout in [blGlyphLeft, blGlyphTop]) then
147      gtk_box_pack_start(PGtkBox(ContentWidget), ImageWidget, True, True, 0)
148    else
149      gtk_box_pack_end(PGtkBox(ContentWidget), ImageWidget, True, True, 0);
150
151    if (ABitBtn.Layout in [blGlyphRight, blGlyphBottom]) then
152      gtk_box_pack_start(PGtkBox(ContentWidget), LabelWidget, True, True, 0)
153    else
154      gtk_box_pack_end(PGtkBox(ContentWidget), LabelWidget, True, True, 0);
155  end
156  else
157  begin
158    // only image or label (or none)
159    if ImageWidget <> nil then
160      ContentWidget := ImageWidget
161    else if LabelWidget <> nil then
162      ContentWidget := LabelWidget;
163  end;
164  // setup align and build the widget
165  AlignWidget := gtk_alignment_new(0, 0, 0, 0);
166  UpdateMargin(ABitBtn, PGtkAlignment(AlignWidget), ABitBtn.Margin);
167  gtk_container_add(PGtkContainer(MainWidget), AlignWidget);
168  if ContentWidget <> nil then
169    gtk_container_add(PGtkContainer(AlignWidget), ContentWidget);
170  gtk_widget_show_all(AlignWidget);
171  // Release the temporary reference
172  if ImageWidget <> nil then
173    g_object_unref(ImageWidget);
174
175  ABitBtnInfo^.LabelWidget := LabelWidget;
176end;
177
178class procedure TGtk2WSBitBtn.UnparentWidget(Widget: PGtkWidget);
179var
180  ParentWidget: PGtkWidget;
181begin
182  ParentWidget := gtk_widget_get_parent(Widget);
183  if ParentWidget <> nil then
184    gtk_container_remove(PGtkContainer(ParentWidget), Widget);
185end;
186
187class function TGtk2WSBitBtn.CreateHandle(const AWinControl: TWinControl;
188  const AParams: TCreateParams): TLCLIntfHandle;
189var
190  BitBtn: TCustomBitBtn absolute AWinControl;
191  WidgetInfo: PWidgetInfo;
192  BitBtnInfo: PBitBtnWidgetInfo;
193  Allocation: TGTKAllocation;
194begin
195  Result := TLCLIntfHandle({%H-}PtrUInt(gtk_button_new));
196  if Result = 0 then Exit;
197  {$IFDEF DebugLCLComponents}
198  DebugGtkWidgets.MarkCreated(Pointer(Result),DbgSName(AWinControl));
199  {$ENDIF}
200
201  WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), BitBtn, AParams);
202
203  New(BitBtnInfo);
204  FillChar(BitBtnInfo^, SizeOf(BitBtnInfo^), 0);
205  WidgetInfo^.UserData := BitBtnInfo;
206  WidgetInfo^.DataOwner := True;
207
208  gtk_widget_show({%H-}PGtkWidget(Result));
209
210  Allocation.X := AParams.X;
211  Allocation.Y := AParams.Y;
212  Allocation.Width := AParams.Width;
213  Allocation.Height := AParams.Height;
214  gtk_widget_size_allocate({%H-}PGtkWidget(Result), @Allocation);
215
216  Set_RC_Name(AWinControl, {%H-}PGtkWidget(Result));
217  if not AWinControl.HandleObjectShouldBeVisible and not (csDesigning in AWinControl.ComponentState) then
218    gtk_widget_hide({%H-}PGtkWidget(Result));
219  SetCallbacks({%H-}PGtkWidget(Result), WidgetInfo);
220end;
221
222class procedure TGtk2WSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn;
223  const AValue: TButtonGlyph);
224var
225  MainWidget: PGtkWidget;
226  WidgetInfo: PWidgetInfo;
227  BitBtnInfo: PBitBtnWidgetInfo;
228  BuildNeeded: Boolean;
229begin
230  if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph') then
231    Exit;
232  MainWidget := {%H-}PGtkWidget(ABitBtn.Handle);
233  WidgetInfo := GetWidgetInfo(MainWidget);
234  BitBtnInfo := WidgetInfo^.UserData;
235  BuildNeeded := UpdateGlyph(ABitBtn, BitBtnInfo, AValue, GtkStateToButtonState[GTK_WIDGET_STATE(MainWidget)]);
236  if BuildNeeded and BitBtnInfo^.SetLayoutCalled then
237    BuildWidget(ABitBtn, MainWidget, BitBtnInfo, ABitBtn.Caption);
238end;
239
240class procedure TGtk2WSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn;
241  const AValue: TButtonLayout);
242var
243  MainWidget: PGtkWidget;
244  WidgetInfo: PWidgetInfo;
245  BitBtnInfo: PBitBtnWidgetInfo;
246begin
247  if not WSCheckHandleAllocated(ABitBtn, 'SetLayout') then
248    Exit;
249  MainWidget := {%H-}Pointer(ABitBtn.Handle);
250  WidgetInfo := GetWidgetInfo(MainWidget);
251  BitBtnInfo := WidgetInfo^.UserData;
252  BitBtnInfo^.SetLayoutCalled:=true;
253  BuildWidget(ABitBtn, MainWidget, BitBtnInfo, ABitBtn.Caption);
254end;
255
256class procedure TGtk2WSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn;
257  const AValue: Integer);
258var
259  MainWidget: PGtkWidget;
260  AlignWidget: PGtkAlignment;
261begin
262  if not WSCheckHandleAllocated(ABitBtn, 'SetMargin') then
263    Exit;
264  MainWidget := {%H-}PGtkWidget(ABitBtn.Handle);
265  AlignWidget := PGtkAlignment(gtk_bin_get_child(PGtkBin(MainWidget)));
266  if GTK_IS_ALIGNMENT(AlignWidget) then
267    UpdateMargin(ABitBtn, AlignWidget, AValue);
268end;
269
270class procedure TGtk2WSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn;
271  const AValue: Integer);
272var
273  MainWidget: PGtkWidget;
274  ChildWidget: PGtkWidget;
275begin
276  if not WSCheckHandleAllocated(ABitBtn, 'SetSpacing') then
277    Exit;
278  MainWidget := {%H-}Pointer(ABitBtn.Handle);
279  ChildWidget := gtk_bin_get_child(PGtkBin(MainWidget));
280  if GTK_IS_ALIGNMENT(ChildWidget) then
281  begin
282    ChildWidget := gtk_bin_get_child(PGtkBin(ChildWidget));
283    if GTK_IS_BOX(ChildWidget) then
284      gtk_box_set_spacing(PGtkBox(ChildWidget), AValue);
285  end;
286end;
287
288class procedure TGtk2WSBitBtn.SetText(const AWinControl: TWinControl;
289  const AText: String);
290var
291  MainWidget: PGtkWidget;
292  LabelWidget: PGtkWidget;
293  WidgetInfo: PWidgetInfo;
294  BitBtnInfo: PBitBtnWidgetInfo;
295  BuildNeeded: Boolean;
296begin
297  MainWidget := {%H-}Pointer(AWinControl.Handle);
298  WidgetInfo := GetWidgetInfo(MainWidget);
299  BitBtnInfo := WidgetInfo^.UserData;
300  if (not BitBtnInfo^.SetLayoutCalled)
301  or not WSCheckHandleAllocated(AWincontrol, 'SetText') then
302    Exit;
303  LabelWidget := BitBtnInfo^.LabelWidget;
304  BuildNeeded := (LabelWidget = nil) xor (AText = '');
305  if BuildNeeded then
306    BuildWidget(TBitBtn(AWinControl), MainWidget, BitBtnInfo, AText)
307  else
308  begin
309    if LabelWidget <> nil then
310      Gtk2WidgetSet.SetLabelCaption(PGtkLabel(LabelWidget), AText);
311  end;
312end;
313
314class procedure TGtk2WSBitBtn.SetColor(const AWinControl: TWinControl);
315var
316  Widget: PGTKWidget;
317begin
318  if not AWinControl.HandleAllocated then exit;
319  Widget:= {%H-}PGtkWidget(AWinControl.Handle);
320  Gtk2WidgetSet.SetWidgetColor(Widget, clNone, AWinControl.color,
321     [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
322end;
323
324class procedure TGtk2WSBitBtn.SetFont(const AWinControl: TWinControl;
325  const AFont: TFont);
326var
327  WidgetInfo: PWidgetInfo;
328  BitBtnInfo: PBitBtnWidgetInfo;
329  LabelWidget: PGTKWidget;
330begin
331  if not AWinControl.HandleAllocated then exit;
332
333  WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(AWinControl.Handle));
334  BitBtnInfo := WidgetInfo^.UserData;
335  LabelWidget := BitBtnInfo^.LabelWidget;
336  if LabelWidget <> nil then
337    UpdateLabelFont(LabelWidget, AFont);
338end;
339
340{
341  UpdateGlyph: update the bitbtn glyph and returns if the structure changed
342}
343
344class function TGtk2WSBitBtn.UpdateGlyph(const ABitBtn: TCustomBitBtn; BitBtnInfo: PBitBtnWidgetInfo;
345  const AValue: TButtonGlyph; const AButtonState: TButtonState): Boolean;
346var
347  ShowGlyph: Boolean;
348  ImageWidget: PGtkWidget;
349  AGlyph: TBitmap;
350  AIndex: Integer;
351  AEffect: TGraphicsDrawEffect;
352  AImageRes: TScaledImageListResolution;
353begin
354  ShowGlyph := ABitBtn.CanShowGlyph(True);
355  if ShowGlyph then
356  begin
357    ImageWidget := BitBtnInfo^.ImageWidget;
358    AGlyph := TBitmap.Create;
359    AValue.GetImageIndexAndEffect(AButtonState, ABitBtn.Font.PixelsPerInch,
360      ABitBtn.GetCanvasScaleFactor, AImageRes, AIndex, AEffect);
361    if (AIndex <> -1) and AImageRes.Valid then
362      AImageRes.GetBitmap(AIndex, AGlyph, AEffect);
363    ShowGlyph := not AGlyph.Empty;
364    if ShowGlyph then
365    begin
366      if ImageWidget = nil then
367        ImageWidget := gtk_image_new;
368      UpdateImageWidget(PGtkImage(ImageWidget), AGlyph);
369    end;
370    AGlyph.Destroy;
371  end
372  else
373    ImageWidget := nil;
374  // Return true if the image was removed or added
375  Result := ImageWidget <> BitBtnInfo^.ImageWidget;
376  if Result then
377  begin
378    // BitBtnInfo^.ImageWidget <> nil -> remove from parent
379    if not ShowGlyph then
380      UnparentWidget(BitBtnInfo^.ImageWidget);
381    BitBtnInfo^.ImageWidget := ImageWidget;
382  end;
383end;
384
385class procedure TGtk2WSBitBtn.UpdateMargin(const ABitBtn: TCustomBitBtn;
386  const AAlignWidget: PGtkAlignment; const AMargin: Integer);
387begin
388  if AMargin < 0 then
389    gtk_alignment_set (AAlignWidget, 0.5, 0.5, 0.0, 0.0)
390  else
391  begin
392    case ABitBtn.Layout of
393      blGlyphLeft:
394        begin
395          gtk_alignment_set(AAlignWidget, 0, 0.5, 0, 0);
396          gtk_alignment_set_padding(AAlignWidget, 0, 0, AMargin, 0);
397        end;
398      blGlyphRight:
399        begin
400          gtk_alignment_set(AAlignWidget, 1, 0.5, 0, 0);
401          gtk_alignment_set_padding(AAlignWidget, 0, 0, 0, AMargin);
402        end;
403      blGlyphTop:
404        begin
405          gtk_alignment_set(AAlignWidget, 0.5, 0, 0, 0);
406          gtk_alignment_set_padding(AAlignWidget, AMargin, 0, 0, 0);
407        end;
408      blGlyphBottom:
409        begin
410          gtk_alignment_set(AAlignWidget, 0.5, 1, 0, 0);
411          gtk_alignment_set_padding(AAlignWidget, 0, AMargin, 0, 0);
412        end;
413    end;
414  end;
415end;
416
417class procedure TGtk2WSBitBtn.SetCallbacks(const AGtkWidget: PGtkWidget;
418  const AWidgetInfo: PWidgetInfo);
419begin
420  TGtk2WSButton.SetCallbacks(AGtkWidget, AWidgetInfo);
421
422  SignalConnect(AGtkWidget, 'state-changed', @GtkWSBitBtn_StateChanged, AWidgetInfo);
423end;
424
425class procedure TGtk2WSBitBtn.UpdateImageWidget(ImageWidget: PGtkImage; Bitmap: TBitmap);
426var
427  GDIObject: PGDIObject;
428  Pixbuf: PGdkPixbuf;
429  Mask: PGdkBitmap;
430begin
431  GDIObject := {%H-}PGDIObject(Bitmap.Handle);
432  Mask := nil;
433  Pixbuf := nil;
434  if GDIObject^.GDIBitmapType = gbPixbuf then
435    Pixbuf := GDIObject^.GDIPixbufObject
436  else
437    Mask := CreateGdkMaskBitmap(Bitmap.Handle, Bitmap.MaskHandle);
438
439  if Pixbuf <> nil then
440    gtk_image_set_from_pixbuf(ImageWidget, Pixbuf)
441  else
442    gtk_image_set_from_pixmap(ImageWidget, GDIObject^.GDIPixmapObject.Image, Mask);
443
444  if Mask <> nil then
445    g_object_unref(Mask);
446end;
447
448class procedure TGtk2WSBitBtn.UpdateLabelFont(LabelWidget: PGtkWidget; Font: TFont);
449begin
450  Gtk2WidgetSet.SetWidgetColor(LabelWidget, Font.Color, clNone,
451    [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
452  Gtk2WidgetSet.SetWidgetFont(LabelWidget, Font);
453end;
454
455
456end.
457