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