1{ $Id$} 2{ 3 ***************************************************************************** 4 * GtkWSButtons.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 GtkWSButtons; 18 19{$mode objfpc}{$H+} 20 21interface 22 23uses 24 // libs 25 {$IFDEF GTK2} 26 Gtk2, gdk2, gdk2Pixbuf, 27 {$ELSE} 28 GLib, Gtk, gdk, gdkPixbuf, Gtk1WSPrivate, 29 {$ENDIF} 30 // LCL 31 Classes, LCLType, Controls, Graphics, GraphType, Buttons, ImgList, 32 // widgetset 33 WSButtons, WSProc, 34 // interface 35 GtkDef, GtkExtra; 36 37type 38 PBitBtnWidgetInfo = ^TBitBtnWidgetInfo; 39 TBitBtnWidgetInfo = record 40 LabelWidget: Pointer; 41 ImageWidget: Pointer; 42 SpaceWidget: Pointer; 43 AlignWidget: Pointer; 44 TableWidget: Pointer; 45 end; 46 47 { TGtkWSBitBtn } 48 49 TGtkWSBitBtn = class(TWSBitBtn) 50 private 51 protected 52 class procedure UpdateGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph; const AButtonState: TButtonState); virtual; 53 class procedure UpdateLayout(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer); 54 class procedure UpdateMargin(const AInfo: PBitBtnWidgetInfo; const ALayout: TButtonLayout; const AMargin: Integer); 55 class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; 56 published 57 class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 58 class procedure SetGlyph(const ABitBtn: TCustomBitBtn; const AValue: TButtonGlyph); override; 59 class procedure SetLayout(const ABitBtn: TCustomBitBtn; const AValue: TButtonLayout); override; 60 class procedure SetMargin(const ABitBtn: TCustomBitBtn; const AValue: Integer); override; 61 class procedure SetSpacing(const ABitBtn: TCustomBitBtn; const AValue: Integer); override; 62 class procedure SetText(const AWinControl: TWinControl; const AText: String); override; 63 class procedure SetColor(const AWinControl: TWinControl); override; 64 class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override; 65 end; 66 TGtkWSBitBtnClass = class of TGtkWSBitBtn; 67 68 { TGtkWSSpeedButton } 69 70 TGtkWSSpeedButton = class(TWSSpeedButton) 71 published 72 end; 73 74implementation 75 76uses 77 GtkProc, GtkInt, GtkWSStdCtrls; 78 79const 80 GtkStateToButtonState: array[GTK_STATE_NORMAL..GTK_STATE_INSENSITIVE] of TButtonState = 81 ( 82{GTK_STATE_NORMAL } bsUp, 83{GTK_STATE_ACTIVE } bsDown, 84{GTK_STATE_PRELIGHT } bsHot, 85{GTK_STATE_SELECTED } bsDown, 86{GTK_STATE_INSENSITIVE} bsDisabled 87 ); 88 89type 90 TCustomBitBtnAccess = class(TCustomBitBtn) 91 end; 92 93procedure GtkWSBitBtn_StateChanged(AWidget: PGtkWidget; AState: TGtkStateType; AInfo: PWidgetInfo); cdecl; 94begin 95 //WriteLn(Astate, ' :: ', GTK_WIDGET_STATE(AWidget)); 96 TGtkWSBitBtnClass(TCustomBitBtn(AInfo^.LCLObject).WidgetSetClass).UpdateGlyph( 97 TBitBtn(AInfo^.LCLObject), 98 TCustomBitBtnAccess(AInfo^.LCLObject).FButtonGlyph, 99 GtkStateToButtonState[GTK_WIDGET_STATE(AWidget)]); 100end; 101 102{ TGtkWSBitBtn } 103 104{ 105 The interiour of TBitBtn is created with a 4X4 table 106 Depending in how the image and label are aligned, only a 107 columns or rows are used (like a 4x1 or 1x4 table). 108 This way the table doesn't have to be recreated on changes. 109 So there are 4 positions 0, 1, 2, 3. 110 Positions 1 and 2 are used for the label and image. 111 Since this is always the case, spacing can be implemented 112 by setting the spacing of row/col 1 113 To get a margin, a gtkInvisible is needed for bottom and 114 right, so the invisible is always in position 3. 115} 116class function TGtkWSBitBtn.CreateHandle(const AWinControl: TWinControl; 117 const AParams: TCreateParams): TLCLIntfHandle; 118var 119 BitBtn: TCustomBitBtn; 120 WidgetInfo: PWidgetInfo; 121 BitBtnInfo: PBitBtnWidgetInfo; 122 Allocation: TGTKAllocation; 123begin 124 BitBtn := AWinControl as TCustomBitBtn; 125 126 Result := TLCLIntfHandle(PtrUInt(gtk_button_new)); 127 if Result = 0 then Exit; 128 {$IFDEF DebugLCLComponents} 129 DebugGtkWidgets.MarkCreated(Pointer(Result),dbgsName(AWinControl)); 130 {$ENDIF} 131 132 WidgetInfo := CreateWidgetInfo(Pointer(Result), BitBtn, AParams); 133 134 New(BitBtnInfo); 135 FillChar(BitBtnInfo^, SizeOf(BitBtnInfo^), 0); 136 WidgetInfo^.UserData := BitBtnInfo; 137 WidgetInfo^.DataOwner := True; 138 139 BitBtnInfo^.AlignWidget := gtk_alignment_new(0.5, 0.5, 0, 0); 140 gtk_container_add(Pointer(Result), BitBtnInfo^.AlignWidget); 141 142 BitBtnInfo^.TableWidget := gtk_table_new(4, 4, False); 143 gtk_container_add(BitBtnInfo^.AlignWidget, BitBtnInfo^.TableWidget); 144 145 BitBtnInfo^.LabelWidget := gtk_label_new('bitbtn'); 146 gtk_table_attach(BitBtnInfo^.TableWidget, BitBtnInfo^.LabelWidget, 147 2, 3, 0, 4, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 148 149 BitBtnInfo^.SpaceWidget := nil; 150 BitBtnInfo^.ImageWidget := nil; 151 152 gtk_widget_show(BitBtnInfo^.AlignWidget); 153 gtk_widget_show(BitBtnInfo^.TableWidget); 154 gtk_widget_show(BitBtnInfo^.LabelWidget); 155 156 Allocation.X := AParams.X; 157 Allocation.Y := AParams.Y; 158 Allocation.Width := AParams.Width; 159 Allocation.Height := AParams.Height; 160 gtk_widget_size_allocate(PGtkWidget(Result), @Allocation); 161 162 Set_RC_Name(AWinControl, PGtkWidget(Result)); 163 SetCallbacks(PGtkWidget(Result), WidgetInfo); 164end; 165 166class procedure TGtkWSBitBtn.SetGlyph(const ABitBtn: TCustomBitBtn; 167 const AValue: TButtonGlyph); 168begin 169 if not WSCheckHandleAllocated(ABitBtn, 'SetGlyph') 170 then Exit; 171 172 UpdateGlyph(ABitBtn, AValue, GtkStateToButtonState[GTK_WIDGET_STATE(PGtkWidget(ABitBtn.Handle))]); 173end; 174 175class procedure TGtkWSBitBtn.SetLayout(const ABitBtn: TCustomBitBtn; 176 const AValue: TButtonLayout); 177var 178 WidgetInfo: PWidgetInfo; 179 BitBtnInfo: PBitBtnWidgetInfo; 180begin 181 if not WSCheckHandleAllocated(ABitBtn, 'SetLayout') 182 then Exit; 183 184 WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle)); 185 BitBtnInfo := WidgetInfo^.UserData; 186 UpdateLayout(BitBtnInfo, AValue, ABitBtn.Margin); 187end; 188 189class procedure TGtkWSBitBtn.SetMargin(const ABitBtn: TCustomBitBtn; 190 const AValue: Integer); 191var 192 WidgetInfo: PWidgetInfo; 193 BitBtnInfo: PBitBtnWidgetInfo; 194begin 195 if not WSCheckHandleAllocated(ABitBtn, 'SetMargin') 196 then Exit; 197 198 WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle)); 199 BitBtnInfo := WidgetInfo^.UserData; 200 UpdateMargin(BitBtnInfo, ABitBtn.Layout, AValue); 201end; 202 203class procedure TGtkWSBitBtn.SetSpacing(const ABitBtn: TCustomBitBtn; 204 const AValue: Integer); 205var 206 WidgetInfo: PWidgetInfo; 207 BitBtnInfo: PBitBtnWidgetInfo; 208begin 209 if not WSCheckHandleAllocated(ABitBtn, 'SetSpacing') 210 then Exit; 211 212 WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle)); 213 BitBtnInfo := WidgetInfo^.UserData; 214 gtk_table_set_col_spacing(BitBtnInfo^.TableWidget, 1, AValue); 215 gtk_table_set_row_spacing(BitBtnInfo^.TableWidget, 1, AValue); 216end; 217 218class procedure TGtkWSBitBtn.SetText(const AWinControl: TWinControl; 219 const AText: String); 220var 221 WidgetInfo: PWidgetInfo; 222 BitBtnInfo: PBitBtnWidgetInfo; 223begin 224 if not WSCheckHandleAllocated(AWincontrol, 'SetText') 225 then Exit; 226 227 WidgetInfo := GetWidgetInfo(Pointer(AWinControl.Handle)); 228 BitBtnInfo := WidgetInfo^.UserData; 229 230 if AText = '' then 231 begin 232 gtk_container_remove(BitBtnInfo^.TableWidget, BitBtnInfo^.LabelWidget); 233 BitBtnInfo^.LabelWidget := nil; 234 end 235 else 236 begin 237 if BitBtnInfo^.LabelWidget = nil then 238 begin 239 BitBtnInfo^.LabelWidget := gtk_label_new(nil); 240 gtk_widget_show(BitBtnInfo^.LabelWidget); 241 end; 242 243 GtkWidgetSet.SetLabelCaption(BitBtnInfo^.LabelWidget, AText 244 {$IFDEF Gtk1},AWinControl,WidgetInfo^.CoreWidget, 'clicked'{$ENDIF}); 245 end; 246 247 UpdateLayout(BitBtnInfo, TBitBtn(AWincontrol).Layout, TBitBtn(AWincontrol).Margin); 248end; 249 250class procedure TGtkWSBitBtn.SetColor(const AWinControl: TWinControl); 251var 252 Widget: PGTKWidget; 253begin 254 if not AWinControl.HandleAllocated then exit; 255 Widget:= PGtkWidget(AWinControl.Handle); 256 GtkWidgetSet.SetWidgetColor(Widget, clNone, AWinControl.color, 257 [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); 258end; 259 260class procedure TGtkWSBitBtn.SetFont(const AWinControl: TWinControl; 261 const AFont: TFont); 262var 263 WidgetInfo: PWidgetInfo; 264 BitBtnInfo: PBitBtnWidgetInfo; 265 Widget: PGTKWidget; 266begin 267 if not AWinControl.HandleAllocated then exit; 268 269 Widget:= PGtkWidget(AWinControl.Handle); 270 WidgetInfo := GetWidgetInfo(Widget); 271 BitBtnInfo := WidgetInfo^.UserData; 272 273 if (BitBtnInfo=nil) or (BitBtnInfo^.LabelWidget = nil) then Exit; 274 GtkWidgetSet.SetWidgetColor(BitBtnInfo^.LabelWidget, AFont.Color, 275 clNone, 276 [GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]); 277 GtkWidgetSet.SetWidgetFont(BitBtnInfo^.LabelWidget, AFont); 278end; 279 280class procedure TGtkWSBitBtn.UpdateGlyph(const ABitBtn: TCustomBitBtn; 281 const AValue: TButtonGlyph; const AButtonState: TButtonState); 282var 283 WidgetInfo: PWidgetInfo; 284 BitBtnInfo: PBitBtnWidgetInfo; 285 GDIObject: PGDIObject; 286 Pixmap: PGdkPixmap; 287 Pixbuf: PGdkPixbuf; 288 Mask: PGdkBitmap; 289 AGlyph: TBitmap; 290 AIndex, aPPI: Integer; 291 AEffect: TGraphicsDrawEffect; 292 aCanvasScaleFactor: Double; 293 ImgResolution: TScaledImageListResolution; 294begin 295 WidgetInfo := GetWidgetInfo(Pointer(ABitBtn.Handle)); 296 BitBtnInfo := WidgetInfo^.UserData; 297 298 if ABitBtn.CanShowGlyph then 299 begin 300 AGlyph := TBitmap.Create; 301 AValue.GetImageIndexAndEffect(AButtonState, aPPI, aCanvasScaleFactor, 302 ImgResolution, AIndex, AEffect); 303 if (AIndex <> -1) and (AValue.Images <> nil) then 304 AValue.Images.GetBitmap(AIndex, AGlyph, AEffect); 305 end 306 else 307 AGlyph := nil; 308 309 // check if an image is needed 310 if (AGlyph = nil) or AGlyph.Empty 311 then begin 312 if BitBtnInfo^.ImageWidget <> nil 313 then begin 314 gtk_container_remove(BitBtnInfo^.TableWidget, BitBtnInfo^.ImageWidget); 315 BitBtnInfo^.ImageWidget := nil; 316 end; 317 AGlyph.Free; 318 Exit; 319 end; 320 321 GDIObject := PGDIObject(AGlyph.Handle); 322 if GDIObject^.GDIBitmapType = gbPixbuf then 323 begin 324 Pixbuf := GDIObject^.GDIPixbufObject; 325 Pixmap := nil; 326 Mask := nil; 327 gdk_pixbuf_render_pixmap_and_mask(Pixbuf, Pixmap, Mask, $80); 328 end 329 else 330 begin 331 Pixmap := GDIObject^.GDIPixmapObject.Image; 332 Mask := CreateGdkMaskBitmap(AGlyph.Handle, AGlyph.MaskHandle); 333 end; 334 // check for image 335 if BitBtnInfo^.ImageWidget = nil 336 then begin 337 BitBtnInfo^.ImageWidget := gtk_pixmap_new(Pixmap, Mask); 338 gtk_widget_show(BitBtnInfo^.ImageWidget); 339 UpdateLayout(BitBtnInfo, ABitBtn.Layout, ABitBtn.Margin); 340 end 341 else 342 gtk_pixmap_set(BitBtnInfo^.ImageWidget, Pixmap, Mask); 343 344 gdk_pixmap_unref(Mask); 345 if Pixmap <> GDIObject^.GDIPixmapObject.Image then 346 gdk_pixmap_unref(Pixmap); 347 AGlyph.Free; 348end; 349 350class procedure TGtkWSBitBtn.UpdateLayout(const AInfo: PBitBtnWidgetInfo; 351 const ALayout: TButtonLayout; const AMargin: Integer); 352begin 353 if (AInfo^.ImageWidget = nil) and (AMargin < 0) then Exit; // nothing to do 354 355 // add references and remove it from the table 356 if AInfo^.LabelWidget <> nil then 357 begin 358 gtk_object_ref(AInfo^.LabelWidget); 359 if PGtkWidget(AInfo^.LabelWidget)^.Parent <> nil then 360 gtk_container_remove(AInfo^.TableWidget, AInfo^.LabelWidget); 361 end; 362 if AInfo^.ImageWidget <> nil then 363 begin 364 gtk_object_ref(AInfo^.ImageWidget); 365 if PGtkWidget(AInfo^.ImageWidget)^.Parent <> nil then 366 gtk_container_remove(AInfo^.TableWidget, AInfo^.ImageWidget); 367 end; 368 if AInfo^.SpaceWidget <> nil then 369 begin 370 gtk_object_ref(AInfo^.SpaceWidget); 371 if PGtkWidget(AInfo^.SpaceWidget)^.Parent <> nil then 372 gtk_container_remove(AInfo^.TableWidget, AInfo^.SpaceWidget); 373 end; 374 375 if ((AInfo^.LabelWidget = nil) or (PGtkLabel(AInfo^.LabelWidget)^.{$ifdef gtk1}thelabel{$else}text{$endif} = '')) and 376 (AInfo^.ImageWidget <> nil) then 377 begin 378 gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 379 0, 3, 0, 3, GTK_EXPAND or GTK_FILL, GTK_EXPAND or GTK_FILL, 0, 0); 380 end 381 else 382 case ALayout of 383 blGlyphLeft: 384 begin 385 if AInfo^.ImageWidget <> nil then 386 gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 387 1, 2, 1, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 388 gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 389 2, 3, 1, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 390 end; 391 blGlyphRight: 392 begin 393 gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 394 1, 2, 1, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 395 if AInfo^.ImageWidget <> nil then 396 gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 397 2, 3, 1, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 398 if AInfo^.SpaceWidget <> nil then 399 gtk_table_attach(AInfo^.TableWidget, AInfo^.SpaceWidget, 400 3, 4, 1, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 401 end; 402 blGlyphTop: 403 begin 404 if AInfo^.ImageWidget <> nil then 405 gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 406 1, 3, 1, 2, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 407 gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 408 1, 3, 2, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 409 end; 410 blGlyphBottom: 411 begin 412 gtk_table_attach(AInfo^.TableWidget, AInfo^.LabelWidget, 413 1, 3, 1, 2, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 414 if AInfo^.ImageWidget <> nil then 415 gtk_table_attach(AInfo^.TableWidget, AInfo^.ImageWidget, 416 1, 3, 2, 3, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 417 if AInfo^.SpaceWidget <> nil then 418 gtk_table_attach(AInfo^.TableWidget, AInfo^.SpaceWidget, 419 1, 3, 3, 4, GTK_SHRINK or GTK_FILL, GTK_SHRINK or GTK_FILL, 0, 0); 420 end; 421 end; 422 423 // remove temp reference 424 if AInfo^.SpaceWidget <> nil then 425 gtk_object_unref(AInfo^.SpaceWidget); 426 if AInfo^.ImageWidget <> nil then 427 gtk_object_unref(AInfo^.ImageWidget); 428 if AInfo^.LabelWidget <> nil then 429 gtk_object_unref(AInfo^.LabelWidget); 430 431 if AMargin >= 0 then 432 UpdateMargin(AInfo, ALayout, AMargin) 433end; 434 435class procedure TGtkWSBitBtn.UpdateMargin(const AInfo: PBitBtnWidgetInfo; 436 const ALayout: TButtonLayout; const AMargin: Integer); 437begin 438 if AMargin < 0 439 then begin 440 if AInfo^.SpaceWidget <> nil 441 then begin 442 gtk_container_remove(AInfo^.TableWidget, AInfo^.SpaceWidget); 443 AInfo^.SpaceWidget := nil; 444 445 gtk_alignment_set(AInfo^.AlignWidget, 0.5, 0.5, 0, 0); 446 447 case ALayout of 448 blGlyphLeft: gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0); 449 blGlyphRight: gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0); 450 blGlyphTop: gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0); 451 blGlyphBottom: gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0); 452 end; 453 end; 454 end 455 else begin 456 if (AInfo^.SpaceWidget = nil) 457 and (ALayout in [blGlyphRight, blGlyphBottom]) 458 then begin 459 {$IFDEF gtk1} 460 AInfo^.SpaceWidget := gtk_invisible_new; 461 {$ELSE} 462 // do not use gtk_invisible_new - it cannot have parent 463 AInfo^.SpaceWidget := gtk_image_new; 464 {$ENDIF} 465 UpdateLayout(AInfo, ALayout, AMargin); 466 end 467 else begin 468 case ALayout of 469 blGlyphLeft: begin 470 gtk_alignment_set(AInfo^.AlignWidget, 0, 0.5, 0, 0); 471 gtk_table_set_col_spacing(AInfo^.TableWidget, 0, AMargin); 472 gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0); 473 gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0); 474 gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0); 475 end; 476 blGlyphRight: begin 477 gtk_alignment_set(AInfo^.AlignWidget, 1, 0.5, 0, 0); 478 gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0); 479 gtk_table_set_col_spacing(AInfo^.TableWidget, 2, AMargin); 480 gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0); 481 gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0); 482 end; 483 blGlyphTop: begin 484 gtk_alignment_set(AInfo^.AlignWidget, 0.5, 0, 0, 0); 485 gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0); 486 gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0); 487 gtk_table_set_row_spacing(AInfo^.TableWidget, 0, AMargin); 488 gtk_table_set_row_spacing(AInfo^.TableWidget, 2, 0); 489 end; 490 blGlyphBottom: begin 491 gtk_alignment_set(AInfo^.AlignWidget, 0.5, 1, 0, 0); 492 gtk_table_set_col_spacing(AInfo^.TableWidget, 0, 0); 493 gtk_table_set_col_spacing(AInfo^.TableWidget, 2, 0); 494 gtk_table_set_row_spacing(AInfo^.TableWidget, 0, 0); 495 gtk_table_set_row_spacing(AInfo^.TableWidget, 2, AMargin); 496 end; 497 end; 498 end; 499 end; 500end; 501 502class procedure TGtkWSBitBtn.SetCallbacks(const AGtkWidget: PGtkWidget; 503 const AWidgetInfo: PWidgetInfo); 504begin 505 TGtkWSButton.SetCallbacks(AGtkWidget, AWidgetInfo); 506 507 SignalConnect(AGtkWidget, 'state-changed', @GtkWSBitBtn_StateChanged, AWidgetInfo); 508end; 509 510end. 511