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

Gtk2: implemented Gtk2WSScrollingWinControl.ScrollBy(), gtk >= 2.8 uses "changed-value" instead "value-changed" on all TScrollingWinControls (GtkRange instead GtkAdjustment callbacks) from now on.NOTE: with gtk >= 2.18 users must set environment variable GDK_NATIVE_WINDOWS=1 otherwise GdkWindow paintings will be funny (when scrolling GtkScrolledWindow). fixes #7321, #10390.

Browse Source 
git-svn-id: trunk@24217 -
This commit is contained in:
zeljko 2010-03-26 11:35:06 +00:00
parent 14e8e2cf01
commit ecf56f9f71
6 changed files with 126 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
lcl/interfaces/gtk/gtkcallback.inc
View File

@ -2572,6 +2572,36 @@ begin
end;
end;
{$ifdef gtk2}
function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
var
Msg: TLMVScroll;
MaxValue: gdouble;
begin
Result := CallBackDefaultReturn;
//Assert(False, Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)]));
if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then
Msg.Msg := LM_HSCROLL
else
Msg.Msg := LM_VSCROLL;
with Msg do
begin
Pos := Round(AValue);
if Pos < High(SmallPos) then
SmallPos := Pos
else
SmallPos := High(SmallPos);
ScrollBar := HWND(PtrUInt(ARange));
ScrollCode := GtkScrollTypeToScrollCode(AScrollType);
end;
Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
end;
{$endif}
{------------------------------------------------------------------------------
Function: GTKKeySnooper
Params: Widget: The widget for which this event is fired

37
lcl/interfaces/gtk/gtkproc.inc
View File

@ -398,6 +398,30 @@ begin
end;
end;
{$ifdef gtk2}
function GtkScrollTypeToScrollCode(ScrollType: TGtkScrollType): LongWord;
begin
case ScrollType of
GTK_SCROLL_NONE : Result := SB_ENDSCROLL;
GTK_SCROLL_JUMP : Result := SB_THUMBPOSITION;
GTK_SCROLL_STEP_BACKWARD : Result := SB_LINELEFT;
GTK_SCROLL_STEP_FORWARD : Result := SB_LINERIGHT;
GTK_SCROLL_PAGE_BACKWARD : Result := SB_PAGELEFT;
GTK_SCROLL_PAGE_FORWARD : Result := SB_PAGERIGHT;
GTK_SCROLL_STEP_UP : Result := SB_LINEUP;
GTK_SCROLL_STEP_DOWN : Result := SB_LINEDOWN;
GTK_SCROLL_PAGE_UP : Result := SB_PAGEUP;
GTK_SCROLL_PAGE_DOWN : Result := SB_PAGEDOWN;
GTK_SCROLL_STEP_LEFT : Result := SB_LINELEFT;
GTK_SCROLL_STEP_RIGHT : Result := SB_LINERIGHT;
GTK_SCROLL_PAGE_LEFT : Result := SB_PAGELEFT;
GTK_SCROLL_PAGE_RIGHT : Result := SB_PAGERIGHT;
GTK_SCROLL_START : Result := SB_TOP;
GTK_SCROLL_END : Result := SB_BOTTOM;
end;
end;
{$endif}
{------------------------------------------------------------------------------
function GtkWidgetIsA(Widget: PGtkWidget; AType: TGtkType): boolean;
@ -7661,7 +7685,7 @@ end;
as main widget.
-------------------------------------------------------------------------------}
function CreateFormContents(AForm: TCustomForm;
var FormWidget: Pointer): Pointer;
var FormWidget: Pointer; AWidgetInfo: PWidgetInfo = nil): Pointer;
var
ScrolledWidget, ClientAreaWidget: PGtkWidget;
WindowStyle: PGtkStyle;
@ -7710,7 +7734,16 @@ begin
if Adjustment <> nil then
gtk_object_set_data(PGTKObject(Adjustment), odnScrollBar,
PGTKScrolledWindow(ScrolledWidget)^.hscrollbar);
{$ifdef gtk2}
if (AWidgetInfo <> nil) and
(gtk_major_version >= 2) and (gtk_minor_version > 8) then
begin
g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.hscrollbar, 'change-value',
TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
g_signal_connect(PGTKScrolledWindow(ScrolledWidget)^.vscrollbar, 'change-value',
TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
end;
{$endif}
end;
end;

15
lcl/interfaces/gtk/gtkproc.pp
View File

@ -204,9 +204,18 @@ function gtkFocusInNotifyCB (widget: PGtkWidget; event: PGdkEvent;
data: gpointer): GBoolean; cdecl;
function gtkFocusOutNotifyCB (widget: PGtkWidget; event: PGdkEvent;
data: gpointer): GBoolean; cdecl;
// PGtkAdjustment cb
function GTKHScrollCB(Adjustment: PGTKAdjustment; data: GPointer): GBoolean; cdecl;
function GTKVScrollCB(Adjustment: PGTKAdjustment;
data: GPointer): GBoolean; cdecl;
{$ifdef gtk2}
// PGtkRange cb
function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
{$endif}
function GTKCheckMenuToggeledCB(AMenuItem: PGTKCheckMenuItem;
AData: gPointer): GBoolean; cdecl;
function GTKKeySnooper(Widget: PGtkWidget; Event: PGdkEventKey;
@ -278,6 +287,9 @@ var
function RectFromGdkRect(AGdkRect: TGdkRectangle): TRect;
function GdkRectFromRect(R: TRect): TGdkRectangle;
function AlignToGtkAlign(Align: TAlignment): gfloat;
{$ifdef gtk2}
function GtkScrollTypeToScrollCode(ScrollType: TGtkScrollType): LongWord;
{$endif}
// debugging
function GtkWidgetIsA(Widget: PGtkWidget; AType: TGtkType): boolean;
@ -697,7 +709,8 @@ procedure FreeClipboardTargetEntries(ClipboardType: TClipboardType);
function GdkAtomToStr(const Atom: TGdkAtom): string;
// forms
function CreateFormContents(AForm: TCustomForm; var FormWidget: Pointer): Pointer;
function CreateFormContents(AForm: TCustomForm;
var FormWidget: Pointer; AWidgetInfo: PWidgetInfo = nil): Pointer;
// styles
type

14
lcl/interfaces/gtk/gtkwsforms.pp
View File

@ -121,12 +121,22 @@ implementation
class procedure TGtkWSScrollingWinControl.SetCallbacks(
const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
var
UseScrollCallback: Boolean;
begin
TGtkWSWinControl.SetCallbacks(PGtkObject(AWidget), TComponent(AWidgetInfo^.LCLObject));
with TGTKWidgetSet(Widgetset) do
begin
SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
{$ifdef gtk1}
UseScrollCallBack := True;
{$else}
UseScrollCallBack := (gtk_major_version = 2) and (gtk_minor_version <= 8);
{$endif}
if UseScrollCallBack then
begin
SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
end;
end;
end;

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

@ -86,65 +86,12 @@ type
published
end;
function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
implementation
uses
Gtk2Int, LMessages, Math;
{ TGtk2WSWinControl }
function GtkScrollTypeToScrollCode(ScrollType: TGtkScrollType): LongWord;
begin
case ScrollType of
GTK_SCROLL_NONE : Result := SB_ENDSCROLL;
GTK_SCROLL_JUMP : Result := SB_THUMBPOSITION;
GTK_SCROLL_STEP_BACKWARD : Result := SB_LINELEFT;
GTK_SCROLL_STEP_FORWARD : Result := SB_LINERIGHT;
GTK_SCROLL_PAGE_BACKWARD : Result := SB_PAGELEFT;
GTK_SCROLL_PAGE_FORWARD : Result := SB_PAGERIGHT;
GTK_SCROLL_STEP_UP : Result := SB_LINEUP;
GTK_SCROLL_STEP_DOWN : Result := SB_LINEDOWN;
GTK_SCROLL_PAGE_UP : Result := SB_PAGEUP;
GTK_SCROLL_PAGE_DOWN : Result := SB_PAGEDOWN;
GTK_SCROLL_STEP_LEFT : Result := SB_LINELEFT;
GTK_SCROLL_STEP_RIGHT : Result := SB_LINERIGHT;
GTK_SCROLL_PAGE_LEFT : Result := SB_PAGELEFT;
GTK_SCROLL_PAGE_RIGHT : Result := SB_PAGERIGHT;
GTK_SCROLL_START : Result := SB_TOP;
GTK_SCROLL_END : Result := SB_BOTTOM;
end;
end;
function Gtk2RangeScrollCB(ARange: PGtkRange; AScrollType: TGtkScrollType;
AValue: gdouble; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
var
Msg: TLMVScroll;
MaxValue: gdouble;
begin
Result := CallBackDefaultReturn;
//Assert(False, Format('Trace:[Gtk2RangeScrollCB] Value: %d', [RoundToInt(AValue)]));
if G_OBJECT_TYPE(ARange) = gtk_hscrollbar_get_type then
Msg.Msg := LM_HSCROLL
else
Msg.Msg := LM_VSCROLL;
with Msg do
begin
Pos := Round(AValue);
if Pos < High(SmallPos) then
SmallPos := Pos
else
SmallPos := High(SmallPos);
ScrollBar := HWND(PtrUInt(ARange));
ScrollCode := GtkScrollTypeToScrollCode(AScrollType);
end;
Result := DeliverMessage(AWidgetInfo^.LCLObject, Msg) <> 0;
end;
function Gtk2ScrolledWindowScrollCB(AScrollWindow: PGtkScrolledWindow; AEvent: PGdkEventScroll; AWidgetInfo: PWidgetInfo): gboolean; cdecl;
var
Msg: TLMVScroll;

38
lcl/interfaces/gtk2/gtk2wsforms.pp
View File

@ -46,6 +46,7 @@ type
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer); override;
end;
{ TGtk2WSScrollBox }
@ -121,8 +122,11 @@ begin
SetCallback(LM_CONFIGUREEVENT, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_CLOSEQUERY, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallBack(LM_Activate, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
if (gtk_major_version = 2) and (gtk_minor_version <= 8) then
begin
SetCallback(LM_HSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_VSCROLL, PGtkObject(AWidget), AWidgetInfo^.LCLObject);
end;
end;
g_signal_connect(PGtkObject(AWidgetInfo^.CoreWidget), gtkevent_window_state_event,
@ -198,7 +202,7 @@ begin
WidgetInfo := CreateWidgetInfo(P, AWinControl, AParams);
Box := CreateFormContents(ACustomForm, P);
Box := CreateFormContents(ACustomForm, P, WidgetInfo);
gtk_container_add(PGtkContainer(P), Box);
//so we can double buffer ourselves, eg, the Form Designer
@ -320,16 +324,25 @@ begin
// create a gtk_layout for the client area, so childs can be added at
// free x,y positions and the scrollbars automatically scrolls the childs
Layout := gtk_layout_new(nil, nil);
gtk_container_add(PGTKContainer(Scrolled), Layout);
gtk_widget_show(Layout);
SetFixedWidget(Scrolled, Layout);
SetMainWidget(Scrolled, Layout);
Result := TLCLIntfHandle(PtrUInt(Scrolled));
Set_RC_Name(AWinControl, PGtkWidget(Scrolled));
SetCallBacks(PGtkWidget(Scrolled), WidgetInfo);
if (gtk_major_version >= 2) and (gtk_minor_version > 8) then
begin
g_signal_connect(Scrolled^.hscrollbar, 'change-value',
TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
g_signal_connect(Scrolled^.vscrollbar, 'change-value',
TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
end;
end;
class procedure TGtk2WSScrollingWinControl.SetColor(
@ -344,4 +357,23 @@ begin
GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
end;
class procedure TGtk2WSScrollingWinControl.ScrollBy(
const AWinControl: TScrollingWinControl; const DeltaX, DeltaY: integer);
var
GtkWidget: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
if not AWinControl.HandleAllocated then exit;
{gtk-2.8 have problem with gtk_window_scroll
also for >= gtk2-2.18 GDK_NATIVE_WINDOW env variable must be setted
or we get paint glitches.}
if (gtk_major_version >= 2) and (gtk_minor_version > 8) then
begin
GtkWidget := PGtkWidget(AWinControl.Handle);
WidgetInfo := GetWidgetInfo(GtkWidget);
if WidgetInfo <> nil then
gdk_window_scroll(WidgetInfo^.ClientWidget^.window, -DeltaX, -DeltaY);
end;
end;
end.