1{ 2 ***************************************************************************** 3 * Gtk2WSForms.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 Gtk2WSForms; 17 18{$mode objfpc}{$H+} 19{$I gtk2defines.inc} 20interface 21 22uses 23 // RTL 24 Gtk2, Glib2, Gdk2, Gdk2Pixbuf, 25 {$IFDEF HASX} 26 Gdk2x, X, XLib, 27 {$ENDIF} 28 Math, types, Classes, 29 // LCL 30 LCLType, Controls, LMessages, InterfaceBase, Graphics, Forms, 31 Gtk2Int, Gtk2Proc, Gtk2Def, Gtk2Extra, Gtk2Globals, Gtk2WSControls, 32 WSForms, WSProc, 33 // LazUtils 34 LazLoggerBase; 35 36type 37 38 { TGtk2WSScrollingWinControl } 39 40 TGtk2WSScrollingWinControl = class(TWSScrollingWinControl) 41 protected 42 class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; 43 published 44 class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 45 class procedure SetColor(const AWinControl: TWinControl); override; 46 end; 47 48 { TGtk2WSScrollBox } 49 50 TGtk2WSScrollBox = class(TWSScrollBox) 51 published 52 end; 53 54 { TGtk2WSCustomFrame } 55 56 TGtk2WSCustomFrame = class(TWSCustomFrame) 57 published 58 end; 59 60 { TGtk2WSFrame } 61 62 TGtk2WSFrame = class(TWSFrame) 63 published 64 end; 65 66 { TGtk2WSCustomForm } 67 68 TGtk2WSCustomForm = class(TWSCustomForm) 69 protected 70 class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; 71 published 72 class function CanFocus(const AWinControl: TWinControl): Boolean; override; 73 class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 74 class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override; 75 class procedure SetIcon(const AForm: TCustomForm; const Small, Big: HICON); override; 76 class procedure SetAlphaBlend(const ACustomForm: TCustomForm; 77 const AlphaBlend: Boolean; const Alpha: Byte); override; 78 class procedure SetFormBorderStyle(const AForm: TCustomForm; 79 const AFormBorderStyle: TFormBorderStyle); override; 80 class procedure SetFormStyle(const AForm: TCustomform; const AFormStyle, 81 {%H-}AOldFormStyle: TFormStyle); override; 82 class procedure SetAllowDropFiles(const AForm: TCustomForm; AValue: Boolean); override; 83 class procedure SetShowInTaskbar(const AForm: TCustomForm; const AValue: TShowInTaskbar); override; 84 class procedure ShowHide(const AWinControl: TWinControl); override; 85 class procedure ShowModal(const {%H-}AForm: TCustomForm); override; 86 class procedure SetBorderIcons(const AForm: TCustomForm; 87 const ABorderIcons: TBorderIcons); override; 88 class procedure SetColor(const AWinControl: TWinControl); override; 89 class procedure SetRealPopupParent(const ACustomForm: TCustomForm; 90 const APopupParent: TCustomForm); override; 91 end; 92 93 { TGtk2WSForm } 94 95 TGtk2WSForm = class(TWSForm) 96 published 97 end; 98 99 { TGtk2WSHintWindow } 100 101 TGtk2WSHintWindow = class(TWSHintWindow) 102 protected 103 class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual; 104 published 105 class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override; 106 class procedure ShowHide(const AWinControl: TWinControl); override; 107 end; 108 109 { TGtk2WSScreen } 110 111 TGtk2WSScreen = class(TWSScreen) 112 published 113 end; 114 115 { TGtk2WSApplicationProperties } 116 117 TGtk2WSApplicationProperties = class(TWSApplicationProperties) 118 published 119 end; 120 121implementation 122 123{ TGtk2WSCustomForm } 124 125function gtk2WSDelayedWindowStateChange(Data: Pointer): gboolean; cdecl; 126var 127 AnForm: TCustomForm absolute data; 128 AEvent: TGdkEventWindowState; 129begin 130 Result := False; 131 AEvent := GetWidgetInfo({%H-}PGtkWidget(AnForm.Handle))^.FormWindowState; 132 GTKWindowStateEventCB({%H-}PGtkWidget(AnForm.Handle), @AEvent, Data); 133 // remove idle handler, because in fast switching hide/show there could 134 // be dozen of added idle handlers, only one should be here. 135 // also reset our internal flag on send_event. 136 GetWidgetInfo({%H-}PGtkWidget(AnForm.Handle))^.FormWindowState.send_event := 0; 137 g_idle_remove_by_data(Data); 138end; 139 140function Gtk2FormEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl; 141var 142 ACtl: TWinControl; 143 Mess : TLMessage; 144 WInfo: PWidgetInfo; 145 X,Y: integer; 146 {$IFDEF HASX} 147 XDisplay: PDisplay; 148 Window: TWindow; 149 RevertStatus: Integer; 150 winX, winY, winW, winH: gint; 151 {$ENDIF} 152 153begin 154 Result := CallBackDefaultReturn; 155 case event^._type of 156 GDK_CONFIGURE: 157 begin 158 {fixes multiple resize events. See comments on 159 http://bugs.freepascal.org/view.php?id=17015} 160 ACtl := TWinControl(Data); 161 GetWidgetRelativePosition({%H-}PGtkWidget(ACtl.Handle), X, Y); 162 Result := (event^.configure.send_event = 1) and 163 not ((X <> ACtl.Left) or (Y <> ACtl.Top)); 164 165 {$IFDEF HASX} 166 // fix for buggy compiz. 167 // see http://bugs.freepascal.org/view.php?id=17523 168 if Gtk2WidgetSet.compositeManagerRunning then 169 begin 170 // issue #25473, compositing manager eg. Mutter (Mint 16) makes 171 // complete mess with lcl<->gtk2<->x11 when our form is designed. 172 if (csDesigning in ACtl.ComponentState) and 173 // issue #26349.This patch is related only to Mint window manager ! 174 (Copy(Gtk2WidgetSet.GetWindowManager,1,6) = 'mutter') then 175 begin 176 gdk_window_get_geometry(event^.configure.window, @winX, @winY, @winW, @winH, nil); 177 if (winW <> event^.configure.width) or (winH <> event^.configure.height) then 178 begin 179 // goto hell 180 {$IF DEFINED(VerboseSizeMsg) OR DEFINED(VerboseGetClientRect)} 181 DebugLn('Warning: GDK_CONFIGURE: Designed form is misconfigured because of bad compositing manager (see issue #25473).'); 182 DebugLn('Warning: GDK_CONFIGURE: Fixing problem by setting current LCL values ',dbgs(ACtl.BoundsRect)); 183 {$ENDIF} 184 Result := True; 185 gdk_window_move_resize(event^.configure.window, ACtl.Left, ACtl.Top, ACtl.Width, ACtl.Height); 186 exit; 187 end; 188 end; 189 if (X <> ACtl.Left) or (Y <> ACtl.Top) then 190 Result := gtkconfigureevent(widget, PGdkEventConfigure(event), 191 Data) 192 else 193 Result := False; 194 end; 195 {$ENDIF} 196 end; 197 GDK_WINDOW_STATE: 198 begin 199 200 if (GDK_WINDOW_STATE_WITHDRAWN and event^.window_state.changed_mask) = 1 then 201 exit; 202 203 {$IFDEF HASX} 204 WInfo := GetWidgetInfo(Widget); 205 if (event^.window_state.new_window_state = GDK_WINDOW_STATE_ICONIFIED) then 206 begin 207 if not Gtk2WidgetSet.IsCurrentDesktop(event^.window_state.window) then 208 begin 209 WInfo := GetWidgetInfo(Widget); 210 if (WInfo <> nil) and (WInfo^.LCLObject = Application.MainForm) then 211 begin 212 g_object_set_data(PGObject(Widget), 'lclhintrestore', Pointer(1)); 213 GTK2WidgetSet.HideAllHints; 214 WInfo^.FormWindowState := Event^.window_state; 215 exit; 216 end; 217 end; 218 end; 219 if (event^.window_state.new_window_state <> GDK_WINDOW_STATE_ICONIFIED) and 220 (WInfo <> nil) and (WInfo^.LCLObject = Application.MainForm) and 221 (event^.window_state.changed_mask = GDK_WINDOW_STATE_ICONIFIED) and 222 (WInfo^.FormWindowState.new_window_state = GDK_WINDOW_STATE_ICONIFIED) and 223 (g_object_get_data(PGObject(Widget), 'lclhintrestore') <> nil) then 224 begin 225 g_object_set_data(PGObject(Widget), 'lclhintrestore', nil); 226 Gtk2WidgetSet.RestoreAllHints; 227 WInfo^.FormWindowState := Event^.window_state; 228 exit; 229 end; 230 {$ELSE} 231 WInfo := GetWidgetInfo(Widget); 232 {$ENDIF} 233 if (WInfo <> nil) then 234 begin 235 if (WInfo^.FormWindowState.new_window_state <> event^.window_state.new_window_state) 236 and (WInfo^.FormWindowState.send_event <> 2) then 237 begin 238 WInfo^.FormWindowState := Event^.window_state; 239 // needed to lock recursions, normally send_event can be 0 or 1 240 // we add 2 to know if recursion occurred. 241 WInfo^.FormWindowState.send_event := 2; 242 g_idle_add(@gtk2WSDelayedWindowStateChange, Data); 243 end else 244 begin 245 // our send_event flag is 2, mean recursion occurred 246 // so we have to normalize things first. 247 while WInfo^.FormWindowState.send_event = 2 do 248 begin 249 Application.Idle(True); 250 Application.ProcessMessages; 251 end; 252 WInfo^.FormWindowState.send_event := 0; 253 Result := GTKWindowStateEventCB(Widget, @event^.window_state, Data); 254 end; 255 end; 256 end; 257 GDK_ENTER_NOTIFY: 258 begin 259 FillChar(Mess{%H-}, SizeOf(Mess), #0); 260 Mess.msg := LM_MOUSEENTER; 261 DeliverMessage(Data, Mess); 262 end; 263 GDK_LEAVE_NOTIFY: 264 begin 265 FillChar(Mess, SizeOf(Mess), #0); 266 Mess.msg := LM_MOUSELEAVE; 267 DeliverMessage(Data, Mess); 268 end; 269 GDK_FOCUS_CHANGE: 270 begin 271 ACtl := TWinControl(Data); 272 if PGdkEventFocus(event)^._in = 0 then 273 begin 274 {$IFDEF HASX} 275 XDisplay := gdk_display; 276 XGetInputFocus(XDisplay, @Window, @RevertStatus); 277 // Window - 1 is our frame ! 278 if (RevertStatus = RevertToParent) and 279 (GDK_WINDOW_XID(Widget^.Window) = Window - 1) then 280 exit(True); 281 {$ENDIF} 282 with Gtk2WidgetSet do 283 begin 284 LastFocusOut := {%H-}PGtkWidget(ACtl.Handle); 285 if LastFocusOut = LastFocusIn then 286 StartFocusTimer; 287 end; 288 end else 289 begin 290 with Gtk2WidgetSet do 291 begin 292 LastFocusIn := {%H-}PGtkWidget(ACtl.Handle); 293 if not AppActive then 294 AppActive := True; 295 end; 296 end; 297 if GTK_IS_WINDOW(Widget) and 298 (g_object_get_data({%H-}PGObject(ACtl.Handle),'lcl_nonmodal_over_modal') <> nil) then 299 begin 300 if PGdkEventFocus(event)^._in = 0 then 301 gtk_window_set_modal({%H-}PGtkWindow(ACtl.Handle), False) 302 else 303 gtk_window_set_modal({%H-}PGtkWindow(ACtl.Handle), True); 304 end; 305 end; 306 end; 307end; 308 309class procedure TGtk2WSCustomForm.SetCallbacks(const AWidget: PGtkWidget; 310 const AWidgetInfo: PWidgetInfo); 311begin 312 TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject)); 313 if (TWinControl(AWidgetInfo^.LCLObject).Parent = nil) and (TWinControl(AWidgetInfo^.LCLObject).ParentWindow = 0) then 314 with TGTK2WidgetSet(Widgetset) do 315 begin 316 {$IFDEF HASX} 317 // fix for buggy compiz. 318 // see http://bugs.freepascal.org/view.php?id=17523 319 if not compositeManagerRunning then 320 {$ENDIF} 321 SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 322 SetCallback(LM_CLOSEQUERY, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 323 SetCallBack(LM_ACTIVATE, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 324 if (gtk_major_version = 2) and (gtk_minor_version <= 8) then 325 begin 326 SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 327 SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 328 end; 329 end; 330 331 g_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget), 'event', 332 gtk_signal_func(@Gtk2FormEvent), AWidgetInfo^.LCLObject); 333end; 334 335class function TGtk2WSCustomForm.CanFocus(const AWinControl: TWinControl 336 ): Boolean; 337var 338 Widget: PGtkWidget; 339begin 340 if AWinControl.HandleAllocated then 341 begin 342 Widget := {%H-}PGtkWidget(AWinControl.Handle); 343 Result := GTK_WIDGET_VISIBLE(Widget) and GTK_WIDGET_SENSITIVE(Widget); 344 end else 345 Result := False; 346end; 347 348class function TGtk2WSCustomForm.CreateHandle(const AWinControl: TWinControl; 349 const AParams: TCreateParams): TLCLIntfHandle; 350var 351 WidgetInfo: PWidgetInfo; 352 p: pointer; // ptr to the newly created GtkWidget 353 Box: Pointer; 354 ABorderStyle: TFormBorderStyle; 355 WindowType: TGtkWindowType; 356 ACustomForm: TCustomForm; 357 AResizable: gint; 358 Allocation: TGtkAllocation; 359begin 360 // Start of old CreateForm method 361 ACustomForm := TCustomForm(AWinControl); 362 363 if (AParams.Style and WS_CHILD) = 0 then 364 begin 365 if csDesigning in ACustomForm.ComponentState then 366 ABorderStyle := bsSizeable 367 else 368 ABorderStyle := ACustomForm.BorderStyle; 369 end 370 else 371 ABorderStyle := bsNone; 372 373 // Maps the border style 374 WindowType := FormStyleMap[ABorderStyle]; 375 if (csDesigning in ACustomForm.ComponentState) then 376 WindowType := GTK_WINDOW_TOPLEVEL; 377 378 if (AParams.Style and WS_CHILD) = 0 then 379 begin 380 // create a floating form 381 P := gtk_window_new(WindowType); 382 383 // This is done with the expectation to avoid the button blinking for forms 384 //that hide it, but currently it doesn't seem to make a difference. 385 gtk_window_set_skip_taskbar_hint(P, True); 386 387 if (ABorderStyle = bsNone) and (ACustomForm.FormStyle in fsAllStayOnTop) then 388 gtk_window_set_decorated(PGtkWindow(P), False); 389 390 // Sets the window as resizable or not 391 // Depends on the WM supporting this 392 if (csDesigning in ACustomForm.ComponentState) then 393 AResizable := 1 394 else 395 AResizable := FormResizableMap[ABorderStyle]; 396 397 // gtk_window_set_policy is deprecated in Gtk2 398 gtk_window_set_resizable(GTK_WINDOW(P), gboolean(AResizable)); 399 400 // Sets the title 401 gtk_window_set_title(PGtkWindow(P), AParams.Caption); 402 403 if (AParams.WndParent <> 0) then 404 gtk_window_set_transient_for(PGtkWindow(P), {%H-}PGtkWindow(AParams.WndParent)) 405 else 406 if not (csDesigning in ACustomForm.ComponentState) and 407 (ACustomForm.FormStyle in fsAllStayOnTop) then 408 gtk_window_set_keep_above(PGtkWindow(P), gboolean(True)); 409 410 // the clipboard needs a widget 411 if (ClipboardWidget = nil) then 412 Gtk2WidgetSet.SetClipboardWidget(P); 413 end 414 else 415 begin 416 // create a form as child control 417 P := gtk_hbox_new(false, 0); 418 end; 419 420{$IFDEF HASX} 421 if (AWinControl = Application.MainForm) and 422 not Application.HasOption('disableaccurateframe') then 423 Gtk2WidgetSet.CreateDummyWidgetFrame(-1, -1, -1, -1); 424{$ENDIF} 425 426 WidgetInfo := CreateWidgetInfo(P, AWinControl, AParams); 427 WidgetInfo^.FormBorderStyle := Ord(ABorderStyle); 428 429 FillChar(WidgetInfo^.FormWindowState, SizeOf(WidgetInfo^.FormWindowState), #0); 430 WidgetInfo^.FormWindowState.new_window_state := GDK_WINDOW_STATE_WITHDRAWN; 431 432 Box := CreateFormContents(ACustomForm, P, WidgetInfo); 433 gtk_container_add(PGtkContainer(P), Box); 434 435 //so we can double buffer ourselves, eg, the Form Designer 436 if csDesigning in AWinControl.ComponentState then 437 gtk_widget_set_double_buffered(Box, False); 438 439 gtk_widget_show(Box); 440 441 // main menu 442 if (ACustomForm.Menu <> nil) and (ACustomForm.Menu.HandleAllocated) then 443 gtk_box_pack_start(Box, {%H-}PGtkWidget(ACustomForm.Menu.Handle), False, False,0); 444 445 // End of the old CreateForm method 446 447 {$IFNDEF NoStyle} 448 if (AParams.Style and WS_CHILD) = 0 then 449 gtk_widget_set_app_paintable(P, True); 450 {$ENDIF} 451 452 if not (csDesigning in AWinControl.ComponentState) then 453 WidgetInfo^.UserData := Pointer(1); 454 455 Allocation.X := AParams.X; 456 Allocation.Y := AParams.Y; 457 Allocation.Width := AParams.Width; 458 Allocation.Height := AParams.Height; 459 gtk_widget_size_allocate(P, @Allocation); 460 461 {$IFDEF DebugLCLComponents} 462 DebugGtkWidgets.MarkCreated(P, dbgsName(AWinControl)); 463 {$ENDIF} 464 Result := TLCLIntfHandle({%H-}PtrUInt(P)); 465 Set_RC_Name(AWinControl, P); 466 SetCallbacks(P, WidgetInfo); 467end; 468 469function Gtk2WSDelayRedraw(Data: Pointer): GBoolean; cdecl; 470begin 471 Result := False; 472 gtk_widget_queue_draw(PWidgetInfo(Data)^.ClientWidget); 473 g_idle_remove_by_data(Data); 474end; 475 476class procedure TGtk2WSCustomForm.ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); 477var 478 Layout: PGtkLayout; 479 WidgetInfo: PWidgetInfo; 480 Adjustment: PGtkAdjustment; 481 h, v: Double; 482 NewPos: Double; 483begin 484 if not AWinControl.HandleAllocated then exit; 485 WidgetInfo := GetWidgetInfo({%H-}PGtkWidget(AWinControl.Handle)); 486 Layout := PGtkLayout(WidgetInfo^.ClientWidget); 487 Adjustment := gtk_layout_get_hadjustment(Layout); 488 if Adjustment <> nil then 489 begin 490 h := gtk_adjustment_get_value(Adjustment); 491 NewPos := Adjustment^.upper - Adjustment^.page_size; 492 if h - DeltaX <= NewPos then 493 NewPos := h - DeltaX; 494 if gtk_adjustment_get_value(Adjustment) <> NewPos then 495 begin 496 gtk_adjustment_set_value(Adjustment, NewPos); 497 //if our adjustment reached end, scrollbar button is disabled 498 //so gtk blocks paints for some reason, so we must postpone an update 499 if NewPos >= Adjustment^.upper - Adjustment^.page_size then 500 g_idle_add(@Gtk2WSDelayRedraw, WidgetInfo); 501 end; 502 end; 503 Adjustment := gtk_layout_get_vadjustment(Layout); 504 if Adjustment <> nil then 505 begin 506 v := gtk_adjustment_get_value(Adjustment); 507 NewPos := Adjustment^.upper - Adjustment^.page_size; 508 if v - DeltaY <= NewPos then 509 NewPos := v - DeltaY; 510 if gtk_adjustment_get_value(Adjustment) <> NewPos then 511 begin 512 gtk_adjustment_set_value(Adjustment, NewPos); 513 //if our adjustment reached end, scrollbar button is disabled 514 //so gtk blocks paints for some reason, so we must postpone an update 515 if NewPos >= Adjustment^.upper - Adjustment^.page_size then 516 g_idle_add(@Gtk2WSDelayRedraw, WidgetInfo); 517 end; 518 end; 519end; 520 521class procedure TGtk2WSCustomForm.SetIcon(const AForm: TCustomForm; 522 const Small, Big: HICON); 523 524 procedure SetSmallBigIcon; 525 var 526 List: PGList; 527 begin 528 List := nil; 529 if Small <> 0 then 530 List := g_list_append(List, {%H-}PGdkPixbuf(Small)); 531 if Big <> 0 then 532 List := g_list_append(List, {%H-}PGdkPixbuf(Big)); 533 gtk_window_set_icon_list({%H-}PGtkWindow(AForm.Handle), List); 534 if List <> nil 535 then g_list_free(List); 536 end; 537 538 {$IFDEF Gtk2SetIconAll} 539 procedure SetAllIcons; 540 var 541 List: PGList; 542 Icon: TIcon; 543 CurSize: Integer; 544 i: Integer; 545 LastIndex: Integer; 546 OldChange: TNotifyEvent; 547 OldCurrent: Integer; 548 IconHnd: HICON; 549 begin 550 List := nil; 551 //debugln(['TGtk2WSCustomForm.SetIcon Form=',DbgSName(AForm)]); 552 Icon:=AForm.Icon; 553 if (Icon=nil) or Icon.Empty then 554 Icon:=Application.Icon; 555 if Assigned(Icon) and not Icon.Empty then 556 begin 557 CurSize:=16; 558 OldChange:=Icon.OnChange; 559 OldCurrent:=Icon.Current; 560 Icon.OnChange := nil; 561 LastIndex:=-1; 562 while CurSize<=256 do begin 563 i:=Icon.GetBestIndexForSize(Size(CurSize,CurSize)); 564 if (i>=0) and (LastIndex<>i) then begin 565 Icon.Current := i; 566 IconHnd:=Icon.ReleaseHandle; 567 if IconHnd <> 0 then 568 List := g_list_append(List, {%H-}PGdkPixbuf(IconHnd)); 569 //debugln(['TGtk2WSCustomForm.SetIcon adding ',CurSize]); 570 LastIndex:=i; 571 end; 572 CurSize:=CurSize*2; 573 end; 574 Icon.Current:=OldCurrent; 575 Icon.OnChange:=OldChange; 576 end; 577 gtk_window_set_icon_list({%H-}PGtkWindow(AForm.Handle), List); 578 if List <> nil 579 then g_list_free(List); 580 end; 581 {$ENDIF} 582 583 {$IFDEF Gtk2SetIconFile} 584 procedure SetIconFromFile; 585 var 586 Filename: String; 587 begin 588 Filename:='test128x128.png'; 589 debugln(['SetIconFromFile filename=',Filename]); 590 gtk_window_set_icon_from_file({%H-}PGtkWindow(AForm.Handle),PGChar(Filename),null); 591 debugln(['SetIconFromFile prg name="',g_get_prgname,'"']); 592 end; 593 {$ENDIF} 594 595begin 596 if not WSCheckHandleAllocated(AForm, 'SetIcon') 597 then Exit; 598 599 if (AForm.Parent <> nil) or (AForm.ParentWindow <> 0) then Exit; 600 601 {$IFDEF Gtk2SetIconAll} 602 SetAllIcons; 603 {$ELSE} 604 {$IFDEF Gtk2SetIconFile} 605 SetIconFromFile; 606 {$ELSE} 607 SetSmallBigIcon; 608 {$ENDIF} 609 {$ENDIF} 610end; 611 612class procedure TGtk2WSCustomForm.SetAlphaBlend(const ACustomForm: TCustomForm; 613 const AlphaBlend: Boolean; const Alpha: Byte); 614begin 615 if not WSCheckHandleAllocated(ACustomForm, 'SetAlphaBlend') then 616 Exit; 617 if Assigned(gtk_window_set_opacity) and GTK_IS_WINDOW({%H-}PGtkWidget(ACustomForm.Handle)) then 618 if AlphaBlend then 619 gtk_window_set_opacity({%H-}PGtkWindow(ACustomForm.Handle), Alpha / 255) 620 else 621 gtk_window_set_opacity({%H-}PGtkWindow(ACustomForm.Handle), 1); 622end; 623 624class procedure TGtk2WSCustomForm.SetFormBorderStyle(const AForm: TCustomForm; 625 const AFormBorderStyle: TFormBorderStyle); 626var 627 Widget: PGtkWidget; 628 WidgetInfo: PWidgetInfo; 629 // WindowType: TGtkWindowType; 630 Resizable: gint; 631begin 632 if not WSCheckHandleAllocated(AForm, 'SetFormBorderStyle') then 633 exit; 634 if (csDesigning in AForm.ComponentState) then 635 exit; 636 637 Widget := {%H-}PGtkWidget(AForm.Handle); 638 WidgetInfo := GetWidgetInfo(Widget); 639 640 if (WidgetInfo^.FormBorderStyle <> Ord(AFormBorderStyle)) then 641 begin 642 if (AForm.Parent<>nil) then 643 begin 644 // a nested form 645 // at the moment the gtk interface does not support any border for this 646 end else if (AFormBorderStyle <> bsNone) then 647 begin 648 // the borderstyle can be only set on creation 649 RecreateWnd(AForm); 650 end else 651 begin 652 // TODO: set window hint WindowType := FormStyleMap[AFormBorderStyle]; 653 Resizable := FormResizableMap[AFormBorderStyle]; 654 if (AFormBorderStyle = bsNone) then 655 gtk_window_set_decorated(PGtkWindow(Widget), False); 656 gtk_window_set_resizable(GTK_WINDOW(Widget), gboolean(Resizable)); 657 WidgetInfo^.FormBorderStyle := Ord(AFormBorderStyle); 658 end; 659 end; 660end; 661 662class procedure TGtk2WSCustomForm.SetFormStyle(const AForm: TCustomform; 663 const AFormStyle, AOldFormStyle: TFormStyle); 664begin 665 if not WSCheckHandleAllocated(AForm, 'SetFormStyle') then 666 exit; 667 if (csDesigning in AForm.ComponentState) then 668 exit; 669 if GTK_IS_WINDOW({%H-}PGtkWindow(AForm.Handle)) then 670 gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle), 671 GBoolean(AFormStyle in fsAllStayOnTop)); 672end; 673 674class procedure TGtk2WSCustomForm.SetAllowDropFiles(const AForm: TCustomForm; 675 AValue: Boolean); 676begin 677 if AValue then 678 gtk_drag_dest_set({%H-}PGtkWidget(AForm.Handle), GTK_DEST_DEFAULT_ALL, 679 @FileDragTarget, 1, GDK_ACTION_COPY or GDK_ACTION_MOVE) 680 else 681 gtk_drag_dest_unset({%H-}PGtkWidget(AForm.Handle)); 682end; 683 684class procedure TGtk2WSCustomForm.SetShowInTaskbar(const AForm: TCustomForm; 685 const AValue: TShowInTaskbar); 686begin 687 if not WSCheckHandleAllocated(AForm, 'SetShowInTaskbar') 688 then Exit; 689 690 SetFormShowInTaskbar(AForm,AValue); 691end; 692 693class procedure TGtk2WSCustomForm.ShowHide(const AWinControl: TWinControl); 694var 695 {$IFDEF HASX} 696 TempGdkWindow: PGdkWindow; 697 {$ENDIF} 698 AForm, APopupParent: TCustomForm; 699 GtkWindow: PGtkWindow; 700 Geometry: TGdkGeometry; 701 702 function ShowNonModalOverModal: Boolean; 703 var 704 AForm: TCustomForm; 705 AWindow: PGtkWindow; 706 begin 707 Result := False; 708 AForm := TCustomForm(AWinControl); 709 if AWinControl.HandleObjectShouldBeVisible and 710 not (csDesigning in AForm.ComponentState) and 711 not (fsModal in AForm.FormState) and 712 (AForm.Parent = nil) and 713 (AForm.FormStyle <> fsMDIChild) and 714 (ModalWindows <> nil) and (ModalWindows.Count > 0) and 715 not (AForm.FormStyle in fsAllStayOnTop) and 716 (AForm.BorderStyle in [bsDialog, bsSingle, bsSizeable]) and 717 (AForm.PopupParent = nil) and (AForm.PopupMode = pmNone) then 718 begin 719 AWindow := {%H-}PGtkWindow(AForm.Handle); 720 gtk_window_set_modal(AWindow, True); 721 // lcl_nonmodal_over_modal is needed to track nonmodal form 722 // created and shown when we have active modal forms 723 g_object_set_data(PGObject(AWindow),'lcl_nonmodal_over_modal', AForm); 724 Result := True; 725 end; 726 end; 727begin 728 AForm := TCustomForm(AWinControl); 729 if not (csDesigning in AForm.ComponentState) then 730 begin 731 if AForm.HandleObjectShouldBeVisible and 732 GTK_IS_WINDOW({%H-}PGtkWindow(AForm.Handle)) then 733 begin 734 gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle), 735 GBoolean(AForm.FormStyle in fsAllStayOnTop)) 736 end 737 else 738 if (AForm.FormStyle in fsAllStayOnTop) and 739 not (csDestroying in AWinControl.ComponentState) then 740 gtk_window_set_keep_above({%H-}PGtkWindow(AForm.Handle), GBoolean(False)); 741 end; 742 743 GtkWindow := {%H-}PGtkWindow(AForm.Handle); 744 745 if (fsModal in AForm.FormState) and AForm.HandleObjectShouldBeVisible then 746 begin 747 gtk_window_set_default_size(GtkWindow, Max(1,AForm.Width), Max(1,AForm.Height)); 748 gtk_widget_set_uposition(PGtkWidget(GtkWindow), AForm.Left, AForm.Top); 749 gtk_window_set_type_hint({%H-}PGtkWindow(AForm.Handle), 750 GtkWindowTypeHints[AForm.BorderStyle]); 751 GtkWindowShowModal(AForm, GtkWindow); 752 end else 753 begin 754 if ShowNonModalOverModal then begin 755 // issue #21459 756 end 757 else if not GTK_IS_WINDOW(GtkWindow) then begin 758 // 759 end 760 else if (AForm.FormStyle <> fsMDIChild) and AForm.HandleObjectShouldBeVisible 761 and (ModalWindows <> nil) and (ModalWindows.Count > 0) 762 and (AForm.PopupParent = nil) and (AForm.BorderStyle = bsNone) 763 then begin 764 // showing a non modal form with bsNone above a modal form 765 gtk_window_set_transient_for(GtkWindow, nil); 766 gtk_window_set_modal(GtkWindow, True); 767 end else begin 768 // hiding/showing normal form 769 // clear former mods, e.g. when a modal form becomes a normal form, see bug 23876 770 {$IFDEF HASX} 771 gtk_window_set_modal(GtkWindow, False); 772 gtk_window_set_transient_for(GtkWindow, nil); //untransient 773 {$ELSE} 774 gtk_window_set_transient_for(GtkWindow, nil); //untransient 775 gtk_window_set_modal(GtkWindow, False); 776 {$ENDIF} 777 end; 778 779 {$IFDEF HASX} 780 // issue #26018 781 if AWinControl.HandleObjectShouldBeVisible and 782 not (csDesigning in AForm.ComponentState) and 783 not (AForm.FormStyle in fsAllStayOnTop) and 784 not (fsModal in AForm.FormState) and 785 (AForm.PopupMode = pmAuto) and 786 (AForm.BorderStyle = bsNone) and 787 (AForm.PopupParent = nil) then 788 begin 789 TempGdkWindow := {%H-}PGdkWindow(Gtk2WidgetSet.GetForegroundWindow); 790 if (TempGdkWindow <> nil) and (GdkWindowObject_modal_hint(GDK_WINDOW_OBJECT(TempGdkWindow)^) = 0) then 791 begin 792 if ((gdk_window_get_state(TempGdkWindow) and GDK_WINDOW_STATE_ABOVE) = GDK_WINDOW_STATE_ABOVE) or 793 GTK2WidgetSet.GetAlwaysOnTopX11(TempGdkWindow) then 794 gtk_window_set_keep_above(GtkWindow, True); 795 end; 796 end; 797 798 if AWinControl.HandleObjectShouldBeVisible and 799 not (csDesigning in AForm.ComponentState) and 800 not (AForm.FormStyle in fsAllStayOnTop) and 801 not (fsModal in AForm.FormState) then 802 begin 803 APopupParent := AForm.GetRealPopupParent; 804 if (APopupParent <> nil) then 805 SetRealPopupParent(AForm, APopupParent); 806 end; 807 {$ENDIF} 808 809 Gtk2WidgetSet.SetVisible(AWinControl, AForm.HandleObjectShouldBeVisible); 810 end; 811 812 if not (csDesigning in AForm.ComponentState) and 813 AForm.HandleObjectShouldBeVisible and 814 (AForm.BorderStyle in [bsDialog, bsSingle]) then 815 begin 816 // we must set fixed size, gtk_window_set_resizable does not work 817 // as expected for some reason.issue #20741 818 with Geometry do 819 begin 820 min_width := AForm.Width; 821 max_width := AForm.Width; 822 min_height := AForm.Height; 823 max_height := AForm.Height; 824 825 base_width := AForm.Width; 826 base_height := AForm.Height; 827 width_inc := 1; 828 height_inc := 1; 829 min_aspect := 0; 830 max_aspect := 1; 831 win_gravity := gtk_window_get_gravity(GtkWindow); 832 end; 833 //debugln('TGtk2WSWinControl.ConstraintsChange A ',GetWidgetDebugReport(Widget),' max=',dbgs(Geometry.max_width),'x',dbgs(Geometry.max_height)); 834 gtk_window_set_geometry_hints(GtkWindow, nil, @Geometry, 835 GDK_HINT_POS or GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE); 836 end; 837 838 if not (csDesigning in AForm.ComponentState) and 839 AForm.HandleObjectShouldBeVisible and (AForm.WindowState = wsFullScreen) then 840 gtk_window_fullscreen(GtkWindow); 841 842 843 InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect); 844end; 845 846class procedure TGtk2WSCustomForm.ShowModal(const AForm: TCustomForm); 847begin 848 // modal is started in ShowHide 849end; 850 851class procedure TGtk2WSCustomForm.SetBorderIcons(const AForm: TCustomForm; 852 const ABorderIcons: TBorderIcons); 853begin 854 if not WSCheckHandleAllocated(AForm, 'SetBorderIcons') 855 then Exit; 856 857 inherited SetBorderIcons(AForm, ABorderIcons); 858end; 859 860class procedure TGtk2WSCustomForm.SetColor(const AWinControl: TWinControl); 861var 862 AScrolled: PGtkWidget; 863 AColor: TColor; 864begin 865 TGtk2WSWinControl.SetColor(AWinControl); 866 867 // Forms: GtkWindow->GtkVBox->gtkScrolledWindow->GtkLayout 868 // we need to set the color of the GtkLayout so that the whole viewport 869 // will be filled (issue #16183) 870 AScrolled := g_object_get_data({%H-}PGObject(AWinControl.Handle), odnScrollArea); 871 if GTK_IS_SCROLLED_WINDOW(AScrolled) and 872 GTK_IS_LAYOUT({%H-}PGtkBin(AScrolled)^.child) then 873 begin 874 AColor := AWinControl.Color; 875 if AColor = clDefault then 876 AColor := GetDefaultColor(AWinControl, dctBrush); 877 Gtk2WidgetSet.SetWidgetColor({%H-}PGtkBin(AScrolled)^.child, 878 clNone, AColor, 879 [GTK_STATE_NORMAL, GTK_STATE_ACTIVE, 880 GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]); 881 end; 882end; 883 884class procedure TGtk2WSCustomForm.SetRealPopupParent( 885 const ACustomForm: TCustomForm; const APopupParent: TCustomForm); 886begin 887 if not WSCheckHandleAllocated(ACustomForm, 'SetRealPopupParent') then Exit; 888 889 if APopupParent <> nil then 890 gtk_window_set_transient_for({%H-}PGtkWindow(ACustomForm.Handle), {%H-}PGtkWindow(APopupParent.Handle)) 891 else 892 gtk_window_set_transient_for({%H-}PGtkWindow(ACustomForm.Handle), nil); 893end; 894 895 896{ TGtk2WSScrollingWinControl } 897 898class procedure TGtk2WSScrollingWinControl.SetCallbacks( 899 const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); 900var 901 UseScrollCallback: Boolean; 902begin 903 TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject)); 904 with TGTK2WidgetSet(Widgetset) do 905 begin 906 UseScrollCallBack := (gtk_major_version = 2) and (gtk_minor_version <= 8); 907 if UseScrollCallBack then 908 begin 909 SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 910 SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 911 end; 912 end; 913end; 914 915class function TGtk2WSScrollingWinControl.CreateHandle( 916 const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; 917var 918 Scrolled: PGtkScrolledWindow; 919 Layout: PGtkWidget; 920 WidgetInfo: PWidgetInfo; 921 Adjustment: PGtkAdjustment; 922begin 923 // create a gtk_scrolled_window for the scrollbars 924 Scrolled := PGtkScrolledWindow(gtk_scrolled_window_new(nil, nil)); 925 gtk_scrolled_window_set_shadow_type(Scrolled, 926 BorderStyleShadowMap[TScrollingWinControl(AWinControl).BorderStyle]); 927 928 GTK_WIDGET_UNSET_FLAGS(Scrolled^.hscrollbar, GTK_CAN_FOCUS); 929 GTK_WIDGET_UNSET_FLAGS(Scrolled^.vscrollbar, GTK_CAN_FOCUS); 930 gtk_scrolled_window_set_policy(Scrolled, GTK_POLICY_NEVER, GTK_POLICY_NEVER); 931 g_object_set_data(PGObject(Scrolled), odnScrollArea, Scrolled); 932 933 {$IFDEF DebugLCLComponents} 934 DebugGtkWidgets.MarkCreated(Scrolled, dbgsName(AWinControl)); 935 {$ENDIF} 936 937 WidgetInfo := CreateWidgetInfo(Scrolled, AWinControl, AParams); 938 939 Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled); 940 if Adjustment <> nil then 941 g_object_set_data(PGObject(Adjustment), odnScrollBar, Scrolled^.vscrollbar); 942 943 Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled); 944 if Adjustment <> nil then 945 g_object_set_data(PGObject(Adjustment), odnScrollBar, Scrolled^.hscrollbar); 946 947 // create a gtk_layout for the client area, so children can be added at 948 // free x,y positions and the scrollbars automatically scrolls the children 949 950 Layout := gtk_layout_new(nil, nil); 951 gtk_container_add(PGTKContainer(Scrolled), Layout); 952 gtk_widget_show(Layout); 953 SetFixedWidget(Scrolled, Layout); 954 SetMainWidget(Scrolled, Layout); 955 956 Result := TLCLIntfHandle({%H-}PtrUInt(Scrolled)); 957 958 Set_RC_Name(AWinControl, PGtkWidget(Scrolled)); 959 SetCallBacks(PGtkWidget(Scrolled), WidgetInfo); 960 if (gtk_major_version >= 2) and (gtk_minor_version > 8) then 961 begin 962 g_signal_connect(Scrolled^.hscrollbar, 'change-value', 963 TGCallback(@Gtk2RangeScrollCB), WidgetInfo); 964 g_signal_connect(Scrolled^.vscrollbar, 'change-value', 965 TGCallback(@Gtk2RangeScrollCB), WidgetInfo); 966 967 g_signal_connect(Scrolled^.hscrollbar, 'value-changed', 968 TGCallback(@Gtk2RangeValueChanged), WidgetInfo); 969 g_signal_connect(Scrolled^.vscrollbar, 'value-changed', 970 TGCallback(@Gtk2RangeValueChanged), WidgetInfo); 971 972 g_signal_connect(Scrolled^.hscrollbar, 'button-press-event', 973 TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo); 974 g_signal_connect(Scrolled^.hscrollbar, 'button-release-event', 975 TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo); 976 g_signal_connect(Scrolled^.vscrollbar, 'button-press-event', 977 TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo); 978 g_signal_connect(Scrolled^.vscrollbar, 'button-release-event', 979 TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo); 980 if (AWinControl is TScrollBox) then 981 g_signal_connect(Scrolled, 'scroll-event', 982 TGCallback(@Gtk2ScrolledWindowScrollCB), WidgetInfo); 983 end; 984end; 985 986class procedure TGtk2WSScrollingWinControl.SetColor(const AWinControl: TWinControl); 987var 988 AColor: TColor; 989begin 990 if not WSCheckHandleAllocated(AWinControl, 'SetColor') 991 then Exit; 992 993 // ScrollingWinControl: GtkScrolledWindow->GtkLayout 994 // we need to set the color of the GtkLayout so that the whole viewport 995 // will be filled (issue #16183) 996 AColor := AWinControl.Color; 997 if AColor = clDefault then 998 AColor := GetDefaultColor(AWinControl, dctBrush); 999 Gtk2WidgetSet.SetWidgetColor({%H-}PGtkBin(AWinControl.Handle)^.child, 1000 clNone, AColor, 1001 [GTK_STATE_NORMAL, GTK_STATE_ACTIVE, 1002 GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]); 1003end; 1004 1005{ TGtk2WSHintWindow } 1006 1007class procedure TGtk2WSHintWindow.SetCallbacks(const AWidget: PGtkWidget; 1008 const AWidgetInfo: PWidgetInfo); 1009begin 1010 TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject)); 1011 if (TControl(AWidgetInfo^.LCLObject).Parent = nil) then 1012 with TGTK2WidgetSet(Widgetset) do 1013 begin 1014 {$note test with smaller minor versions and check where LM_CONFIGUREEVENT is needed.} 1015 {$IFDEF HASX} 1016 // fix for buggy compiz. 1017 // see http://bugs.freepascal.org/view.php?id=17523 1018 if not compositeManagerRunning then 1019 {$ENDIF} 1020 SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject); 1021 end; 1022end; 1023 1024class function TGtk2WSHintWindow.CreateHandle(const AWinControl: TWinControl; 1025 const AParams: TCreateParams): TLCLIntfHandle; 1026var 1027 TempWidget : PGTKWidget; // pointer to gtk-widget (local use when neccessary) 1028 p : pointer; // ptr to the newly created GtkWidget 1029 ACustomForm: TCustomForm; 1030 AWindow: PGdkWindow; 1031 WidgetInfo: PWidgetInfo; 1032begin 1033 ACustomForm := TCustomForm(AWinControl); 1034 1035 p := gtk_window_new(GTK_WINDOW_POPUP); 1036 WidgetInfo := CreateWidgetInfo(p, AWinControl, AParams); 1037 gtk_window_set_policy(GTK_WINDOW(p), 0, 0, 0); 1038 gtk_window_set_focus_on_map(P, False); 1039 1040 // issue #24363 1041 g_object_set_data(P,'lclhintwindow',AWinControl); 1042 1043 // Create the form client area 1044 TempWidget := CreateFixedClientWidget; 1045 gtk_container_add(p, TempWidget); 1046 GTK_WIDGET_UNSET_FLAGS(TempWidget, GTK_CAN_FOCUS); 1047 gtk_widget_show(TempWidget); 1048 SetFixedWidget(p, TempWidget); 1049 SetMainWidget(p, TempWidget); 1050 1051 ACustomForm.FormStyle := fsStayOnTop; 1052 ACustomForm.BorderStyle := bsNone; 1053 gtk_widget_realize(p); 1054 AWindow := GetControlWindow(P); 1055 {$IFDEF DebugGDK}BeginGDKErrorTrap;{$ENDIF} 1056 1057 gdk_window_set_decorations(AWindow, GetWindowDecorations(ACustomForm)); 1058 1059 gdk_window_set_functions(AWindow, GetWindowFunction(ACustomForm)); 1060 1061 {$IFDEF DebugGDK}EndGDKErrorTrap;{$ENDIF} 1062 gtk_widget_show_all(TempWidget);// Important: do not show the window yet, only make its content visible 1063 1064 {$IFNDEF NoStyle} 1065 if (ACustomForm.Parent = nil) then 1066 gtk_widget_set_app_paintable(P, True); 1067 {$ENDIF} 1068 1069 {$IFDEF DebugLCLComponents} 1070 DebugGtkWidgets.MarkCreated(P,dbgsName(AWinControl)); 1071 {$ENDIF} 1072 Result := TLCLIntfHandle({%H-}PtrUInt(P)); 1073 Set_RC_Name(AWinControl, P); 1074 SetCallbacks(P, WidgetInfo); 1075end; 1076 1077class procedure TGtk2WSHintWindow.ShowHide(const AWinControl: TWinControl); 1078var 1079 bVisible: boolean; 1080begin 1081 if not WSCheckHandleAllocated(AWinControl, 'SetColor') then 1082 exit; 1083 1084 bVisible := AWinControl.HandleObjectShouldBeVisible; 1085 if bVisible then 1086 gtk_window_set_type_hint({%H-}PGtkWindow(AWinControl.Handle), GDK_WINDOW_TYPE_HINT_TOOLTIP); 1087 Gtk2WidgetSet.SetVisible(AWinControl, bVisible); 1088 InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect); 1089end; 1090 1091end. 1092