paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-08 09:58:15 +02:00
Code Issues Packages Projects Releases Wiki Activity
main
lazarus/lcl/interfaces/gtk2/gtk2wscontrols.pp

1327 lines
44 KiB
ObjectPascal
Raw Permalink Blame History

{ $Id$}
{
*****************************************************************************
* Gtk2WSControls.pp *
* ----------------- *
* *
* *
*****************************************************************************
*****************************************************************************
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 Gtk2WSControls;
{$mode objfpc}{$H+}
{$I gtk2defines.inc}
interface
uses
// RTL
Classes, SysUtils,
Gtk2, Gdk2, Glib2, gdk2pixbuf,
// LazUtils
LazLoggerBase,
// LCL
////////////////////////////////////////////////////
// I M P O R T A N T
////////////////////////////////////////////////////
// To get as little as posible circles,
// uncomment only when needed for registration
////////////////////////////////////////////////////
Controls, ComCtrls, Graphics, LMessages, Forms, LCLType,
Gtk2Globals, Gtk2Def,
Gtk2Proc,
WSControls, WSProc, Gtk2WinapiWindow, Gtk2WSPrivate;
type
{ TGtk2WSDragImageListResolution }
TGtk2WSDragImageListResolution = class(TWSDragImageListResolution)
published
class function BeginDrag(const ADragImageList: TDragImageListResolution; {%H-}Window: HWND; AIndex, X, Y: Integer): Boolean; override;
class function DragMove(const {%H-}ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean; override;
class procedure EndDrag(const {%H-}ADragImageList: TDragImageListResolution); override;
class function HideDragImage(const {%H-}ADragImageList: TDragImageListResolution;
{%H-}ALockedWindow: HWND; {%H-}DoUnLock: Boolean): Boolean; override;
class function ShowDragImage(const {%H-}ADragImageList: TDragImageListResolution;
{%H-}ALockedWindow: HWND; X, Y: Integer; {%H-}DoLock: Boolean): Boolean; override;
end;
{ TGtkWSControl }
TGtk2WSControl = class(TWSControl)
published
end;
{ TGtk2WSWinControl }
TGtk2WSWinControl = class(TWSWinControl)
private
protected
public
// Internal public
class procedure SetCallbacks(const AGTKObject: PGTKObject; const AComponent: TComponent);
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
class procedure AddControl(const AControl: TControl); override;
class function CanFocus(const AWinControl: TWinControl): Boolean; override;
class procedure ConstraintsChange(const AWinControl: TWinControl); override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
class procedure Invalidate(const AWinControl: TWinControl); override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
class procedure SetChildZPosition(const AWinControl, AChild: TWinControl; const {%H-}AOldPos, ANewPos: Integer; const AChildren: TFPList); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetCursor(const AWinControl: TWinControl; const ACursor: HCursor); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetSize(const AWinControl: TWinControl; const AWidth, AHeight: Integer); override;
class procedure SetPos(const AWinControl: TWinControl; const ALeft, ATop: Integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetShape(const AWinControl: TWinControl; const AShape: HBITMAP); override;
class procedure SetBiDiMode(const AWinControl: TWinControl; UseRightToLeftAlign, {%H-}UseRightToLeftReading, {%H-}UseRightToLeftScrollBar : Boolean); override;
class procedure PaintTo(const AWinControl: TWinControl; ADC: HDC; X, Y: Integer); override;
class procedure Repaint(const AWinControl: TWinControl); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TGtk2WSGraphicControl }
TGtk2WSGraphicControl = class(TWSGraphicControl)
published
end;
{ TGtk2WSCustomControl }
TGtk2WSCustomControl = class(TWSCustomControl)
published
end;
{ TGtk2WSImageList }
TGtk2WSImageList = class(TWSImageList)
published
end;
{ TGtkWSBaseScrollingWinControl }
{
TGtkWSBaseScrollingWinControl is a shared gtk only base implementation of
all scrolling widgets, like TListView, TScrollingWinControl etc.
It only creates a scrolling widget and handles the LM_HSCROLL and LM_VSCROLL
messages
}
PBaseScrollingWinControlData = ^TBaseScrollingWinControlData;
TBaseScrollingWinControlData = record
HValue: Integer;
HScroll: PGTKWidget;
VValue: Integer;
VScroll: PGTKWidget;
end;
{ TGtk2ListBoxPrivateList }
{ Private class for gtklists }
TGtk2ListBoxPrivateList = class(TGtkPrivateList)
private
protected
public
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); override;
end;
{ TGtk2WSBaseScrollingWinControl }
TGtk2WSBaseScrollingWinControl = class(TWSWinControl)
public
class procedure SetCallbacks(const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): HWND; override;
end;
function GetWidgetHAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
function GetWidgetVAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
var
HasWarnedLibOverlay: boolean = false;
implementation
uses
Gtk2Int;
{ TGtk2WSWinControl }
class function TGtk2WSWinControl.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): HWND;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
ScrollBar: PGtkWidget;
Adjustment: PGtkAdjustment;
begin
Widget := GTK2WidgetSet.CreateAPIWidget(AWinControl);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
Result := {%H-}HWND(Widget);
if Result = 0 then Exit;
WidgetInfo := GetWidgetInfo(Widget); // Widget info already created in CreateAPIWidget
WidgetInfo^.Style := AParams.Style;
WidgetInfo^.ExStyle := AParams.ExStyle;
WidgetInfo^.WndProc := {%H-}PtrUInt(AParams.WindowClass.lpfnWndProc);
// set allocation
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(Widget, @Allocation);
Set_RC_Name(AWinControl, Widget);
TGtk2WSWinControl.SetCallbacks(GTK_OBJECT(Widget), AWinControl);
// scrollbars
if (GetWidgetClassName(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar)='OsScrollbar')
or (GetWidgetClassName(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar)='OsScrollbar')
then begin
// ubuntu liboverlay scrollbar is active
if not HasWarnedLibOverlay then begin
HasWarnedLibOverlay:=true;
debugln(['WARNING: liboverlay_scrollbar is active for control=',AWinControl,'. Set environment option LIBOVERLAY_SCROLLBAR=0 before starting this application, otherwise scrollbars will not work properly.']);
end;
end;
ScrollBar:=GTK_SCROLLED_WINDOW(Widget)^.hscrollbar;
if (GetWidgetClassName(ScrollBar)='OsScrollbar')
then begin
// the ubuntu scroll bar eats the change-value signal => use value-changed
Adjustment:=gtk_scrolled_window_get_hadjustment(GTK_SCROLLED_WINDOW(Widget));
g_signal_connect_after(Adjustment, 'value-changed',TGCallback(@Gtk2RangeUbuntuScrollCB), WidgetInfo);
end else begin
g_signal_connect_after(ScrollBar, 'change-value',
TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
end;
ScrollBar:=GTK_SCROLLED_WINDOW(Widget)^.vscrollbar;
if (GetWidgetClassName(ScrollBar)='OsScrollbar')
then begin
// the ubuntu scroll bar eats the change-value signal => use value-changed
Adjustment:=gtk_scrolled_window_get_vadjustment(GTK_SCROLLED_WINDOW(Widget));
g_signal_connect_after(Adjustment, 'value-changed',TGCallback(@Gtk2RangeUbuntuScrollCB), WidgetInfo);
end else begin
g_signal_connect_after(ScrollBar, 'change-value',
TGCallback(@Gtk2RangeScrollCB), WidgetInfo);
end;
g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar, 'button-press-event',
TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.hscrollbar, 'button-release-event',
TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar, 'button-press-event',
TGCallback(@Gtk2RangeScrollPressCB), WidgetInfo);
g_signal_connect(GTK_SCROLLED_WINDOW(Widget)^.vscrollbar, 'button-release-event',
TGCallback(@Gtk2RangeScrollReleaseCB), WidgetInfo);
g_signal_connect(Widget, 'scroll-event', TGCallback(@Gtk2ScrolledWindowScrollCB), WidgetInfo);
end;
class procedure TGtk2WSWinControl.SetBiDiMode(const AWinControl : TWinControl;
UseRightToLeftAlign, UseRightToLeftReading, UseRightToLeftScrollBar : Boolean
);
const
WidgetDirection : array[boolean] of longint = (GTK_TEXT_DIR_LTR, GTK_TEXT_DIR_RTL);
var
Info: PWidgetInfo;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetBiDiMode') then
Exit;
gtk_widget_set_direction({%H-}PGtkWidget(AWinControl.Handle),
WidgetDirection[UseRightToLeftAlign]);
Info := GetWidgetInfo({%H-}PGtkWidget(AWinControl.Handle));
if Info <> nil then
begin
if Info^.CoreWidget <> nil then
gtk_widget_set_direction(Info^.CoreWidget,
WidgetDirection[UseRightToLeftAlign]);
if Info^.ClientWidget <> nil then
gtk_widget_set_direction(Info^.ClientWidget,
WidgetDirection[UseRightToLeftAlign]);
end;
end;
function Gtk1GetText(const AWinControl: TWinControl; var AText: String): Boolean;
var
CS: PChar;
Handle: HWND;
begin
if not WSCheckHandleAllocated(AWinControl, 'GetText')
then Exit(False);
Result := true;
Handle := AWinControl.Handle;
case AWinControl.fCompStyle of
csComboBox:
begin
AText := StrPas(gtk_entry_get_text(PGtkEntry({%H-}PGtkCombo(Handle)^.entry)));
end;
csEdit: AText:= StrPas(gtk_entry_get_text({%H-}PgtkEntry(Handle)));
csSpinEdit: AText:= StrPas(gtk_entry_get_text(@{%H-}PGtkSpinButton(Handle)^.entry));
csMemo:
begin
CS := gtk_editable_get_chars(PGtkEditable(
GetOrCreateWidgetInfo({%H-}Pointer(Handle))^.CoreWidget), 0, -1);
AText := StrPas(CS);
g_free(CS);
end;
else
Result := false;
end;
end;
class function TGtk2WSWinControl.GetText(const AWinControl: TWinControl;
var AText: String): Boolean;
var
TextBuf: PGtkTextBuffer;
StartIter,
EndIter: TGtkTextIter;
CS: PChar;
Handle: HWND;
begin
Result := true;
Handle := AWinControl.Handle;
case AWinControl.fCompStyle of
csMemo:
begin
TextBuf := gtk_text_view_get_buffer(PGtkTextView(GetOrCreateWidgetInfo({%H-}Pointer(Handle))^.CoreWidget));
gtk_text_buffer_get_start_iter(TextBuf, @StartIter);
gtk_text_buffer_get_end_iter(TextBuf, @EndIter);
CS := gtk_text_buffer_get_text(TextBuf, @StartIter, @EndIter, False);
AText := StrPas(CS);
g_free(CS);
end;
else
Result:=Gtk1GetText(AWinControl, AText);
end;
end;
procedure Gtk1SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetBorderStyle')
then Exit;
Widget := {%H-}PGtkWidget(AWinControl.Handle);
if GtkWidgetIsA(Widget, GTKAPIWidget_GetType) then
GTKAPIWidget_SetShadowType(PGTKAPIWidget(Widget), BorderStyleShadowMap[ABorderStyle])
else
if GTK_IS_FRAME(Widget) then
gtk_frame_set_shadow_type(PGtkFrame(Widget), BorderStyleShadowMap[ABorderStyle])
else
if GTK_IS_VIEWPORT(Widget) then
gtk_viewport_set_shadow_type(PGtkViewport(Widget), BorderStyleShadowMap[ABorderStyle]);
end;
class procedure TGtk2WSWinControl.SetBorderStyle(
const AWinControl: TWinControl; const ABorderStyle: TBorderStyle);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetBorderStyle')
then Exit;
Widget := {%H-}PGtkWidget(AWinControl.Handle);
if GTK_IS_SCROLLED_WINDOW(Widget) then
gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(Widget), BorderStyleShadowMap[ABorderStyle])
else
if GTK_IS_ENTRY(Widget) then
gtk_entry_set_has_frame(PGtkEntry(Widget), ABorderStyle <> bsNone)
else
Gtk1SetBorderStyle(AWinControl, ABorderStyle);
end;
function GetWidgetHAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
begin
if GtkWidgetIsA(AWidget,GTK_TYPE_SCROLLED_WINDOW) then
Result:=gtk_scrolled_window_get_hadjustment(PGTKScrolledWindow(AWidget))
else if GtkWidgetIsA(AWidget,GTK_TYPE_TREE_VIEW) then
Result:=gtk_tree_view_get_hadjustment(PGtkTreeView(AWidget))
else
Result:=nil;
end;
function GetWidgetVAdjustment(AWidget: PGTKWidget): PGTKAdjustment;
begin
if GtkWidgetIsA(AWidget,GTK_TYPE_SCROLLED_WINDOW) then
Result:=gtk_scrolled_window_get_vadjustment(PGTKScrolledWindow(AWidget))
else if GtkWidgetIsA(AWidget,GTK_TYPE_TREE_VIEW) then
Result:=gtk_tree_view_get_vadjustment(PGtkTreeView(AWidget))
else
Result:=nil;
end;
{ TGtk2WSDragImageListResolution }
class function TGtk2WSDragImageListResolution.BeginDrag(
const ADragImageList: TDragImageListResolution; Window: HWND; AIndex, X, Y: Integer
): Boolean;
var
ABitmap: TBitmap;
GDIObject: PGDIObject;
Pixmap: PGdkPixmap;
Mask: PGdkBitmap;
begin
ABitmap := TBitmap.Create;
ADragImageList.GetBitmap(AIndex, ABitmap);
if (ABitmap.Handle = 0) or (ABitmap.Width = 0) or (ABitmap.Height = 0) then
begin
Result := False;
Exit;
end;
GDIObject := {%H-}PGDIObject(ABitmap.Handle);
Pixmap := nil;
Mask := nil;
case GDIObject^.GDIBitmapType of
gbBitmap:
begin
Pixmap := GDIObject^.GDIBitmapObject;
gdk_bitmap_ref(Pixmap);
Mask := nil;
end;
gbPixmap:
begin
Pixmap := GDIObject^.GDIPixmapObject.Image;
Mask := GDIObject^.GDIPixmapObject.Mask;
gdk_pixmap_ref(Pixmap);
gdk_bitmap_ref(Mask);
end;
gbPixbuf:
begin
Pixmap := nil;
Mask := nil;
// todo: TEST
//gdk_pixbuf_render_pixmap_and_mask(GDIObject^.GDIPixbufObject, Pixmap, Mask, $80);
gdk_pixbuf_render_pixmap_and_mask(GDIObject^.GDIPixbufObject, Pixmap, Mask, $80);
end;
end;
Result := Gtk2Widgetset.DragImageList_BeginDrag(Pixmap, Mask, ADragImageList.DragHotSpot);
if Result then
Gtk2Widgetset.DragImageList_DragMove(X, Y);
gdk_pixmap_unref(Pixmap);
gdk_bitmap_unref(Mask);
ABitmap.Free;
end;
class function TGtk2WSDragImageListResolution.DragMove(
const ADragImageList: TDragImageListResolution; X, Y: Integer): Boolean;
begin
Result := Gtk2Widgetset.DragImageList_DragMove(X, Y);
end;
class procedure TGtk2WSDragImageListResolution.EndDrag(
const ADragImageList: TDragImageListResolution);
begin
Gtk2Widgetset.DragImageList_EndDrag;
end;
class function TGtk2WSDragImageListResolution.HideDragImage(
const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; DoUnLock: Boolean
): Boolean;
begin
Result := Gtk2Widgetset.DragImageList_SetVisible(False);
end;
class function TGtk2WSDragImageListResolution.ShowDragImage(
const ADragImageList: TDragImageListResolution; ALockedWindow: HWND; X, Y: Integer;
DoLock: Boolean): Boolean;
begin
Result := Gtk2Widgetset.DragImageList_DragMove(X, Y) and Gtk2Widgetset.DragImageList_SetVisible(True);
end;
{ TGtk2WSWinControl }
type
TWinControlHack = class(TWinControl)
end;
function Gtk2TreeViewEditorEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
var
R: TRect;
Alloc: TGtkAllocation;
w: PGtkWidget;
AOrientation: TGtkOrientation;
begin
Result := CallBackDefaultReturn;
case event^._type of
GDK_FOCUS_CHANGE:
begin
// cheat GtkTreeView container , so we are visible and ready for input.
if event^.focus_change._in = 1 then
begin
R := TWinControl(Data).BoundsRect;
Alloc.x := R.Left;
Alloc.y := R.Top;
Alloc.width := R.Right - R.Left;
Alloc.height := R.Bottom - R.Top;
gtk_widget_size_allocate(Widget, @Alloc);
end else
begin
w := gtk_widget_get_parent(Widget);
if Assigned(w) and GTK_IS_ICON_VIEW(w) then
begin
//gtk2 does not layout items correctly when iconArrangement is iaTop.
//so we force it to do so.
AOrientation := gtk_icon_view_get_orientation(PGtkIconView(w));
if AOrientation = GTK_ORIENTATION_HORIZONTAL then
gtk_icon_view_set_orientation(PGtkIconView(w), GTK_ORIENTATION_VERTICAL)
else
gtk_icon_view_set_orientation(PGtkIconView(w), GTK_ORIENTATION_HORIZONTAL);
gtk_icon_view_set_orientation(PGtkIconView(w), AOrientation)
end;
end;
end;
end;
end;
class procedure TGtk2WSWinControl.AddControl(const AControl: TControl);
var
AParent: TWinControl;
ParentWidget: PGTKWidget;
ChildWidget: PGTKWidget;
pFixed: PGTKWidget;
begin
AParent := TWinControl(AControl).Parent;
// DebugLn('LM_AddChild: ',dbgsName(AControl),' ',dbgs(AParent<>nil));
if not Assigned(AParent) then
Assert(true, Format('Trace: [TGtkWSWinControl.AddControl] %s --> Parent is not assigned', [AControl.ClassName]))
else
begin
// DebugLn(Format('Trace: [TGtkWSWinControl.AddControl] %s --> Calling Add Child: %s', [AParent.ClassName, AControl.ClassName]));
ParentWidget := {%H-}PGtkwidget(AParent.Handle);
pFixed := GetFixedWidget(ParentWidget);
// gtk2 is pretty tricky about adding editor into control
if (AParent.FCompStyle = csListView) and
(TWinControl(AControl).FCompStyle = csEdit) then
begin
ChildWidget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
ParentWidget := gtk_bin_get_child(PGtkBin(PFixed)); // treeview
// MUST allocate some size before adding it to container !
gtk_widget_set_size_request(ChildWidget, 80, 25);
gtk_widget_set_parent(ChildWidget, ParentWidget);
// now we connect our GtkEntry directly to event filter
g_signal_connect(PGtkObject(ChildWidget), 'event',
gtk_signal_func(@Gtk2TreeViewEditorEvent), AControl);
end else
begin
if pFixed <> ParentWidget then
begin
// parent changed for child
ChildWidget := {%H-}PGtkWidget(TWinControl(AControl).Handle);
FixedPutControl(pFixed, ChildWidget, AControl.Left, AControl.Top);
RegroupAccelerator(ChildWidget);
end;
end;
end;
end;
class function TGtk2WSWinControl.CanFocus(const AWinControl: TWinControl): Boolean;
var
Widget, FocusWidget: PGtkWidget;
begin
if AWinControl.HandleAllocated then
begin
Widget := {%H-}PGtkWidget(AWinControl.Handle);
FocusWidget := FindFocusWidget(Widget);
Result := (FocusWidget <> nil) and GTK_WIDGET_CAN_FOCUS(FocusWidget);
end else
Result := False;
end;
class procedure TGtk2WSWinControl.ConstraintsChange(const AWinControl: TWinControl);
begin
SetWidgetConstraints(AWinControl);
end;
class procedure TGtk2WSWinControl.DestroyHandle(const AWinControl: TWinControl);
begin
//DebugLn('TGtk2WSWinControl.DestroyHandle ',DbgSName(AWinControl));
Gtk2WidgetSet.DestroyLCLComponent(AWinControl);
end;
class procedure TGtk2WSWinControl.Invalidate(const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'Invalidate')
then Exit;
//DebugLn('Trace:Trying to invalidate window... !!!');
gtk_widget_queue_draw({%H-}PGtkWidget(AWinControl.Handle));
end;
class procedure TGtk2WSWinControl.ShowHide(const AWinControl: TWinControl);
begin
// other methods use ShowHide also, can't move code
Gtk2WidgetSet.SetVisible(AWinControl, AWinControl.HandleObjectShouldBeVisible);
InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
end;
class procedure TGtk2WSWinControl.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Scrolled: PGtkScrolledWindow;
Adjustment: PGtkAdjustment;
h, v: Double;
NewPos: Double;
begin
if not AWinControl.HandleAllocated then exit;
Scrolled := GTK_SCROLLED_WINDOW({%H-}Pointer(AWinControl.Handle));
if not GTK_IS_SCROLLED_WINDOW(Scrolled) then
exit;
Adjustment := gtk_scrolled_window_get_hadjustment(Scrolled);
if Adjustment <> nil then
begin
h := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if h - DeltaX <= NewPos then
NewPos := h - DeltaX;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
Adjustment := gtk_scrolled_window_get_vadjustment(Scrolled);
if Adjustment <> nil then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - DeltaY <= NewPos then
NewPos := v - DeltaY;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
AWinControl.Invalidate;
end;
class procedure TGtk2WSWinControl.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
AForm: TCustomForm;
Geometry: TGdkGeometry;
AHints: TGdkWindowHints;
AFixedWidthHeight: Boolean;
clientRectFix: TRect;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetBounds')
then Exit;
ResizeHandle(AWinControl);
InvalidateLastWFPResult(AWinControl, Bounds(ALeft, ATop, AWidth, AHeight));
if not AWinControl.Visible then // Gtk2WSForms.ShowHide will correct visibility
exit;
if (not (AWinControl is TCustomForm)) or (AWinControl.Parent<>nil)
or (AWinControl.ParentWindow<>0) then
exit;
AForm := TCustomForm(AWinControl);
if not (csDesigning in AForm.ComponentState) and
AForm.HandleObjectShouldBeVisible then
begin
clientRectFix:= GetWidgetInfo(PGtkWidget(AForm.Handle))^.FormClientRectFix;
// we must set fixed size, gtk_window_set_resizable does not work
// as expected for some reason.issue #20741.
// Constraints fix issue #29563
AFixedWidthHeight := AForm.BorderStyle in [bsDialog, bsSingle, bsToolWindow];
FillChar(Geometry{%H-}, SizeOf(TGdkGeometry), 0);
with Geometry do
begin
if not AFixedWidthHeight and (AForm.Constraints.MinWidth > 0) then
min_width := AForm.Constraints.MinWidth
else
if AFixedWidthHeight then
min_width := AForm.Width;
if not AFixedWidthHeight and (AForm.Constraints.MaxWidth > 0) then
max_width := AForm.Constraints.MaxWidth
else
if AFixedWidthHeight then
max_width := AForm.Width;
if not AFixedWidthHeight and (AForm.Constraints.MinHeight > 0) then
min_height := AForm.Constraints.MinHeight
else
if AFixedWidthHeight then
min_height := AForm.Height;
if not AFixedWidthHeight and (AForm.Constraints.MaxHeight > 0) then
max_height := AForm.Constraints.MaxHeight
else
if AFixedWidthHeight then
max_height := AForm.Height;
if not AFixedWidthHeight and (AForm.Constraints.MaxHeight = 0) then
max_height := 32767;
if not AFixedWidthHeight and (AForm.Constraints.MaxWidth = 0) then
max_width := 32767;
if min_width>0 then inc(min_width, clientRectFix.Width);
if max_width>0 then inc(max_width, clientRectFix.Width);
if min_height>0 then inc(min_height, clientRectFix.Height);
if max_height>0 then inc(max_height, clientRectFix.Height);
base_width := AForm.Width + clientRectFix.Width;
base_height := AForm.Height + clientRectFix.Height;
width_inc := 1;
height_inc := 1;
min_aspect := 0;
max_aspect := 1;
win_gravity := gtk_window_get_gravity({%H-}PGtkWindow(AForm.Handle));
end;
//debugln('TGtk2WSWinControl.SetBounds A maxw=',dbgs(Geometry.max_width),' maxh=',dbgs(Geometry.max_height),
//' base w=',dbgs(Geometry.base_width),' h=',dbgs(Geometry.base_height));
if AFixedWidthHeight then
gtk_window_set_geometry_hints({%H-}PGtkWindow(AForm.Handle), nil, @Geometry,
GDK_HINT_POS or GDK_HINT_MIN_SIZE or GDK_HINT_MAX_SIZE)
else
begin
if AForm.BorderStyle <> bsNone then
begin
AHints := GDK_HINT_POS or GDK_HINT_BASE_SIZE;
if (AForm.Constraints.MinHeight > 0) or (AForm.Constraints.MinWidth > 0) then
AHints := AHints or GDK_HINT_MIN_SIZE;
if (AForm.Constraints.MaxHeight > 0) or (AForm.Constraints.MaxWidth > 0) then begin
AHints := AHints or GDK_HINT_MAX_SIZE;
{ Work around for only one maximum specified; see TGtk2WSWinControl.ConstraintsChange }
if AForm.Constraints.MaxHeight = 0 then
Geometry.max_height := 32767;
if AForm.Constraints.MaxWidth = 0 then
Geometry.max_width := 32767;
end;
{$IFDEF HASX}
if (AHints and GDK_HINT_MIN_SIZE = 0) and (AHints and GDK_HINT_MAX_SIZE = 0) and
(Gtk2WidgetSet.GetWindowManager = 'openbox') then
else
{$ENDIF}
gtk_window_set_geometry_hints({%H-}PGtkWindow(AForm.Handle), nil, @Geometry,
AHints);
end;
if LockTopLevelWindowResizeOnNativeCall then
begin
if TopLevelWindowResizeLocked = 0 then
SetWindowSizeAndPosition({%H-}PGtkWindow(AForm.Handle), AForm);
end
else
gtk_window_resize({%H-}PGtkWindow(AForm.Handle),
AForm.Width + clientRectFix.Width,
AForm.Height + clientRectFix.Height);
end;
end;
end;
class procedure TGtk2WSWinControl.SetCallbacks(const AGTKObject: PGTKObject;
const AComponent: TComponent);
begin
Gtk2WidgetSet.SetCommonCallbacks(AGtkObject, AComponent);
end;
class procedure TGtk2WSWinControl.SetChildZPosition(
const AWinControl, AChild: TWinControl;
const AOldPos, ANewPos: Integer; const AChildren: TFPList);
var
n: Integer;
child: TWinControlHack;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetChildZPosition')
then Exit;
if not WSCheckHandleAllocated(AChild, 'SetChildZPosition (child)') then
Exit;
if (ANewPos <= 0) or (ANewPos >= AChildren.Count - 1) then
begin
// simple
Child := TWinControlHack(AChild);
if ANewPos <= 0 then // bottom
TGtkPrivateWidgetClass(
Child.WidgetSetClass.WSPrivate).SetZPosition(Child, wszpBack)
else
TGtkPrivateWidgetClass(
Child.WidgetSetClass.WSPrivate).SetZPosition(Child, wszpFront);
end else
begin
for n := 1 to AChildren.Count - 1 do
begin
Child := TWinControlHack(AChildren[n]);
if Child.HandleAllocated then
TGtkPrivateWidgetClass(
Child.WidgetSetClass.WSPrivate).SetZPosition(Child, wszpBack);
end;
end;
end;
class procedure TGtk2WSWinControl.SetCursor(const AWinControl: TWinControl; const ACursor: HCursor);
var
WidgetInfo: PWidgetInfo;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetCursor')
then Exit;
WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
if WidgetInfo^.ControlCursor <> ACursor then
begin
WidgetInfo^.ControlCursor := ACursor;
TGtkPrivateWidgetClass(AWinControl.WidgetSetClass.WSPrivate).UpdateCursor(WidgetInfo);
end;
end;
class procedure TGtk2WSWinControl.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetFont')
then Exit;
Widget := {%H-}PGtkWidget(AWinControl.Handle);
if GtkWidgetIsA(Widget, GTKAPIWidget_GetType) then
exit;
//DebugLn('TGtk2WSWinControl.SetFont ',DbgSName(AWinControl));
Gtk2WidgetSet.SetWidgetFont(Widget, AFont);
Gtk2WidgetSet.SetWidgetColor(Widget, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
GTK_STATE_PRELIGHT,GTK_STATE_SELECTED,
GTK_STYLE_TEXT]);
end;
class procedure TGtk2WSWinControl.SetPos(const AWinControl: TWinControl;
const ALeft, ATop: Integer);
var
Widget: PGtkWidget;
Allocation: TGTKAllocation;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetPos')
then Exit;
{$IFDEF VerboseSizeMsg}
DebugLn(['TGtk2WSWinControl.SetPos ',DbgSName(AWinControl),' ',ALeft,',',ATop]);
{$ENDIF}
Widget := {%H-}PGtkWidget(AWinControl.Handle);
Allocation.X := gint16(ALeft);
Allocation.Y := gint16(ATop);
Allocation.Width := guint16(Widget^.Allocation.Width);
Allocation.Height := guint16(Widget^.Allocation.Height);
gtk_widget_size_allocate(Widget, @Allocation);// Beware: this triggers callbacks
end;
class procedure TGtk2WSWinControl.SetSize(const AWinControl: TWinControl;
const AWidth, AHeight: Integer);
var
Widget: PGtkWidget;
Allocation: TGTKAllocation;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetSize')
then Exit;
{$IFDEF VerboseSizeMsg}
DebugLn(['TGtk2WSWinControl.SetSize ',DbgSName(AWinControl),' ',AWidth,',',AHeight]);
{$ENDIF}
Widget := {%H-}PGtkWidget(AWinControl.Handle);
Allocation.X := Widget^.Allocation.X;
Allocation.Y := Widget^.Allocation.Y;
Allocation.Width := guint16(AWidth);
Allocation.Height := guint16(AHeight);
gtk_widget_size_allocate(Widget, @Allocation);// Beware: this triggers callbacks
end;
class procedure TGtk2WSWinControl.SetColor(const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor')
then Exit;
// do not change color of scrollbar. issue #22996
if (AWinControl.FCompStyle = csScrollBar) then
exit;
if ((csOpaque in AWinControl.ControlStyle) and
GtkWidgetIsA({%H-}pGtkWidget(AWinControl.handle),GTKAPIWidget_GetType)) then
Exit;
//DebugLn('TGtk2WSWinControl.SetColor ',DbgSName(AWinControl));
Gtk2WidgetSet.SetWidgetColor({%H-}PGtkWidget(AWinControl.Handle),
AWinControl.Font.Color, AWinControl.Color,
[GTK_STATE_NORMAL, GTK_STATE_ACTIVE,
GTK_STATE_PRELIGHT, GTK_STATE_SELECTED]);
// GtkWidgetSet.setWidgetFont(pGtkWidget(AWinControl.handle),aWinControl.font);
UpdateWidgetStyleOfControl(AWinControl);
end;
class procedure TGtk2WSWinControl.SetText(const AWinControl: TWinControl;
const AText: string);
procedure SetNotebookPageTabLabel;
var
NoteBookWidget: PGtkWidget; // the notebook
PageWidget: PGtkWidget; // the page (content widget)
TabWidget: PGtkWidget; // the tab (hbox containing a pixmap, a label
// and a close button)
TabLabelWidget: PGtkWidget; // the label in the tab
MenuWidget: PGtkWidget; // the popup menu (hbox containing a pixmap and
// a label)
MenuLabelWidget: PGtkWidget; // the label in the popup menu item
NewText: PChar;
begin
if (AWinControl.Parent <> nil) and (AWinControl.Parent is TTabControl) then
exit;
// dig through the hierachy to get the labels
NoteBookWidget:={%H-}PGtkWidget((AWinControl.Parent).Handle);
PageWidget:={%H-}PGtkWidget(AWinControl.Handle);
TabWidget:=gtk_notebook_get_tab_label(PGtkNoteBook(NotebookWidget),
PageWidget);
if TabWidget<>nil then
TabLabelWidget:=g_object_get_data(PGObject(TabWidget), 'TabLabel')
else
TabLabelWidget:=nil;
MenuWidget:=gtk_notebook_get_menu_label(PGtkNoteBook(NotebookWidget),
PageWidget);
if MenuWidget<>nil then
MenuLabelWidget:=g_object_get_data(PGObject(MenuWidget), 'TabMenuLabel')
else
MenuLabelWidget:=nil;
// set new text
NewText:=PChar(AText);
if TabLabelWidget<>nil then
gtk_label_set_text(pGtkLabel(TabLabelWidget), NewText);
if MenuLabelWidget<>nil then
gtk_label_set_text(pGtkLabel(MenuLabelWidget), NewText);
end;
var
P : Pointer;
aLabel, pLabel: pchar;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetText')
then Exit;
//TODO: create classprocedures for this in the corresponding classes
P := {%H-}Pointer(AWinControl.Handle);
Assert(p <> nil, 'Trace:WARNING: [TGtkWidgetSet.SetLabel] --> got nil pointer');
//DebugLn('Trace:Setting Str1 in SetLabel');
pLabel := pchar(AText);
case AWinControl.fCompStyle of
csBitBtn,
csButton: DebugLn('[WARNING] Obsolete call to TGTKOBject.SetLabel for ', AWinControl.ClassName);
csForm,
csFileDialog, csOpenFileDialog, csSaveFileDialog, csSelectDirectoryDialog,
csPreviewFileDialog,
csColorDialog,
csFontDialog:
if GtkWidgetIsA(p,gtk_window_get_type) then
gtk_window_set_title(pGtkWindow(p),PLabel);
csCheckBox,
csToggleBox,
csRadioButton:
begin
aLabel := Ampersands2Underscore(PLabel);
try
gtk_label_set_text(
pGtkLabel(gtk_bin_get_child(PGtkBin(@PGTKToggleButton(p)^.Button))),
aLabel);
gtk_label_parse_uline(
pGtkLabel(gtk_bin_get_child(PGtkBin(@PGTKToggleButton(p)^.Button))),
aLabel);
finally
StrDispose(aLabel);
end;
end;
csEdit:
begin
LockOnChange(PGtkObject(p),+1);
gtk_entry_set_text(pGtkEntry(P), pLabel);
LockOnChange(PGtkObject(p),-1);
end;
csSpinEdit:
begin
LockOnChange(PGtkObject(p),+1);
gtk_entry_set_text(pGtkEntry(P), pLabel);
gtk_spin_button_update(PGtkSpinButton(p));
LockOnChange(PGtkObject(p),-1);
end;
csMemo:
begin
P:= GetOrCreateWidgetInfo(P)^.CoreWidget;
//debugln('TGtk2WSWinControl.SetText A ',dbgs(gtk_text_get_length(PGtkText(P))),' AText="',AText,'"');
gtk_text_freeze(PGtkText(P));
gtk_text_set_point(PGtkText(P), 0);
gtk_text_forward_delete(PGtkText(P), gtk_text_get_length(PGtkText(P)));
gtk_text_insert(PGtkText(P), nil, nil, nil, pLabel, -1);
gtk_text_thaw(PGtkText(P));
//debugln('TGtk2WSWinControl.SetText B ',dbgs(gtk_text_get_length(PGtkText(P))));
end;
csPage:
SetNotebookPageTabLabel;
// else
// DebugLn('WARNING: [TGtkWidgetSet.SetLabel] --> not handled for class ',Sender.ClassName);
end;
//DebugLn(Format('trace: [TGtkWidgetSet.SetLabel] %s --> END', [AWinControl.ClassName]));
end;
class procedure TGtk2WSWinControl.SetShape(const AWinControl: TWinControl;
const AShape: HBITMAP);
var
GtkWidget, FixedWidget: PGtkWidget;
GdkBitmap: PGDKBitmap;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetShape') then
Exit;
GtkWidget := {%H-}PGtkWidget(AWinControl.Handle);
FixedWidget := GetFixedWidget(GtkWidget);
if AShape <> 0 then
begin
if Gtk2Widgetset.IsValidGDIObjectType(AShape, gdiBitmap) then
GdkBitmap := {%H-}PGdiObject(AShape)^.GDIBitmapObject
else
GdkBitmap := nil;
end
else
GdkBitmap := nil;
gtk_widget_shape_combine_mask(GtkWidget, GdkBitmap, 0, 0);
if FixedWidget <> GtkWidget then
gtk_widget_shape_combine_mask(FixedWidget, GdkBitmap, 0, 0);
end;
{
Paint control to X, Y point of device context.
}
class procedure TGtk2WSWinControl.PaintTo(const AWinControl: TWinControl;
ADC: HDC; X, Y: Integer);
var
DC: TGtkDeviceContext absolute ADC;
procedure PaintGtkForm(AWindow: PGdkWindow);
var
W, H: gint;
Pixbuf: PGdkPixbuf;
MenuPixBuf: PGdkPixBuf;
AMenuBar: PGtkWidget;
OffsetY: Integer;
begin
OffsetY := 0;
MenuPixBuf := nil;
if Assigned(TCustomForm(AWinControl).Menu) then
begin
AMenuBar := {%H-}PGtkWidget(TCustomForm(AWinControl).Menu.Handle);
if GTK_IS_MENU_BAR(AMenuBar) and GTK_WIDGET_VISIBLE(AMenuBar) then
begin
OffsetY := AMenuBar^.allocation.height;
MenuPixbuf := gdk_pixbuf_get_from_drawable(nil, AMenuBar^.Window, nil,
0, 0, 0, 0, AMenuBar^.allocation.Width, AMenuBar^.Allocation.Height);
gdk_pixbuf_render_to_drawable(MenuPixbuf, DC.Drawable, DC.GC, 0, 0, X, Y + OffsetY,
AMenuBar^.allocation.Width, AMenuBar^.Allocation.Height, GDK_RGB_DITHER_NONE, 0, 0);
gdk_pixbuf_unref(MenuPixbuf);
end;
end;
gdk_window_get_size(AWindow, @W, @H);
Pixbuf := gdk_pixbuf_get_from_drawable(nil, AWindow, nil,
0, 0, 0, 0, W, H);
// put menubar into form screenshoot too
if OffsetY <> 0 then
begin
MenuPixBuf := gdk_pixbuf_scale_simple(PixBuf, W, H - OffsetY,GDK_INTERP_NEAREST);
gdk_pixbuf_render_to_drawable(MenuPixbuf, DC.Drawable, DC.GC, 0, 0, X, Y + (OffsetY * 2),
-1, -1, GDK_RGB_DITHER_NONE, 0, 0);
if MenuPixBuf <> nil then
gdk_pixbuf_unref(MenuPixBuf);
end else
gdk_pixbuf_render_to_drawable(Pixbuf, DC.Drawable, DC.GC, 0, 0, X, Y,
-1, -1, GDK_RGB_DITHER_NONE, 0, 0);
gdk_pixbuf_unref(Pixbuf);
end;
procedure PaintWindow(AWindow: PGdkWindow);
var
W, H: gint;
Pixbuf: PGdkPixbuf;
begin
gdk_window_get_size(AWindow, @W, @H);
// for some reason gdk_window_copy_area does not work
Pixbuf := gdk_pixbuf_get_from_drawable(nil, AWindow, nil,
0, 0, 0, 0, W, H);
gdk_pixbuf_render_to_drawable(Pixbuf, DC.Drawable, DC.GC, 0, 0, X, Y,
-1, -1, GDK_RGB_DITHER_NONE, 0, 0);
gdk_pixbuf_unref(Pixbuf);
end;
procedure PaintWidget(AWidget: PGtkWidget);
var
AWindow: PGdkWindow;
begin
if (AWinControl.FCompStyle = csForm) then
PaintGtkForm(AWidget^.window)
else
begin
AWindow := GetControlWindow(AWidget);
if AWindow <> nil then
PaintWindow(AWindow);
end;
end;
begin
if not WSCheckHandleAllocated(AWinControl, 'PaintTo') then
Exit;
PaintWidget(GetFixedWidget({%H-}PGtkWidget(AWinControl.Handle)));
end;
class procedure TGtk2WSWinControl.Repaint(const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'Repaint')
then Exit;
gtk_widget_queue_draw({%H-}PGtkWidget(AWinControl.Handle));
end;
procedure Gtk2WS_ListBoxChange({%H-}Selection: PGtkTreeSelection; WidgetInfo: PWidgetInfo); cdecl;
var
Mess: TLMessage;
begin
{$IFDEF EventTrace}
EventTrace('Gtk2WS_ListBoxChange', WidgetInfo^.LCLObject);
{$ENDIF}
FillChar(Mess{%H-}, SizeOf(Mess), 0);
Mess.msg := LM_SELCHANGE;
DeliverMessage(WidgetInfo^.LCLObject, Mess);
end;
{ TGtk2ListBoxPrivateList }
class procedure TGtk2ListBoxPrivateList.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
var
Selection: PGtkTreeSelection;
begin
TGtk2WSBaseScrollingWinControl.SetCallbacks(AGtkWidget, AWidgetInfo);
Selection := gtk_tree_view_get_selection(PGtkTreeView(AWidgetInfo^.CoreWidget));
SignalConnect(PGtkWidget(Selection), 'changed', @Gtk2WS_ListBoxChange, AWidgetInfo);
end;
{ TGtk2WSBaseScrollingWinControl }
function Gtk2WSBaseScrollingWinControl_HValueChanged(AAdjustment: PGTKAdjustment; AInfo: PWidgetInfo): GBoolean; cdecl;
var
ScrollingData: PBaseScrollingWinControlData;
Msg: TLMHScroll;
OldValue, V, U, L, StepI, PageI: Integer;
X, Y: GInt;
Mask: TGdkModifierType;
begin
Result := CallBackDefaultReturn;
if AInfo^.ChangeLock > 0 then Exit;
ScrollingData := AInfo^.UserData;
// round values
V := Round(AAdjustment^.Value);
U := Round(AAdjustment^.Upper);
L := Round(AAdjustment^.Lower);
StepI := Round(AAdjustment^.Step_Increment);
PageI := Round(AAdjustment^.Page_Increment);
OldValue := ScrollingData^.HValue;
ScrollingData^.HValue := V;
// get keystates
Mask := 0;
if ScrollingData^.HScroll <> nil then
begin
{$IFDEF UseGDKErrorTrap}
BeginGDKErrorTrap;
{$ENDIF}
gdk_window_get_pointer(GetControlWindow(ScrollingData^.HScroll), @X, @Y, @Mask);
{$IFDEF UseGDKErrorTrap}
EndGDKErrorTrap;
{$ENDIF}
end;
Msg.msg := LM_HSCROLL;
// get scrollcode
if ssLeft in GTKEventStateToShiftState(Word(Mask))
then Msg.ScrollCode := SB_THUMBTRACK
else if V <= L
then Msg.ScrollCode := SB_TOP
else if V >= U
then Msg.ScrollCode := SB_BOTTOM
else if V - OldValue = StepI
then Msg.ScrollCode := SB_LINERIGHT
else if OldValue - V = StepI
then Msg.ScrollCode := SB_LINELEFT
else if V - OldValue = PageI
then Msg.ScrollCode := SB_PAGERIGHT
else if OldValue - V = PageI
then Msg.ScrollCode := SB_PAGELEFT
else Msg.ScrollCode := SB_THUMBPOSITION;
Msg.Pos := V;
if V < High(Msg.SmallPos)
then Msg.SmallPos := V
else Msg.SmallPos := High(Msg.SmallPos);
Msg.ScrollBar := {%H-}HWND(ScrollingData^.HScroll);
Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn;
end;
function Gtk2WSBaseScrollingWinControl_VValueChanged(AAdjustment: PGTKAdjustment; AInfo: PWidgetInfo): GBoolean; cdecl;
var
ScrollingData: PBaseScrollingWinControlData;
Msg: TLMHScroll;
OldValue, V, U, L, StepI, PageI: Integer;
X, Y: GInt;
Mask: TGdkModifierType;
begin
Result := CallBackDefaultReturn;
if AInfo^.ChangeLock > 0 then Exit;
ScrollingData := AInfo^.UserData;
// round values
V := Round(AAdjustment^.Value);
U := Round(AAdjustment^.Upper);
L := Round(AAdjustment^.Lower);
StepI := Round(AAdjustment^.Step_Increment);
PageI := Round(AAdjustment^.Page_Increment);
OldValue := ScrollingData^.VValue;
ScrollingData^.VValue := V;
// get keystates
Mask := 0;
if ScrollingData^.VScroll <> nil then
begin
{$IFDEF UseGDKErrorTrap}
BeginGDKErrorTrap;
{$ENDIF}
gdk_window_get_pointer(GetControlWindow(ScrollingData^.VScroll), @X, @Y, @Mask);
{$IFDEF UseGDKErrorTrap}
EndGDKErrorTrap;
{$ENDIF}
end;
Msg.msg := LM_VSCROLL;
// Get scrollcode
if ssLeft in GTKEventStateToShiftState(Word(Mask))
then Msg.ScrollCode := SB_THUMBTRACK
else if V <= L
then Msg.ScrollCode := SB_TOP
else if V >= U
then Msg.ScrollCode := SB_BOTTOM
else if V - OldValue = StepI
then Msg.ScrollCode := SB_LINEDOWN
else if OldValue - V = StepI
then Msg.ScrollCode := SB_LINEUP
else if V - OldValue = PageI
then Msg.ScrollCode := SB_PAGEDOWN
else if OldValue - V = PageI
then Msg.ScrollCode := SB_PAGEUP
else Msg.ScrollCode := SB_THUMBPOSITION;
Msg.Pos := V;
if V < High(Msg.SmallPos)
then Msg.SmallPos := V
else Msg.SmallPos := High(Msg.SmallPos);
Msg.ScrollBar := {%H-}HWND(ScrollingData^.HScroll);
Result := (DeliverMessage(AInfo^.LCLObject, Msg) <> 0) xor CallBackDefaultReturn;
end;
class function TGtk2WSBaseScrollingWinControl.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams): HWND;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
ScrollingData: PBaseScrollingWinControlData;
Allocation: TGTKAllocation;
begin
Widget := gtk_scrolled_window_new(nil, nil);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget,dbgsName(AWinControl));
{$ENDIF}
Result := {%H-}HWND(Widget);
if Result = 0 then Exit;
gtk_widget_show(Widget);
WidgetInfo := CreateWidgetInfo(Widget, AWinControl, AParams);
New(ScrollingData);
ScrollingData^.HValue := 0;
ScrollingData^.VValue := 0;
ScrollingData^.HScroll := PGtkScrolledWindow(Widget)^.HScrollbar;
ScrollingData^.VScroll := PGtkScrolledWindow(Widget)^.VScrollbar;
WidgetInfo^.UserData := ScrollingData;
WidgetInfo^.DataOwner := True;
// set allocation
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(Widget, @Allocation);
Set_RC_Name(AWinControl, Widget);
// SetCallbacks isn't called here, it should be done in the 'derived' class
end;
class procedure TGtk2WSBaseScrollingWinControl.SetCallbacks(
const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AWidget),
TComponent(AWidgetInfo^.LCLObject));
SignalConnect(
PGtkWidget(GetWidgetHAdjustment(AWidget)),
'value-changed',
@Gtk2WSBaseScrollingWinControl_HValueChanged,
AWidgetInfo
);
SignalConnect(
PGtkWidget(GetWidgetVAdjustment(AWidget)),
'value-changed',
@Gtk2WSBaseScrollingWinControl_VValueChanged,
AWidgetInfo
);
end;
end.
Reference in New Issue View Git Blame Copy Permalink