mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-10 05:08:23 +02:00
572 lines
15 KiB
ObjectPascal
572 lines
15 KiB
ObjectPascal
{ $Id$ }
|
|
{
|
|
------------------------------------------
|
|
gtk2wsprivate.pp - Gtk2 internal classes
|
|
------------------------------------------
|
|
|
|
@created(Thu Feb 1st WET 2007)
|
|
@lastmod($Date$)
|
|
@author(Marc Weustink <marc@@lazarus.dommelstein.net>)
|
|
|
|
This unit contains the private classhierarchy for the gtk implemetations
|
|
This hierarchy reflects (more or less) the gtk widget hierarchy
|
|
|
|
*****************************************************************************
|
|
This file is part of the Lazarus Component Library (LCL)
|
|
|
|
See the file COPYING.modifiedLGPL.txt, included in this distribution,
|
|
for details about the license.
|
|
*****************************************************************************
|
|
}
|
|
unit Gtk2WSPrivate;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
// libs
|
|
Gtk2, Glib2, Gdk2,
|
|
Classes, SysUtils,
|
|
// LCL
|
|
LCLType, LMessages, LCLProc, Controls, Forms,
|
|
// widgetset
|
|
WSControls, WSLCLClasses, WSProc,
|
|
// interface
|
|
Gtk2Extra, Gtk2Def, Gtk2Proc;
|
|
|
|
|
|
type
|
|
{ TGtkPrivate } // GTK1WS Legacy!
|
|
{ Generic base class, don't know if it is needed }
|
|
|
|
TGtkPrivate = class(TWSPrivate)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TGtkPrivateWidget }
|
|
{ Private class for all gtk widgets }
|
|
|
|
TGtkPrivateWidget = class(TGtkPrivate)
|
|
private
|
|
protected
|
|
public
|
|
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
|
|
class procedure UpdateCursor(AInfo: PWidgetInfo); virtual;
|
|
end;
|
|
TGtkPrivateWidgetClass = class of TGtkPrivateWidget;
|
|
|
|
{ TGtkPrivateEntry }
|
|
{ Private class for gtkentries (text fields) }
|
|
|
|
TGtkPrivateEntry = class(TGtkPrivateWidget)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtkPrivateContainer }
|
|
{ Private class for gtkcontainers }
|
|
|
|
TGtkPrivateContainer = class(TGtkPrivateWidget)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TGtkPrivateBin }
|
|
{ Private class for gtkbins }
|
|
|
|
TGtkPrivateBin = class(TGtkPrivateContainer)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtkWSScrollingPrivate }
|
|
{ we may want to use something like a compund class }
|
|
|
|
TGtkPrivateScrolling = class(TGtkPrivateContainer)
|
|
private
|
|
protected
|
|
public
|
|
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
|
|
end;
|
|
|
|
TGtkPrivateScrollingWinControl = class(TGtkPrivateScrolling)
|
|
private
|
|
protected
|
|
public
|
|
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); override;
|
|
end;
|
|
{ ------------------------------------}
|
|
|
|
{ TGtkPrivateWindow }
|
|
{ Private class for gtkwindows }
|
|
|
|
TGtkPrivateWindow = class(TGtkPrivateBin)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TGtkPrivateDialog }
|
|
{ Private class for gtkdialogs }
|
|
|
|
TGtkPrivateDialog = class(TGtkPrivateWindow)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TGtkPrivateButton }
|
|
{ Private class for gtkbuttons }
|
|
|
|
TGtkPrivateButton = class(TGtkPrivateBin)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TGtkPrivateList }
|
|
{ Private class for gtklists }
|
|
|
|
TGtkPrivateListClass = class of TGtkPrivateList;
|
|
TGtkPrivateList = class(TGtkPrivateScrolling)
|
|
private
|
|
protected
|
|
public
|
|
class procedure SetCallbacks(const {%H-}AGtkWidget: PGtkWidget; const {%H-}AWidgetInfo: PWidgetInfo); virtual;
|
|
end;
|
|
|
|
{ TGtkPrivateNotebook }
|
|
{ Private class for gtknotebooks }
|
|
|
|
TGtkPrivateNotebook = class(TGtkPrivateBin)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
{ TGtkPrivatePaned }
|
|
{ Private class for gtkpaned }
|
|
TGtkPrivatePaned = class(TGtkPrivateContainer)
|
|
private
|
|
protected
|
|
public
|
|
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
|
|
end;
|
|
|
|
|
|
{ TGtk2PrivateWidget }
|
|
{ Private class for gtkwidgets }
|
|
|
|
TGtk2PrivateWidget = class(TGtkPrivateWidget)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtk2PrivateContainer }
|
|
{ Private class for gtkcontainers }
|
|
|
|
TGtk2PrivateContainer = class(TGtkPrivateContainer)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtk2PrivateBin }
|
|
{ Private class for gtkbins }
|
|
|
|
TGtk2PrivateBin = class(TGtkPrivateBin)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtk2PrivateWindow }
|
|
{ Private class for gtkwindows }
|
|
|
|
TGtk2PrivateWindow = class(TGtkPrivateWindow)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtk2PrivateDialog }
|
|
{ Private class for gtkdialogs }
|
|
|
|
TGtk2PrivateDialog = class(TGtkPrivateDialog)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
{ TGtk2PrivateButton }
|
|
{ Private class for gtkbuttons }
|
|
|
|
TGtk2PrivateButton = class(TGtkPrivateButton)
|
|
private
|
|
protected
|
|
public
|
|
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
|
|
end;
|
|
|
|
{ TGtk2PrivateMemo }
|
|
{ Private class for gtkmemos }
|
|
|
|
TGtk2PrivateMemo = class(TGtkPrivateScrolling)
|
|
private
|
|
protected
|
|
public
|
|
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
|
|
end;
|
|
|
|
{ TGtk2PrivateNotebook }
|
|
{ Private class for gtknotebooks }
|
|
|
|
TGtk2PrivateNotebook = class(TGtkPrivateNotebook)
|
|
private
|
|
protected
|
|
public
|
|
class procedure UpdateCursor(AInfo: PWidgetInfo); override;
|
|
end;
|
|
|
|
{ TGtk2PrivatePaned }
|
|
|
|
TGtk2PrivatePaned = class(TGtkPrivatePaned)
|
|
private
|
|
protected
|
|
public
|
|
end;
|
|
|
|
|
|
function GetWidgetWithWindow(const AHandle: HWND): PGtkWidget;
|
|
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
|
|
ARecursive: Boolean; ASetDefault: Boolean);
|
|
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
|
|
ASetDefault: Boolean);
|
|
procedure SetGlobalCursor(Cursor: HCURSOR);
|
|
|
|
implementation
|
|
|
|
{$I Gtk2PrivateWidget.inc}
|
|
{$I Gtk2PrivateList.inc}
|
|
|
|
{ TGtkPrivateScrolling }
|
|
{ temp class to keep things working }
|
|
|
|
class procedure TGtkPrivateScrolling.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
|
|
var
|
|
ScrollWidget: PGtkScrolledWindow;
|
|
// WidgetInfo: PWidgetInfo;
|
|
Widget: PGtkWidget;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
|
|
then Exit;
|
|
|
|
ScrollWidget := {%H-}Pointer(AWinControl.Handle);
|
|
// WidgetInfo := GetWidgetInfo(ScrollWidget);
|
|
// Some controls have viewports, so we get the first window.
|
|
Widget := GetWidgetWithWindow(AWinControl.Handle);
|
|
|
|
case APosition of
|
|
wszpBack: begin
|
|
//gdk_window_lower(WidgetInfo^.CoreWidget^.Window);
|
|
gdk_window_lower(Widget^.Window);
|
|
if ScrollWidget^.hscrollbar <> nil
|
|
then gdk_window_lower(ScrollWidget^.hscrollbar^.Window);
|
|
if ScrollWidget^.vscrollbar <> nil
|
|
then gdk_window_lower(ScrollWidget^.vscrollbar^.Window);
|
|
end;
|
|
wszpFront: begin
|
|
//gdk_window_raise(WidgetInfo^.CoreWidget^.Window);
|
|
gdk_window_raise(Widget^.Window);
|
|
if ScrollWidget^.hscrollbar <> nil
|
|
then gdk_window_raise(ScrollWidget^.hscrollbar^.Window);
|
|
if ScrollWidget^.vscrollbar <> nil
|
|
then gdk_window_raise(ScrollWidget^.vscrollbar^.Window);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ TGtkPrivateScrollingWinControl }
|
|
|
|
class procedure TGtkPrivateScrollingWinControl.SetZPosition(
|
|
const AWinControl: TWinControl; const APosition: TWSZPosition);
|
|
var
|
|
Widget: PGtkWidget;
|
|
ScrollWidget: PGtkScrolledWindow;
|
|
// WidgetInfo: PWidgetInfo;
|
|
begin
|
|
if not WSCheckHandleAllocated(AWincontrol, 'SetZPosition')
|
|
then Exit;
|
|
|
|
//TODO: when all scrolling controls are "derived" from TGtkWSBaseScrollingWinControl
|
|
// retrieve scrollbars from WidgetInfo^.Userdata. In that case, the following
|
|
// code can be removed and a call to TGtkWSBaseScrollingWinControl.SetZPosition
|
|
// can be made. This is not possible now since we have a frame around us
|
|
|
|
Widget := {%H-}Pointer(AWinControl.Handle);
|
|
// WidgetInfo := GetWidgetInfo(Widget);
|
|
|
|
// Only do the scrollbars, leave the core to the default (we might have a viewport)
|
|
TGtkPrivateWidget.SetZPosition(AWinControl, APosition);
|
|
|
|
if GtkWidgetIsA(Widget, gtk_frame_get_type) then
|
|
ScrollWidget := PGtkScrolledWindow(PGtkFrame(Widget)^.Bin.Child)
|
|
else
|
|
if GtkWidgetIsA(Widget, gtk_scrolled_window_get_type) then
|
|
ScrollWidget := PGtkScrolledWindow(Widget)
|
|
else
|
|
ScrollWidget := nil;
|
|
|
|
if ScrollWidget <> nil then
|
|
begin
|
|
case APosition of
|
|
wszpBack: begin
|
|
// gdk_window_lower(WidgetInfo^.CoreWidget^.Window);
|
|
if ScrollWidget^.hscrollbar <> nil then
|
|
begin
|
|
if GDK_IS_WINDOW(ScrollWidget^.hscrollbar^.Window) then
|
|
gdk_window_lower(ScrollWidget^.hscrollbar^.Window);
|
|
end;
|
|
|
|
if ScrollWidget^.vscrollbar <> nil then
|
|
begin
|
|
if GDK_IS_WINDOW(ScrollWidget^.vscrollbar^.Window) then
|
|
gdk_window_lower(ScrollWidget^.vscrollbar^.Window);
|
|
end;
|
|
end;
|
|
wszpFront: begin
|
|
// gdk_window_raise(WidgetInfo^.CoreWidget^.Window);
|
|
if ScrollWidget^.hscrollbar <> nil then
|
|
begin
|
|
if GDK_IS_WINDOW(ScrollWidget^.hscrollbar^.Window) then
|
|
gdk_window_raise(ScrollWidget^.hscrollbar^.Window);
|
|
end;
|
|
if ScrollWidget^.vscrollbar <> nil then
|
|
begin
|
|
if GDK_IS_WINDOW(ScrollWidget^.vscrollbar^.Window) then
|
|
gdk_window_raise(ScrollWidget^.vscrollbar^.Window);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure: SetWindowCursor
|
|
Params: AWindow : PGDkWindow, ACursor: PGdkCursor, ASetDefault: Boolean
|
|
Returns: Nothing
|
|
|
|
Sets the cursor for a window.
|
|
Tries to avoid messing with the cursors of implicitly created
|
|
child windows (e.g. headers in TListView) with the following logic:
|
|
- If Cursor <> nil, saves the old cursor (if not already done or ASetDefault = true)
|
|
before setting the new one.
|
|
- If Cursor = nil, restores the old cursor (if not already done).
|
|
|
|
Unfortunately gdk_window_get_cursor is only available from
|
|
version 2.18, so it needs to be retrieved dynamically.
|
|
If gdk_window_get_cursor is not available, the cursor is set
|
|
according to LCL widget data.
|
|
------------------------------------------------------------------------------}
|
|
procedure SetWindowCursor(AWindow: PGdkWindow; Cursor: PGdkCursor; ASetDefault: Boolean);
|
|
var
|
|
OldCursor: PGdkCursor;
|
|
Data: gpointer;
|
|
Info: PWidgetInfo;
|
|
begin
|
|
Info := nil;
|
|
gdk_window_get_user_data(AWindow, @Data);
|
|
if (Data <> nil) and GTK_IS_WIDGET(Data) then
|
|
begin
|
|
Info := GetWidgetInfo(PGtkWidget(Data));
|
|
end;
|
|
if not Assigned(gdk_window_get_cursor) and (Info = nil)
|
|
then Exit;
|
|
if ASetDefault then //and ((Cursor <> nil) or ( <> nil)) then
|
|
begin
|
|
// Override any old default cursor
|
|
g_object_steal_data(PGObject(AWindow), 'havesavedcursor'); // OK?
|
|
g_object_steal_data(PGObject(AWindow), 'savedcursor');
|
|
gdk_window_set_cursor(AWindow, Cursor);
|
|
Exit;
|
|
end;
|
|
if Cursor <> nil then
|
|
begin
|
|
if Assigned(gdk_window_get_cursor)
|
|
then OldCursor := gdk_window_get_cursor(AWindow)
|
|
else OldCursor := {%H-}PGdkCursor(Info^.ControlCursor);
|
|
// As OldCursor can be nil, use a separate key to indicate whether it
|
|
// is stored.
|
|
if ASetDefault or (g_object_get_data(PGObject(AWindow), 'havesavedcursor') = nil) then
|
|
begin
|
|
g_object_set_data(PGObject(AWindow), 'havesavedcursor', gpointer(1));
|
|
g_object_set_data(PGObject(AWindow), 'savedcursor', gpointer(OldCursor));
|
|
end;
|
|
gdk_window_set_cursor(AWindow, Cursor);
|
|
end else
|
|
begin
|
|
if g_object_steal_data(PGObject(AWindow), 'havesavedcursor') <> nil then
|
|
begin
|
|
Cursor := g_object_steal_data(PGObject(AWindow), 'savedcursor');
|
|
gdk_window_set_cursor(AWindow, Cursor);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure SetWindowCursorWithGrab(AWindow: PGdkWindow; Cursor: PGdkCursor; ASetDefault: Boolean);
|
|
var
|
|
display: PGdkDisplayExtended;
|
|
prevWindow: PgdkWindow;
|
|
begin
|
|
display := PGdkDisplayExtended(gdk_drawable_get_display(AWindow));
|
|
prevWindow := display^.pointer_info.window_under_pointer;
|
|
display^.pointer_info.window_under_pointer := AWindow;
|
|
try
|
|
SetWindowCursor(AWindow, Cursor, ASetDefault);
|
|
finally
|
|
display^.pointer_info.window_under_pointer := prevWindow;
|
|
end;
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure: SetWindowCursor
|
|
Params: AWindow : PGDkWindow, ACursor: HCursor, ARecursive: Boolean
|
|
Returns: Nothing
|
|
|
|
Sets the cursor for a window (or recursively for window with children)
|
|
------------------------------------------------------------------------------}
|
|
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
|
|
ARecursive: Boolean; ASetDefault: Boolean);
|
|
var
|
|
Cursor: PGdkCursor;
|
|
GrabPresent: Boolean;
|
|
|
|
procedure SetCursorRecursive(AWindow: PGdkWindow);
|
|
var
|
|
ChildWindows, ListEntry: PGList;
|
|
begin
|
|
if GrabPresent then
|
|
SetWindowCursorWithGrab(AWindow, Cursor, ASetDefault)
|
|
else
|
|
SetWindowCursor(AWindow, Cursor, ASetDefault);
|
|
|
|
ChildWindows := gdk_window_get_children(AWindow);
|
|
|
|
ListEntry := ChildWindows;
|
|
while ListEntry <> nil do
|
|
begin
|
|
SetCursorRecursive(PGdkWindow(ListEntry^.Data));
|
|
ListEntry := ListEntry^.Next;
|
|
end;
|
|
g_list_free(ChildWindows);
|
|
end;
|
|
begin
|
|
Cursor := {%H-}PGdkCursor(ACursor);
|
|
// check for debian users with gtk2 2.12..2.16
|
|
GrabPresent := (gtk_grab_get_current <> nil) and
|
|
(gtk_major_version = 2) and (gtk_minor_version >= 18);
|
|
if ARecursive then
|
|
SetCursorRecursive(AWindow)
|
|
else
|
|
if GrabPresent then
|
|
SetWindowCursorWithGrab(AWindow, Cursor, ASetDefault)
|
|
else
|
|
SetWindowCursor(AWindow, Cursor, ASetDefault);
|
|
end;
|
|
|
|
// Helper functions
|
|
|
|
function GetWidgetWithWindow(const AHandle: HWND): PGtkWidget;
|
|
var
|
|
Children: PGList;
|
|
begin
|
|
Result := {%H-}PGTKWidget(PtrUInt(AHandle));
|
|
while (Result <> nil) and GTK_WIDGET_NO_WINDOW(Result)
|
|
and GtkWidgetIsA(Result,gtk_container_get_type) do
|
|
begin
|
|
Children := gtk_container_children(PGtkContainer(Result));
|
|
if Children = nil
|
|
then Result := nil
|
|
else Result := Children^.Data;
|
|
end;
|
|
end;
|
|
|
|
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
|
|
ASetDefault: Boolean);
|
|
var
|
|
Cursor: PGdkCursor;
|
|
Data: gpointer;
|
|
Info: PWidgetInfo;
|
|
|
|
procedure SetCursorRecursive(AWindow: PGdkWindow);
|
|
var
|
|
ChildWindows, ListEntry: PGList;
|
|
begin
|
|
gdk_window_get_user_data(AWindow, @Data);
|
|
if (Data <> nil) and GTK_IS_WIDGET(Data) then
|
|
begin
|
|
Info := GetWidgetInfo(PGtkWidget(Data));
|
|
if Info = AInfo then
|
|
SetWindowCursor(AWindow, Cursor, ASetDefault);
|
|
end;
|
|
|
|
ChildWindows := gdk_window_get_children(AWindow);
|
|
|
|
ListEntry := ChildWindows;
|
|
while ListEntry <> nil do
|
|
begin
|
|
SetCursorRecursive(PGdkWindow(ListEntry^.Data));
|
|
ListEntry := ListEntry^.Next;
|
|
end;
|
|
g_list_free(ChildWindows);
|
|
end;
|
|
begin
|
|
if AInfo = nil then Exit;
|
|
Cursor := {%H-}PGdkCursor(AInfo^.ControlCursor);
|
|
SetCursorRecursive(AWindow);
|
|
end;
|
|
|
|
{------------------------------------------------------------------------------
|
|
procedure: SetGlobalCursor
|
|
Params: ACursor: HCursor
|
|
Returns: Nothing
|
|
|
|
Sets the cursor for all toplevel windows. Also sets the cursor for all child
|
|
windows recursively provided gdk_get_window_cursor is available.
|
|
------------------------------------------------------------------------------}
|
|
procedure SetGlobalCursor(Cursor: HCURSOR);
|
|
var
|
|
TopList, List: PGList;
|
|
begin
|
|
TopList := gdk_window_get_toplevels;
|
|
List := TopList;
|
|
while List <> nil do
|
|
begin
|
|
if (List^.Data <> nil) then
|
|
SetWindowCursor(PGDKWindow(List^.Data), Cursor,
|
|
Assigned(gdk_window_get_cursor), False);
|
|
list := g_list_next(list);
|
|
end;
|
|
|
|
if TopList <> nil then
|
|
g_list_free(TopList);
|
|
end;
|
|
|
|
|
|
end.
|
|
|