paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-07-23 13:46:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

Gtk2: fixes all problems with cursor under gtk2 >= 2.18. Patch by Ere Maijala. issue #20313

Browse Source 
git-svn-id: trunk@34635 -
This commit is contained in:
zeljko 2012-01-07 09:59:16 +00:00
parent e62d7530b7
commit 6e4efa1d2e
10 changed files with 128 additions and 127 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/interfaces/gtk2/gtk2def.pp
View File

@ -472,7 +472,6 @@ type
DoubleBuffer: PGdkPixmap;
CursorPos: integer; // needed for delayed SetSelStart
ControlCursor: HCursor; // current widget cursor
DefaultCursor: HCursor; // default widget cursor
Flags: TWidgetInfoFlags;
ChangeLock: Integer; // lock events
PaintDepth: integer; // increased/decreased by Begin/EndPaint

6
lcl/interfaces/gtk2/gtk2extra.inc
View File

@ -56,6 +56,7 @@ end;
var
gtkhandle: tlibhandle;
glibhandle: tlibhandle;
gdklibhandle: tlibhandle;
libIter: Integer;
initialization
@ -77,9 +78,14 @@ initialization
break;
end;
end;
gdklibhandle := LoadLibrary(gdklib);
if gdklibhandle <> 0
then pointer(gdk_window_get_cursor):=GetProcAddress(gdklibhandle,'gdk_window_get_cursor');
finalization
if gtkhandle <> 0 then
FreeLibrary(gtkhandle);
if glibhandle <> 0 then
FreeLibrary(glibhandle);
if gdklibhandle <> 0 then
FreeLibrary(gdklibhandle);

1
lcl/interfaces/gtk2/gtk2extrah.inc
View File

@ -228,6 +228,7 @@ function gdk_screen_is_composited(screen: PGdkScreen): gboolean; cdecl; external
var
gtk_window_set_opacity: procedure(window: PGtkWindow; opacity: gdouble); cdecl;
g_object_ref_sink: function(anObject: PGObject): gpointer; cdecl;
gdk_window_get_cursor: function(window: PGdkWindow): PGdkCursor; cdecl;
{$ifdef ver2_2}
{$ifdef darwin}

24
lcl/interfaces/gtk2/gtk2privatewidget.inc
View File

@ -29,14 +29,9 @@ begin
// always recurse windows which do not accept controls.
// this way we will catch all widgets with double windows
if not (csAcceptsControls in TControl(AInfo^.LCLObject).ControlStyle) then
SetWindowCursor(Window, AInfo^.ControlCursor, True)
SetWindowCursor(Window, AInfo^.ControlCursor, False, True)
else
SetCursorForWindowsWithInfo(Window, AInfo);
end;
class procedure TGtkPrivateWidget.SetDefaultCursor(AInfo: PWidgetInfo);
begin
AInfo^.DefaultCursor := Screen.Cursors[crDefault];
SetCursorForWindowsWithInfo(Window, AInfo, True);
end;
class procedure TGtkPrivateWidget.SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition);
@ -70,17 +65,12 @@ begin
Widget := AInfo^.CoreWidget;
Window := PGTkPaned(Widget)^.handle;
if Window = nil then Exit;
SetWindowCursor(Window, AInfo^.ControlCursor, False);
SetWindowCursor(Window, AInfo^.ControlCursor, False, True);
end;
{ TGtkPrivateEntry }
class procedure TGtkPrivateEntry.SetDefaultCursor(AInfo: PWidgetInfo);
begin
AInfo^.DefaultCursor := Screen.Cursors[crIBeam];
end;
class procedure TGtk2PrivateButton.UpdateCursor(AInfo: PWidgetInfo);
var
Widget: PGtkWidget;
@ -90,7 +80,7 @@ begin
if (Widget = nil) or not GTK_IS_BUTTON(Widget) then Exit;
Window := PGtkButton(Widget)^.event_window;
if Window = nil then Exit;
SetWindowCursor(Window, AInfo^.ControlCursor, False);
SetWindowCursor(Window, AInfo^.ControlCursor, False, True);
end;
class procedure TGtk2PrivateNotebook.UpdateCursor(AInfo: PWidgetInfo);
@ -110,9 +100,9 @@ var
// always recurse windows which do not accept controls.
// this way we will catch all widgets with double windows
if not (csAcceptsControls in TControl(AInfo^.LCLObject).ControlStyle) then
SetWindowCursor(Window, AInfo^.ControlCursor, True)
SetWindowCursor(Window, AInfo^.ControlCursor, True, True)
else
SetCursorForWindowsWithInfo(Window, AInfo);
SetCursorForWindowsWithInfo(Window, AInfo, True);
end;
begin
@ -124,7 +114,7 @@ begin
Widget := AInfo^.CoreWidget;
Window := PGTkNotebook(Widget)^.event_window;
if Window <> nil then
SetWindowCursor(Window, AInfo^.ControlCursor, False);
SetWindowCursor(Window, AInfo^.ControlCursor, False, True);
// do not know how to set cursor under tabs
end;

1
lcl/interfaces/gtk2/gtk2proc.inc
View File

@ -3918,7 +3918,6 @@ begin
New(Result);
FillChar(Result^, SizeOf(Result^), 0);
gtk_object_set_data(AWidget, 'widgetinfo', Result);
Result^.DefaultCursor := HCursor(-1);
end;
end;

90
lcl/interfaces/gtk2/gtk2winapi.inc
View File

@ -7932,97 +7932,13 @@ end;
Returns : current cursor
------------------------------------------------------------------------------}
function TGtk2WidgetSet.SetCursor(ACursor: HCURSOR): HCURSOR;
var
DefaultCursor: HCursor;
procedure SetGlobalCursor;
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), ACursor, True);
list := g_list_next(list);
end;
if TopList <> nil then
g_list_free(TopList);
end;
procedure ResetGlobalCursor;
procedure SetToWindow(AWindow: PGDKWindow);
var
data: gpointer;
Widget: PGTKWidget absolute data;
WidgetInfo: PWidgetInfo;
WSPrivate: TWSPrivateClass;
begin
gdk_window_get_user_data(AWindow, @data);
if GtkWidgetIsA(Widget, gtk_widget_get_type)
then begin
WidgetInfo := GetWidgetInfo(Widget);
if (WidgetInfo <> nil)
and (WidgetInfo^.LCLObject <> nil)
and (WidgetInfo^.LCLObject is TWinControl)
then begin
WSPrivate := TWinControl(WidgetInfo^.LCLObject).WidgetSetClass.WSPrivate;
TGtkPrivateWidgetClass(WSPrivate).UpdateCursor(WidgetInfo);
Exit;
end;
end;
// no lcl cursor, so reset to default
//gdk_window_set_cursor(AWindow, PGdkCursor(DefaultCursor));
SetWindowCursor(AWindow, DefaultCursor, True);
end;
procedure Traverse(AWindow: PGDKWindow);
var
ChildWindows, ListEntry: PGList;
begin
SetToWindow(AWindow);
ChildWindows := gdk_window_get_children(AWindow);
ListEntry := ChildWindows;
while ListEntry <> nil do
begin
Traverse(PGdkWindow(ListEntry^.Data));
ListEntry := ListEntry^.Next;
end;
g_list_free(ChildWindows);
end;
var
TopList, List: PGList;
begin
TopList := gdk_window_get_toplevels;
List := TopList;
while List <> nil do
begin
if (List^.Data <> nil) then
Traverse(PGDKWindow(List^.Data));
list := g_list_next(list);
end;
if TopList <> nil then
g_list_free(TopList);
end;
begin
// set global gtk cursor
Result := FGlobalCursor;
if ACursor = FGlobalCursor then Exit;
DefaultCursor := Screen.Cursors[crDefault];
if ACursor <> DefaultCursor
then SetGlobalCursor
else ResetGlobalCursor;
if ACursor = Screen.Cursors[crDefault]
then SetGlobalCursor(0)
else SetGlobalCursor(ACursor);
FGlobalCursor := ACursor;
end;

15
lcl/interfaces/gtk2/gtk2wscontrols.pp
View File

@ -592,22 +592,21 @@ end;
class procedure TGtk2WSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor);
var
WidgetInfo: PWidgetInfo;
NewCursor: HCURSOR;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetCursor')
then Exit;
WidgetInfo := GetWidgetInfo(Pointer(AWinControl.Handle));
if (WidgetInfo^.ControlCursor = ACursor) and
(WidgetInfo^.DefaultCursor <> HCursor(-1)) then Exit;
if ACursor <> Screen.Cursors[crDefault] then
WidgetInfo^.ControlCursor := ACursor
NewCursor := ACursor
else
NewCursor := 0;
WidgetInfo := GetWidgetInfo(Pointer(AWinControl.Handle));
if WidgetInfo^.ControlCursor <> NewCursor then
begin
if WidgetInfo^.DefaultCursor = HCursor(-1) then
TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).SetDefaultCursor(WidgetInfo);
WidgetInfo^.ControlCursor := WidgetInfo^.DefaultCursor;
WidgetInfo^.ControlCursor := NewCursor;
TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WidgetInfo);
end;
TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WidgetInfo);
end;
class procedure TGtk2WSWinControl.SetFont(const AWinControl: TWinControl;

1
lcl/interfaces/gtk2/gtk2wscustomlistview.inc
View File

@ -1591,7 +1591,6 @@ begin
// already created in TGtkWSBaseScrollingWinControl
// Replace the ScrollingInfo with our info
WidgetInfo := GetWidgetInfo(ScrollWidget);
WidgetInfo^.DefaultCursor:=0;
OrigScrollingData := WidgetInfo^.UserData;
Widgets^.ScrollingData := OrigScrollingData^;

115
lcl/interfaces/gtk2/gtk2wsprivate.pp
View File

@ -60,7 +60,6 @@ type
public
class procedure SetZPosition(const AWinControl: TWinControl; const APosition: TWSZPosition); virtual;
class procedure UpdateCursor(AInfo: PWidgetInfo); virtual;
class procedure SetDefaultCursor(AInfo: PWidgetInfo); virtual;
end;
TGtkPrivateWidgetClass = class of TGtkPrivateWidget;
@ -71,7 +70,6 @@ type
private
protected
public
class procedure SetDefaultCursor(AInfo: PWidgetInfo); override;
end;
@ -259,11 +257,17 @@ type
function GetWidgetWithWindow(const AHandle: THandle): PGtkWidget;
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; ARecursive: Boolean);
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo);
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
ARecursive: Boolean; ASetDefault: Boolean);
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
ASetDefault: Boolean);
procedure SetGlobalCursor(Cursor: HCURSOR);
implementation
uses
Gtk2Extra;
{$I Gtk2PrivateWidget.inc}
{$I Gtk2PrivateList.inc}
@ -369,6 +373,68 @@ begin
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), False);
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 := 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: SetWindowCursor
Params: AWindow : PGDkWindow, ACursor: HCursor, ARecursive: Boolean
@ -376,7 +442,8 @@ end;
Sets the cursor for a window (or recursively for window with children)
------------------------------------------------------------------------------}
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor; ARecursive: Boolean);
procedure SetWindowCursor(AWindow: PGdkWindow; ACursor: HCursor;
ARecursive: Boolean; ASetDefault: Boolean);
var
Cursor: PGdkCursor;
@ -384,7 +451,7 @@ var
var
ChildWindows, ListEntry: PGList;
begin
gdk_window_set_cursor(AWindow, Cursor);
SetWindowCursor(AWindow, Cursor, ASetDefault);
ChildWindows := gdk_window_get_children(AWindow);
@ -398,10 +465,9 @@ var
end;
begin
Cursor := PGdkCursor(ACursor);
if Cursor = nil then Exit;
if ARecursive
then SetCursorRecursive(AWindow)
else gdk_window_set_cursor(AWindow, Cursor);
else SetWindowCursor(AWindow, Cursor, ASetDefault);
end;
// Helper functions
@ -421,7 +487,8 @@ begin
end;
end;
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo);
procedure SetCursorForWindowsWithInfo(AWindow: PGdkWindow; AInfo: PWidgetInfo;
ASetDefault: Boolean);
var
Cursor: PGdkCursor;
Data: gpointer;
@ -436,7 +503,7 @@ var
begin
Info := GetWidgetInfo(PGtkWidget(Data), False);
if Info = AInfo then
gdk_window_set_cursor(AWindow, Cursor);
SetWindowCursor(AWindow, Cursor, ASetDefault);
end;
ChildWindows := gdk_window_get_children(AWindow);
@ -452,9 +519,35 @@ var
begin
if AInfo = nil then Exit;
Cursor := PGdkCursor(AInfo^.ControlCursor);
if Cursor = nil then Exit;
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.

1
lcl/interfaces/gtk2/gtk2wsspin.pp
View File

@ -202,7 +202,6 @@ begin
Result := TLCLIntfHandle(PtrUInt(Widget));
WidgetInfo := CreateWidgetInfo(Widget, AWinControl, AParams);
WidgetInfo^.DefaultCursor:=0;
Set_RC_Name(AWinControl, Widget);
SetCallbacks(Widget, WidgetInfo);
end;