1{ $Id$ } 2{ 3 ------------------------------------------ 4 gtk2wsprivate.pp - Gtk2 internal classes 5 ------------------------------------------ 6 7 @created(Thu Feb 1st WET 2007) 8 @lastmod($Date$) 9 @author(Marc Weustink <marc@@lazarus.dommelstein.net>) 10 11 This unit contains the private classhierarchy for the gtk implemetations 12 This hierarchy reflects (more or less) the gtk widget hierarchy 13 14 ***************************************************************************** 15 This file is part of the Lazarus Component Library (LCL) 16 17 See the file COPYING.modifiedLGPL.txt, included in this distribution, 18 for details about the license. 19 ***************************************************************************** 20} 21 22unit Gtk2WSPrivate; 23{$mode objfpc}{$H+} 24 25interface 26 27uses 28 // libs 29 Gtk2, Glib2, Gdk2, 30 Classes, SysUtils, 31 // LCL 32 LCLType, LMessages, LCLProc, Controls, Forms, 33 // widgetset 34 WSControls, WSLCLClasses, WSProc, 35 // interface 36 Gtk2Def, Gtk2Proc, Gtk2WSControls; 37 38 39type 40 { TGtkPrivate } // GTK1WS Legacy! 41 { Generic base class, don't know if it is needed } 42 43 TGtkPrivate = class(TWSPrivate) 44 private 45 protected 46 public 47 end; 48 49 { TGtkPrivateWidget } 50 { Private class for all gtk widgets } 51 52 TGtkPrivateWidget = class(TGtkPrivate) 53 private 54 protected 55 public 56 class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual; 57 class procedure UpdateCursor(AInfo: PWidgetInfo); virtual; 58 end; 59 TGtkPrivateWidgetClass = class of TGtkPrivateWidget; 60 61 { TGtkPrivateEntry } 62 { Private class for gtkentries (text fields) } 63 64 TGtkPrivateEntry = class(TGtkPrivateWidget) 65 private 66 protected 67 public 68 end; 69 70 71 { TGtkPrivateContainer } 72 { Private class for gtkcontainers } 73 74 TGtkPrivateContainer = class(TGtkPrivateWidget) 75 private 76 protected 77 public 78 end; 79 80 { TGtkPrivateBin } 81 { Private class for gtkbins } 82 83 TGtkPrivateBin = class(TGtkPrivateContainer) 84 private 85 protected 86 public 87 end; 88 89 90 { TGtkWSScrollingPrivate } 91 { we may want to use something like a compund class } 92 93 TGtkPrivateScrolling = class(TGtkPrivateContainer) 94 private 95 protected 96 public 97 class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override; 98 end; 99 100 TGtkPrivateScrollingWinControl = class(TGtkPrivateScrolling) 101 private 102 protected 103 public 104 class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override; 105 end; 106 { ------------------------------------} 107 108 { TGtkPrivateWindow } 109 { Private class for gtkwindows } 110 111 TGtkPrivateWindow = class(TGtkPrivateBin) 112 private 113 protected 114 public 115 end; 116 117 { TGtkPrivateDialog } 118 { Private class for gtkdialogs } 119 120 TGtkPrivateDialog = class(TGtkPrivateWindow) 121 private 122 protected 123 public 124 end; 125 126 { TGtkPrivateButton } 127 { Private class for gtkbuttons } 128 129 TGtkPrivateButton = class(TGtkPrivateBin) 130 private 131 protected 132 public 133 end; 134 135 { TGtkPrivateList } 136 { Private class for gtklists } 137 138 TGtkPrivateListClass = class of TGtkPrivateList; 139 TGtkPrivateList = class(TGtkPrivateScrolling) 140 private 141 protected 142 public 143 class procedure SetCallbacks(const {%H-}AGtkWidget: PGtkWidget; const {%H-}AWidgetInfo: PWidgetInfo); virtual; 144 end; 145 146 { TGtkPrivateNotebook } 147 { Private class for gtknotebooks } 148 149 TGtkPrivateNotebook = class(TGtkPrivateBin) 150 private 151 protected 152 public 153 end; 154 155 { TGtkPrivatePaned } 156 { Private class for gtkpaned } 157 TGtkPrivatePaned = class(TGtkPrivateContainer) 158 private 159 protected 160 public 161 class procedure UpdateCursor(AInfo: PWidgetInfo); override; 162 end; 163 164 165 { TGtk2PrivateWidget } 166 { Private class for gtkwidgets } 167 168 TGtk2PrivateWidget = class(TGtkPrivateWidget) 169 private 170 protected 171 public 172 end; 173 174 175 { TGtk2PrivateContainer } 176 { Private class for gtkcontainers } 177 178 TGtk2PrivateContainer = class(TGtkPrivateContainer) 179 private 180 protected 181 public 182 end; 183 184 185 { TGtk2PrivateBin } 186 { Private class for gtkbins } 187 188 TGtk2PrivateBin = class(TGtkPrivateBin) 189 private 190 protected 191 public 192 end; 193 194 195 { TGtk2PrivateWindow } 196 { Private class for gtkwindows } 197 198 TGtk2PrivateWindow = class(TGtkPrivateWindow) 199 private 200 protected 201 public 202 end; 203 204 205 { TGtk2PrivateDialog } 206 { Private class for gtkdialogs } 207 208 TGtk2PrivateDialog = class(TGtkPrivateDialog) 209 private 210 protected 211 public 212 end; 213 214 215 { TGtk2PrivateButton } 216 { Private class for gtkbuttons } 217 218 TGtk2PrivateButton = class(TGtkPrivateButton) 219 private 220 protected 221 public 222 class procedure UpdateCursor(AInfo: PWidgetInfo); override; 223 end; 224 225 { TGtk2PrivateList } 226 { Private class for gtklists } 227 228 TGtk2PrivateList = class(TGtkPrivateList) 229 private 230 protected 231 public 232 class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override; 233 end; 234 235 { TGtk2PrivateMemo } 236 { Private class for gtkmemos } 237 238 TGtk2PrivateMemo = class(TGtkPrivateScrolling) 239 private 240 protected 241 public 242 class procedure UpdateCursor(AInfo: PWidgetInfo); override; 243 end; 244 245 { TGtk2PrivateNotebook } 246 { Private class for gtknotebooks } 247 248 TGtk2PrivateNotebook = class(TGtkPrivateNotebook) 249 private 250 protected 251 public 252 class procedure UpdateCursor(AInfo: PWidgetInfo); override; 253 end; 254 255 { TGtk2PrivatePaned } 256 257 TGtk2PrivatePaned = class(TGtkPrivatePaned) 258 private 259 protected 260 public 261 end; 262 263 264function GetWidgetWithWindow(const AHandle: HWND): PGtkWidget; 265procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; 266 ARecursive: Boolean; ASetDefault: Boolean); 267procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo; 268 ASetDefault: Boolean); 269procedure SetGlobalCursor(Cursor: HCURSOR); 270 271implementation 272 273uses 274 Gtk2Extra; 275 276{$I Gtk2PrivateWidget.inc} 277{$I Gtk2PrivateList.inc} 278 279{ TGtkPrivateScrolling } 280{ temp class to keep things working } 281 282class procedure TGtkPrivateScrolling.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); 283var 284 ScrollWidget: PGtkScrolledWindow; 285// WidgetInfo: PWidgetInfo; 286 Widget: PGtkWidget; 287begin 288 if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition') 289 then Exit; 290 291 ScrollWidget := {%H-}Pointer(AWinControl.Handle); 292// WidgetInfo := GetWidgetInfo(ScrollWidget); 293 // Some controls have viewports, so we get the first window. 294 Widget := GetWidgetWithWindow(AWinControl.Handle); 295 296 case APosition of 297 wszpBack: begin 298 //gdk_window_lower(WidgetInfo^.CoreWidget^.Window); 299 gdk_window_lower(Widget^.Window); 300 if ScrollWidget^.hscrollbar <> nil 301 then gdk_window_lower(ScrollWidget^.hscrollbar^.Window); 302 if ScrollWidget^.vscrollbar <> nil 303 then gdk_window_lower(ScrollWidget^.vscrollbar^.Window); 304 end; 305 wszpFront: begin 306 //gdk_window_raise(WidgetInfo^.CoreWidget^.Window); 307 gdk_window_raise(Widget^.Window); 308 if ScrollWidget^.hscrollbar <> nil 309 then gdk_window_raise(ScrollWidget^.hscrollbar^.Window); 310 if ScrollWidget^.vscrollbar <> nil 311 then gdk_window_raise(ScrollWidget^.vscrollbar^.Window); 312 end; 313 end; 314end; 315 316{ TGtkPrivateScrollingWinControl } 317 318class procedure TGtkPrivateScrollingWinControl.SetZPosition( 319 const AWinControl: TWinControl; const APosition: TWSZPosition); 320var 321 Widget: PGtkWidget; 322 ScrollWidget: PGtkScrolledWindow; 323// WidgetInfo: PWidgetInfo; 324begin 325 if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition') 326 then Exit; 327 328 //TODO: when all scrolling controls are "derived" from TGtkWSBaseScrollingWinControl 329 // retrieve scrollbars from WidgetInfo^.Userdata. In that case, the following 330 // code can be removed and a call to TGtkWSBaseScrollingWinControl.SetZPosition 331 // can be made. This is not possible now since we have a frame around us 332 333 Widget := {%H-}Pointer(AWinControl.Handle); 334 // WidgetInfo := GetWidgetInfo(Widget); 335 336 // Only do the scrollbars, leave the core to the default (we might have a viewport) 337 TGtkPrivateWidget.SetZPosition(AWinControl, APosition); 338 339 if GtkWidgetIsA(Widget, gtk_frame_get_type) then 340 ScrollWidget := PGtkScrolledWindow(PGtkFrame(Widget)^.Bin.Child) 341 else 342 if GtkWidgetIsA(Widget, gtk_scrolled_window_get_type) then 343 ScrollWidget := PGtkScrolledWindow(Widget) 344 else 345 ScrollWidget := nil; 346 347 if ScrollWidget <> nil then 348 begin 349 case APosition of 350 wszpBack: begin 351 // gdk_window_lower(WidgetInfo^.CoreWidget^.Window); 352 if ScrollWidget^.hscrollbar <> nil then 353 begin 354 if GDK_IS_WINDOW(ScrollWidget^.hscrollbar^.Window) then 355 gdk_window_lower(ScrollWidget^.hscrollbar^.Window); 356 end; 357 358 if ScrollWidget^.vscrollbar <> nil then 359 begin 360 if GDK_IS_WINDOW(ScrollWidget^.vscrollbar^.Window) then 361 gdk_window_lower(ScrollWidget^.vscrollbar^.Window); 362 end; 363 end; 364 wszpFront: begin 365 // gdk_window_raise(WidgetInfo^.CoreWidget^.Window); 366 if ScrollWidget^.hscrollbar <> nil then 367 begin 368 if GDK_IS_WINDOW(ScrollWidget^.hscrollbar^.Window) then 369 gdk_window_raise(ScrollWidget^.hscrollbar^.Window); 370 end; 371 if ScrollWidget^.vscrollbar <> nil then 372 begin 373 if GDK_IS_WINDOW(ScrollWidget^.vscrollbar^.Window) then 374 gdk_window_raise(ScrollWidget^.vscrollbar^.Window); 375 end; 376 end; 377 end; 378 end; 379end; 380 381{------------------------------------------------------------------------------ 382 procedure: SetWindowCursor 383 Params: AWindow : PGDkWindow, ACursor: PGdkCursor, ASetDefault: Boolean 384 Returns: Nothing 385 386 Sets the cursor for a window. 387 Tries to avoid messing with the cursors of implicitly created 388 child windows (e.g. headers in TListView) with the following logic: 389 - If Cursor <> nil, saves the old cursor (if not already done or ASetDefault = true) 390 before setting the new one. 391 - If Cursor = nil, restores the old cursor (if not already done). 392 393 Unfortunately gdk_window_get_cursor is only available from 394 version 2.18, so it needs to be retrieved dynamically. 395 If gdk_window_get_cursor is not available, the cursor is set 396 according to LCL widget data. 397 ------------------------------------------------------------------------------} 398procedure SetWindowCursor(AWindow: PGdkWindow; Cursor: PGdkCursor; ASetDefault: Boolean); 399var 400 OldCursor: PGdkCursor; 401 Data: gpointer; 402 Info: PWidgetInfo; 403begin 404 Info := nil; 405 gdk_window_get_user_data(AWindow, @Data); 406 if (Data <> nil) and GTK_IS_WIDGET(Data) then 407 begin 408 Info := GetWidgetInfo(PGtkWidget(Data)); 409 end; 410 if not Assigned(gdk_window_get_cursor) and (Info = nil) 411 then Exit; 412 if ASetDefault then //and ((Cursor <> nil) or ( <> nil)) then 413 begin 414 // Override any old default cursor 415 g_object_steal_data(PGObject(AWindow), 'havesavedcursor'); // OK? 416 g_object_steal_data(PGObject(AWindow), 'savedcursor'); 417 gdk_window_set_cursor(AWindow, Cursor); 418 Exit; 419 end; 420 if Cursor <> nil then 421 begin 422 if Assigned(gdk_window_get_cursor) 423 then OldCursor := gdk_window_get_cursor(AWindow) 424 else OldCursor := {%H-}PGdkCursor(Info^.ControlCursor); 425 // As OldCursor can be nil, use a separate key to indicate whether it 426 // is stored. 427 if ASetDefault or (g_object_get_data(PGObject(AWindow), 'havesavedcursor') = nil) then 428 begin 429 g_object_set_data(PGObject(AWindow), 'havesavedcursor', gpointer(1)); 430 g_object_set_data(PGObject(AWindow), 'savedcursor', gpointer(OldCursor)); 431 end; 432 gdk_window_set_cursor(AWindow, Cursor); 433 end else 434 begin 435 if g_object_steal_data(PGObject(AWindow), 'havesavedcursor') <> nil then 436 begin 437 Cursor := g_object_steal_data(PGObject(AWindow), 'savedcursor'); 438 gdk_window_set_cursor(AWindow, Cursor); 439 end; 440 end; 441end; 442 443{------------------------------------------------------------------------------ 444 procedure: SetWindowCursor 445 Params: AWindow : PGDkWindow, ACursor: HCursor, ARecursive: Boolean 446 Returns: Nothing 447 448 Sets the cursor for a window (or recursively for window with children) 449 ------------------------------------------------------------------------------} 450procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; 451 ARecursive: Boolean; ASetDefault: Boolean); 452var 453 Cursor: PGdkCursor; 454 455 procedure SetCursorRecursive(AWindow: PGdkWindow); 456 var 457 ChildWindows, ListEntry: PGList; 458 begin 459 SetWindowCursor(AWindow, Cursor, ASetDefault); 460 461 ChildWindows := gdk_window_get_children(AWindow); 462 463 ListEntry := ChildWindows; 464 while ListEntry <> nil do 465 begin 466 SetCursorRecursive(PGdkWindow(ListEntry^.Data)); 467 ListEntry := ListEntry^.Next; 468 end; 469 g_list_free(ChildWindows); 470 end; 471begin 472 Cursor := {%H-}PGdkCursor(ACursor); 473 if ARecursive 474 then SetCursorRecursive(AWindow) 475 else SetWindowCursor(AWindow, Cursor, ASetDefault); 476end; 477 478// Helper functions 479 480function GetWidgetWithWindow(const AHandle: HWND): PGtkWidget; 481var 482 Children: PGList; 483begin 484 Result := {%H-}PGTKWidget(PtrUInt(AHandle)); 485 while (Result <> nil) and GTK_WIDGET_NO_WINDOW(Result) 486 and GtkWidgetIsA(Result,gtk_container_get_type) do 487 begin 488 Children := gtk_container_children(PGtkContainer(Result)); 489 if Children = nil 490 then Result := nil 491 else Result := Children^.Data; 492 end; 493end; 494 495procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo; 496 ASetDefault: Boolean); 497var 498 Cursor: PGdkCursor; 499 Data: gpointer; 500 Info: PWidgetInfo; 501 502 procedure SetCursorRecursive(AWindow: PGdkWindow); 503 var 504 ChildWindows, ListEntry: PGList; 505 begin 506 gdk_window_get_user_data(AWindow, @Data); 507 if (Data <> nil) and GTK_IS_WIDGET(Data) then 508 begin 509 Info := GetWidgetInfo(PGtkWidget(Data)); 510 if Info = AInfo then 511 SetWindowCursor(AWindow, Cursor, ASetDefault); 512 end; 513 514 ChildWindows := gdk_window_get_children(AWindow); 515 516 ListEntry := ChildWindows; 517 while ListEntry <> nil do 518 begin 519 SetCursorRecursive(PGdkWindow(ListEntry^.Data)); 520 ListEntry := ListEntry^.Next; 521 end; 522 g_list_free(ChildWindows); 523 end; 524begin 525 if AInfo = nil then Exit; 526 Cursor := {%H-}PGdkCursor(AInfo^.ControlCursor); 527 SetCursorRecursive(AWindow); 528end; 529 530{------------------------------------------------------------------------------ 531 procedure: SetGlobalCursor 532 Params: ACursor: HCursor 533 Returns: Nothing 534 535 Sets the cursor for all toplevel windows. Also sets the cursor for all child 536 windows recursively provided gdk_get_window_cursor is available. 537 ------------------------------------------------------------------------------} 538procedure SetGlobalCursor(Cursor: HCURSOR); 539var 540 TopList, List: PGList; 541begin 542 TopList := gdk_window_get_toplevels; 543 List := TopList; 544 while List <> nil do 545 begin 546 if (List^.Data <> nil) then 547 SetWindowCursor(PGDKWindow(List^.Data), Cursor, 548 Assigned(gdk_window_get_cursor), False); 549 list := g_list_next(list); 550 end; 551 552 if TopList <> nil then 553 g_list_free(TopList); 554end; 555 556 557end. 558 559