(* GTK-Kylix Library: GTKControls - Basic objects Copyright (C) 2007 Tomas Bzatek This library is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this library; if not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307 USA. *) unit GTKControls; interface uses lazglib2, lazgobject2, lazgdk3, lazgtk3, Classes; const { TModalResult values } mrNone = 0; mrOk = mrNone + 1; mrCancel = mrOk + 1; mrYes = mrCancel + 1; mrNo = mrYes + 1; mrAbort = mrNo + 1; mrRetry = mrAbort + 1; mrIgnore = mrRetry + 1; mrAll = mrIgnore + 1; mrNoToAll = mrAll + 1; mrYesToAll = mrNoToAll + 1; type {$IFNDEF CPU64} // 32-bit platform TComponent64 = class(TComponent); {$ELSE} // 64-bit platform TComponent64 = class(TComponent) private FTag: QWORD; published property Tag: QWORD read FTag write FTag default 0; end; {$ENDIF} type TGTKShadowType = (stNone, stShadowIn, stShadowOut, stEtchedIn, stEtchedOut); TGTKPosition = (poLeft, poRight, poTop, poBottom); TGTKAlignment = (taLeftJustify, taRightJustify, taCenter, taFill); (****************************************** TGTKCONTROL *************************************************************************) TGDKMouseButton = (mbLeft, mbMiddle, mbRight, mbNoButton); TGDKKeyEvent = procedure (Sender: TObject; Key: Word; Shift: TShiftState; var Accept: boolean) of object; TGDKMouseEvent = procedure (Sender: TObject; Button: TGDKMouseButton; Shift: TShiftState; X, Y: Integer; var Accept: boolean) of object; TGDKFocusEvent = procedure (Sender: TObject; var Accept: boolean) of object; TGDKExposeEvent = procedure (Sender: TObject; const Rect: PGdkRectangle; var Accept: boolean) of object; TGTKControlState = (csNormal, csActive, csPrelight, csSelected, csInsensitive, csInconsistent, csFocused, csBackdrop, csDirLTR, cdDirRTL, csLink, csVisited, csChecked, csDropActive); TGTKControl = class(TComponent64) private FVisible: Boolean; FParent: TGTKControl; FPopupMenu: TGTKControl; FButtonPressSignalHandler, FButtonReleaseSignalHandler, FKeyDownSignalHandler, FKeyUpSignalHandler, FFocusInSignalHandler, FFocusOutSignalHandler, FExposeSignalHandler, FMotionNotifyHandler: gulong; FOnKeyDown: TGDKKeyEvent; FOnKeyUp: TGDKKeyEvent; FOnEnter: TGDKFocusEvent; FOnExit: TGDKFocusEvent; FOnMouseDown: TGDKMouseEvent; FOnMouseUp: TGDKMouseEvent; FOnDblClick: TGDKMouseEvent; FOnExpose: TGDKExposeEvent; FOnMouseMove: TGDKMouseEvent; function GetWidth: Integer; function GetHeight: Integer; function GetLeft: Integer; function GetTop: Integer; function GetEnabled: boolean; function GetTooltip: string; function GetCanFocus: boolean; function GetFocused: boolean; function GetDefault: boolean; function GetControlState: TGTKControlState; function GetHAlign: TGTKAlignment; function GetVAlign: TGTKAlignment; function GetMarginStart: Integer; function GetMarginEnd: Integer; function GetMarginTop: Integer; function GetMarginBottom: Integer; procedure SetHeight(const Value: Integer); procedure SetVisible(const Value: Boolean); procedure SetWidth(const Value: Integer); procedure SetEnabled(const Value: boolean); procedure SetPopupMenu(Value: TGTKControl); procedure SetTooltip(Value: string); procedure SetFocused(Value: boolean); procedure SetOnKeyDown(Value: TGDKKeyEvent); procedure SetOnKeyUp(Value: TGDKKeyEvent); procedure SetOnEnter(Value: TGDKFocusEvent); procedure SetOnExit(Value: TGDKFocusEvent); procedure SetOnMouseDown(Value: TGDKMouseEvent); procedure SetOnMouseUp(Value: TGDKMouseEvent); procedure SetDefault(Value: boolean); procedure SetOnDblClick(Value: TGDKMouseEvent); procedure SetCanFocus(Value: boolean); procedure SetOnExpose(Value: TGDKExposeEvent); procedure SetControlState(Value: TGTKControlState); procedure SetOnMouseMove(Value: TGDKMouseEvent); procedure SetHAlign(Value: TGTKAlignment); procedure SetVAlign(Value: TGTKAlignment); procedure SetMarginStart(Value: Integer); procedure SetMarginEnd(Value: Integer); procedure SetMarginTop(Value: Integer); procedure SetMarginBottom(Value: Integer); protected procedure SetParent(const Value: TGTKControl); virtual; public FWidget: PGtkWidget; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Hide; procedure Show; procedure ShowAll; procedure SetSizeRequest(const Width, Height: Integer); property Parent: TGTKControl read FParent write SetParent; property Visible: Boolean read FVisible write SetVisible default True; property Enabled: Boolean read GetEnabled write SetEnabled default True; property PopupMenu: TGTKControl read FPopupMenu write SetPopupMenu; procedure SetFocus; procedure Invalidate; function GetData(Key: string): Pointer; procedure SetData(Key: string; Value: Pointer); published property Width: Integer read GetWidth write SetWidth; property Height: Integer read GetHeight write SetHeight; property Left: Integer read GetLeft; property Top: Integer read GetTop; property Tooltip: string read GetTooltip write SetTooltip; property CanFocus: boolean read GetCanFocus write SetCanFocus; property Focused: boolean read GetFocused write SetFocused; property Default: boolean read GetDefault write SetDefault; property OnKeyDown: TGDKKeyEvent read FOnKeyDown write SetOnKeyDown; property OnKeyUp: TGDKKeyEvent read FOnKeyUp write SetOnKeyUp; property OnEnter: TGDKFocusEvent read FOnEnter write SetOnEnter; property OnExit: TGDKFocusEvent read FOnExit write SetOnExit; property OnMouseDown: TGDKMouseEvent read FOnMouseDown write SetOnMouseDown; property OnMouseUp: TGDKMouseEvent read FOnMouseUp write SetOnMouseUp; property OnMouseMove: TGDKMouseEvent read FOnMouseMove write SetOnMouseMove; property OnDblClick: TGDKMouseEvent read FOnDblClick write SetOnDblClick; property OnExpose: TGDKExposeEvent read FOnExpose write SetOnExpose; property ComponentState; property ControlState: TGTKControlState read GetControlState write SetControlState; property HAlign: TGTKAlignment read GetHAlign write SetHAlign; property VAlign: TGTKAlignment read GetVAlign write SetHAlign; property MarginStart: Integer read GetMarginStart write SetMarginStart; property MarginEnd: Integer read GetMarginEnd write SetMarginEnd; property MarginTop: Integer read GetMarginTop write SetMarginTop; property MarginBottom: Integer read GetMarginBottom write SetMarginBottom; end; (****************************************** TGTKCONTAINER ***********************************************************************) TGTKContainer = class(TGTKControl) private function GetBorderWidth: integer; procedure SetBorderWidth(Value: integer); function GetChildrenCount: integer; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AddControl(AControl: TGTKControl); procedure RemoveControl(AControl: TGTKControl); published property BorderWidth: integer read GetBorderWidth write SetBorderWidth; property ChildrenCount: integer read GetChildrenCount; end; (****************************************** TGTKBIN *****************************************************************************) TGTKBin = class(TGTKContainer) private function GetChildControl: PGtkWidget; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; property ChildControl: PGtkWidget read GetChildControl; end; (****************************************** TGTKBOX *****************************************************************************) TGTKBox = class(TGTKContainer) private FLinked: boolean; function GetHomogeneous: boolean; function GetSpacing: integer; procedure SetHomogeneous(Value: boolean); procedure SetSpacing(Value: integer); public constructor Create(AOwner: TComponent); override; constructor CreateLinked(AOwner: TComponent; Widget: PGtkWidget); destructor Destroy; override; procedure AddControl(Control: TGTKControl); procedure AddControlEnd(Control: TGTKControl); procedure AddControlEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer); procedure AddControlEndEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer); published property Homogeneous: boolean read GetHomogeneous write SetHomogeneous; property Spacing: integer read GetSpacing write SetSpacing; end; (****************************************** TGTKHBOX ****************************************************************************) TGTKHBox = class(TGTKBox) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; (****************************************** TGTKVBOX ****************************************************************************) TGTKVBox = class(TGTKBox) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; (****************************************** TGTKEVENTBOX ************************************************************************) TGTKEventBox = class(TGTKBin) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; (****************************************** TGTKGRID ****************************************************************************) TGTKGridAttachOptions = set of (taoExpand, taoShrink, taoFill); TGTKGrid = class(TGTKContainer) private function GetRowSpacing: integer; procedure SetRowSpacing(Value: integer); function GetColSpacing: integer; procedure SetColSpacing(Value: integer); function GetRowHomogeneous: boolean; function GetColHomogeneous: boolean; procedure SetRowHomogeneous(Value: boolean); procedure SetColHomogeneous(Value: boolean); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AddControl(Column, Row, NumCols, NumRows: integer; Control: TGTKControl); published property RowSpacing: integer read GetRowSpacing write SetRowSpacing; property ColSpacing: integer read GetColSpacing write SetColSpacing; property RowHomogeneous: boolean read GetRowHomogeneous write SetRowHomogeneous; property ColHomogeneous: boolean read GetColHomogeneous write SetColHomogeneous; end; procedure Beep; (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) (********************************************************************************************************************************) implementation uses GTKMenus, GTKForms, GTKUtils; procedure Beep; begin gdk_beep(); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKControl.Create(AOwner: TComponent); begin inherited Create(AOwner); if AOwner is TGTKControl then FParent := AOwner as TGTKControl; FButtonPressSignalHandler := 0; FButtonReleaseSignalHandler := 0; FKeyDownSignalHandler := 0; FKeyUpSignalHandler := 0; FFocusInSignalHandler := 0; FFocusOutSignalHandler := 0; FExposeSignalHandler := 0; FVisible := True; FWidget := nil; FPopupMenu := nil; FOnKeyDown := nil; FOnKeyUp := nil; FOnEnter := nil; FOnExit := nil; FOnExpose := nil; FOnMouseMove := nil; FOnMouseDown := nil; FOnMouseUp := nil; end; destructor TGTKControl.Destroy; begin try // SetParent(nil); // if Assigned(FWidget) {and GTK_IS_WIDGET(FWidget)} then gtk_widget_destroy(PGtkWidget(FWidget)); except end; inherited Destroy; end; procedure TGTKControl.Hide; begin FVisible := False; gtk_widget_hide(FWidget); end; procedure TGTKControl.Show; begin FVisible := True; gtk_widget_show(FWidget); end; procedure TGTKControl.ShowAll; begin if Parent <> nil then Parent.ShowAll; FVisible := True; gtk_widget_show_all(FWidget); end; procedure TGTKControl.SetParent(const Value: TGTKControl); begin if (csDestroying in ComponentState) then Exit; if FParent <> Value then begin if Value = Self then raise EInvalidOperation.Create('Invalid Operation'); FParent := Value; try if Assigned(FWidget) then if Assigned(Value) then gtk_widget_set_parent(FWidget, Value.FWidget) else gtk_widget_unparent(FWidget); except end; end; end; procedure TGTKControl.SetVisible(const Value: Boolean); begin if Value then Show else Hide; end; function TGTKControl.GetWidth: Integer; begin Result := gtk_widget_get_allocated_width(FWidget); end; function TGTKControl.GetHeight: Integer; begin Result := gtk_widget_get_allocated_height(FWidget); end; procedure TGTKControl.SetWidth(const Value: Integer); begin SetSizeRequest(Value, GetHeight); end; procedure TGTKControl.SetHeight(const Value: Integer); begin SetSizeRequest(GetWidth, Value); end; procedure TGTKControl.SetSizeRequest(const Width, Height: Integer); begin gtk_widget_set_size_request(FWidget, Width, Height); end; function TGTKControl.GetLeft: Integer; var A: TGtkAllocation; begin gtk_widget_get_allocation(FWidget, @A); Result := A.x; end; function TGTKControl.GetTop: Integer; var A: TGtkAllocation; begin gtk_widget_get_allocation(FWidget, @A); Result := A.y; end; function TGTKControl.GetEnabled: boolean; var b: gboolean; begin b := False; if not (csDestroying in ComponentState) then g_object_get(PGObject(FWidget), 'sensitive', [@b, nil]); Result := b; end; procedure TGTKControl.SetEnabled(const Value: boolean); begin gtk_widget_set_sensitive(FWidget, Value); end; function TGTKControl_button_press_event(widget: PGtkWidget; event: PGdkEventButton; user_data: gpointer):gboolean; cdecl; var Shift: TShiftState; Accept: boolean; begin Shift := []; if GDK_SHIFT_MASK in event^.state then Include(Shift, ssShift); if GDK_CONTROL_MASK in event^.state then Include(Shift, ssCtrl); if GDK_MOD1_MASK in event^.state then Include(Shift, ssAlt); Accept := True; if Assigned(TGTKControl(user_data).FOnMouseDown) and (event^.type_ = GDK_BUTTON_PRESS) then TGTKControl(user_data).FOnMouseDown(TGTKControl(user_data), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept); if Assigned(TGTKControl(user_data).FOnDblClick) and (event^.type_ = GDK_2BUTTON_PRESS) then TGTKControl(user_data).FOnDblClick(TGTKControl(user_data), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept); Result := not Accept; if Accept then if (Event^.button = 3) and Assigned(TGTKControl(user_data).FPopupMenu) then begin // if Assigned(TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup(TGTKMenuItem(TGTKControl(user_data).FPopupMenu)); if Assigned(TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(user_data).FPopupMenu).OnPopup(TGTKControl(user_data)); gtk_menu_popup(PGtkMenu(TGTKMenuItem(TGTKControl(user_data).FPopupMenu).FMenu), nil, nil, nil, nil, event^.button, event^.time); Result := False; // Allow list views to process their events - select an item beneath the cursor end; end; procedure TGTKControl.SetPopupMenu(Value: TGTKControl); begin if FPopupMenu <> Value then begin FPopupMenu := Value; if not Assigned(Value) then begin if not Assigned(FOnMouseDown) then begin g_signal_handler_disconnect(PGObject(FWidget), FButtonPressSignalHandler); FButtonPressSignalHandler := 0; end; end else if FButtonPressSignalHandler = 0 then FButtonPressSignalHandler := g_signal_connect_data(PGObject(FWidget), 'button-press-event', TGCallback(@TGTKControl_button_press_event), Self, nil, G_CONNECT_DEFAULT) end; end; function TGTKControl.GetTooltip: string; begin Result := gtk_widget_get_tooltip_text(FWidget); end; procedure TGTKControl.SetTooltip(Value: string); begin gtk_widget_set_tooltip_text(FWidget, PChar(Value)); end; procedure TGTKControl.SetFocus; begin if (csDestroying in ComponentState) then Exit; gtk_widget_grab_focus(FWidget); end; function TGTKControl.GetCanFocus: boolean; var b: gboolean; begin b := False; if not (csDestroying in ComponentState) then g_object_get(PGObject(FWidget), 'can-focus', [@b, nil]); Result := b; end; procedure TGTKControl.SetCanFocus(Value: boolean); begin { if Value then FWidget^.private_flags := FWidget^.private_flags or GTK_CAN_FOCUS else FWidget^.private_flags := FWidget^.private_flags and (not GTK_CAN_FOCUS); } g_object_set(PGObject(FWidget), 'can-focus', [Ord(Value), nil]); end; function TGTKControl.GetFocused: boolean; var b: boolean; begin b := False; Result := False; try if (csDestroying in ComponentState) or (FWidget = nil) then Exit; g_object_get(PGObject(FWidget), 'has-focus', [@b, nil]); Result := b; except end; end; procedure TGTKControl.SetFocused(Value: boolean); begin SetFocus; end; function TGTKControl_key_event(event: PGdkEventKey; user_data : gpointer; KeyDown : boolean): gboolean; var Shift: TShiftState; Accept: boolean; begin Accept := True; Shift := []; if GDK_SHIFT_MASK in event^.state then Include(Shift, ssShift); if GDK_CONTROL_MASK in event^.state then Include(Shift, ssCtrl); if GDK_MOD1_MASK in event^.state then Include(Shift, ssAlt); if KeyDown then begin if Assigned(TGTKControl(user_data).FOnKeyDown) then TGTKControl(user_data).FOnKeyDown(TGTKControl(user_data), event^.keyval, Shift, Accept); end else if Assigned(TGTKControl(user_data).FOnKeyUp) then TGTKControl(user_data).FOnKeyUp(TGTKControl(user_data), event^.keyval, Shift, Accept); Result := not Accept; end; function TGTKControl_key_press_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl; begin Result := TGTKControl_key_event(event, user_data, True); end; function TGTKControl_key_release_event(widget: PGtkWidget; event: PGdkEventKey; user_data : gpointer): gboolean; cdecl; begin Result := TGTKControl_key_event(event, user_data, False); end; procedure TGTKControl.SetOnKeyDown(Value: TGDKKeyEvent); begin if @FOnKeyDown <> @Value then begin FOnKeyDown := Value; if Assigned(Value) then FKeyDownSignalHandler := g_signal_connect_data(PGObject(FWidget), 'key-press-event', TGCallback(@TGTKControl_key_press_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FKeyDownSignalHandler); end; end; procedure TGTKControl.SetOnKeyUp(Value: TGDKKeyEvent); begin if @FOnKeyUp <> @Value then begin FOnKeyUp := Value; if Assigned(Value) then FKeyUpSignalHandler := g_signal_connect_data(PGObject(FWidget), 'key-release-event', TGCallback(@TGTKControl_key_release_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FKeyUpSignalHandler); end; end; function TGTKControl_focus_in_event(widget: PGtkWidget; event: PGdkEventFocus; user_data : gpointer): gboolean; cdecl; var Accept: boolean; begin Accept := True; if Assigned(TGTKControl(user_data).FOnEnter) then TGTKControl(user_data).FOnEnter(TGTKControl(user_data), Accept); Result := not Accept; end; function TGTKControl_focus_out_event(widget: PGtkWidget; event: PGdkEventFocus; user_data : gpointer): gboolean; cdecl; var Accept: boolean; begin Accept := True; if Assigned(TGTKControl(user_data).FOnExit) then TGTKControl(user_data).FOnExit(TGTKControl(user_data), Accept); Result := not Accept; end; procedure TGTKControl.SetOnEnter(Value: TGDKFocusEvent); begin if @FOnEnter <> @Value then begin FOnEnter := Value; if Assigned(Value) then FFocusInSignalHandler := g_signal_connect_data(PGObject(FWidget), 'focus-in-event', TGCallback(@TGTKControl_focus_in_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FFocusInSignalHandler); end; end; procedure TGTKControl.SetOnExit(Value: TGDKFocusEvent); begin if @FOnExit <> @Value then begin FOnExit := Value; if Assigned(Value) then FFocusOutSignalHandler := g_signal_connect_data(PGObject(FWidget), 'focus-out-event', TGCallback(@TGTKControl_focus_out_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FFocusOutSignalHandler); end; end; procedure TGTKControl.SetOnMouseDown(Value: TGDKMouseEvent); begin if @FOnMouseDown <> @Value then begin FOnMouseDown := Value; if not Assigned(Value) then begin if (not Assigned(FPopupMenu)) and (not Assigned(FOnDblClick)) then begin g_signal_handler_disconnect(PGObject(FWidget), FButtonPressSignalHandler); FButtonPressSignalHandler := 0; end; end else if FButtonPressSignalHandler = 0 then FButtonPressSignalHandler := g_signal_connect_data(PGObject(FWidget), 'button-press-event', TGCallback(@TGTKControl_button_press_event), Self, nil, G_CONNECT_DEFAULT) end; end; procedure TGTKControl.SetOnDblClick(Value: TGDKMouseEvent); begin if @FOnMouseDown <> @Value then begin FOnDblClick := Value; if not Assigned(Value) then begin if (not Assigned(FPopupMenu)) and (not Assigned(FOnMouseDown)) then begin g_signal_handler_disconnect(PGObject(FWidget), FButtonPressSignalHandler); FButtonPressSignalHandler := 0; end; end else if FButtonPressSignalHandler = 0 then FButtonPressSignalHandler := g_signal_connect_data(PGObject(FWidget), 'button-press-event', TGCallback(@TGTKControl_button_press_event), Self, nil, G_CONNECT_DEFAULT) end; end; function TGTKControl_button_release_event(widget: PGtkWidget; event: PGdkEventButton; user_data: gpointer):gboolean; cdecl; var Shift: TShiftState; Accept: boolean; begin Shift := []; if GDK_SHIFT_MASK in event^.state then Include(Shift, ssShift); if GDK_CONTROL_MASK in event^.state then Include(Shift, ssCtrl); if GDK_MOD1_MASK in event^.state then Include(Shift, ssAlt); Accept := True; if Assigned(TGTKControl(user_data).FOnMouseUp) then TGTKControl(user_data).FOnMouseUp(TGTKControl(user_data), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept); Result := not Accept; end; procedure TGTKControl.SetOnMouseUp(Value: TGDKMouseEvent); begin if @FOnMouseUp <> @Value then begin FOnMouseUp := Value; if Assigned(Value) then FButtonReleaseSignalHandler := g_signal_connect_data(PGObject(FWidget), 'button-release-event', TGCallback(@TGTKControl_button_release_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FButtonReleaseSignalHandler); end; end; function TGTKControl_motion_notify_event(widget: PGtkWidget; event: PGdkEventMotion; user_data: gpointer): gboolean; cdecl; var Shift: TShiftState; Button: TGDKMouseButton; Accept: boolean; begin Accept := True; Result := False; if event^.is_hint <> 0 then Exit; Shift := []; if GDK_SHIFT_MASK in event^.state then Include(Shift, ssShift); if GDK_CONTROL_MASK in event^.state then Include(Shift, ssCtrl); if GDK_MOD1_MASK in event^.state then Include(Shift, ssAlt); if GDK_BUTTON1_MASK in event^.state then Button := mbLeft else if GDK_BUTTON2_MASK in event^.state then Button := mbMiddle else if GDK_BUTTON3_MASK in event^.state then Button := mbRight else Button := mbNoButton; if Assigned(TGTKControl(user_data).FOnMouseMove) then TGTKControl(user_data).FOnMouseMove(TGTKControl(user_data), Button, Shift, Trunc(event^.x), Trunc(event^.y), Accept); Result := not Accept; end; procedure TGTKControl.SetOnMouseMove(Value: TGDKMouseEvent); begin if @FOnMouseMove <> @Value then begin FOnMouseMove := Value; if Assigned(Value) then FMotionNotifyHandler := g_signal_connect_data(PGObject(FWidget), 'motion-notify-event', TGCallback(@TGTKControl_motion_notify_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FMotionNotifyHandler); end; end; function TGTKControl.GetDefault: boolean; var b: gboolean; begin b := False; if not (csDestroying in ComponentState) then g_object_get(PGObject(FWidget), 'has-default', [@b, nil]); Result := b; end; procedure TGTKControl.SetDefault(Value: boolean); begin if (csDestroying in ComponentState) then Exit; g_object_set(PGObject(FWidget), 'can-default', [Ord(Value), nil]); end; procedure TGTKControl.Invalidate; begin if (csDestroying in ComponentState) then Exit; gtk_widget_queue_draw(FWidget); end; function TGTKControl_expose_event(widget: PGtkWidget; event: PGdkEventExpose; user_data: gpointer):gboolean; cdecl; var Accept: boolean; begin Accept := True; if Assigned(TGTKControl(user_data).FOnExpose) then TGTKControl(user_data).FOnExpose(TGTKControl(user_data), @event^.area, Accept); Result := not Accept; end; procedure TGTKControl.SetOnExpose(Value: TGDKExposeEvent); begin if @FOnExpose <> @Value then begin FOnExpose := Value; if Assigned(Value) then FExposeSignalHandler := g_signal_connect_data(PGObject(FWidget), 'expose-event', TGCallback(@TGTKControl_expose_event), Self, nil, G_CONNECT_DEFAULT) else g_signal_handler_disconnect(PGObject(FWidget), FExposeSignalHandler); end; end; function TGTKControl.GetControlState: TGTKControlState; begin Result := TGTKControlState(gtk_widget_get_state_flags(FWidget)); end; procedure TGTKControl.SetControlState(Value: TGTKControlState); begin gtk_widget_set_state_flags(FWidget, TGtkStateFlags(Value), True); end; function TGTKControl.GetData(Key: string): Pointer; begin Result := g_object_get_data(PGObject(FWidget), PChar(Key)); end; procedure TGTKControl.SetData(Key: string; Value: Pointer); begin g_object_set_data(PGObject(FWidget), PChar(Key), Value); end; function TGTKControl.GetHAlign: TGTKAlignment; begin Result := TGTKAlignment(gtk_widget_get_halign(FWidget)); end; function TGTKControl.GetVAlign: TGTKAlignment; begin Result := TGTKAlignment(gtk_widget_get_valign(FWidget)); end; procedure TGTKControl.SetHAlign(Value: TGTKAlignment); begin gtk_widget_set_halign(FWidget, TGtkAlign(Value)); end; procedure TGTKControl.SetVAlign(Value: TGTKAlignment); begin gtk_widget_set_valign(FWidget, TGtkAlign(Value)); end; function TGTKControl.GetMarginStart: Integer; begin Result := gtk_widget_get_margin_start(FWidget); end; function TGTKControl.GetMarginEnd: Integer; begin Result := gtk_widget_get_margin_end(FWidget); end; function TGTKControl.GetMarginTop: Integer; begin Result := gtk_widget_get_margin_top(FWidget); end; function TGTKControl.GetMarginBottom: Integer; begin Result := gtk_widget_get_margin_bottom(FWidget); end; procedure TGTKControl.SetMarginStart(Value: Integer); begin gtk_widget_set_margin_start(FWidget, Value); end; procedure TGTKControl.SetMarginEnd(Value: Integer); begin gtk_widget_set_margin_end(FWidget, Value); end; procedure TGTKControl.SetMarginTop(Value: Integer); begin gtk_widget_set_margin_top(FWidget, Value); end; procedure TGTKControl.SetMarginBottom(Value: Integer); begin gtk_widget_set_margin_bottom(FWidget, Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKContainer.Create(AOwner: TComponent); begin inherited Create(AOwner); end; destructor TGTKContainer.Destroy; begin inherited Destroy; end; function TGTKContainer.GetBorderWidth: integer; begin Result := gtk_container_get_border_width(PGtkContainer(FWidget)); end; procedure TGTKContainer.SetBorderWidth(Value: integer); begin gtk_container_set_border_width(PGtkContainer(FWidget), Value); end; procedure TGTKContainer.AddControl(AControl: TGTKControl); begin gtk_container_add(PGtkContainer(FWidget), AControl.FWidget); end; procedure TGTKContainer.RemoveControl(AControl: TGTKControl); begin gtk_container_remove(PGtkContainer(FWidget), AControl.FWidget); end; function TGTKContainer.GetChildrenCount: integer; var List: PGList; begin List := LAZGLIB2.PGList(gtk_container_get_children(PGtkContainer(FWidget))); Result := g_list_length(List); g_list_free(List); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKBin.Create(AOwner: TComponent); begin inherited Create(AOwner); end; destructor TGTKBin.Destroy; begin inherited Destroy; end; function TGTKBin.GetChildControl: PGtkWidget; begin Result := gtk_bin_get_child(PGtkBin(FWidget)); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FLinked := False; end; constructor TGTKBox.CreateLinked(AOwner: TComponent; Widget: PGtkWidget); begin inherited Create(AOwner); FLinked := True; FWidget := Widget; Show; end; destructor TGTKBox.Destroy; begin if not FLinked then inherited Destroy; end; procedure TGTKBox.AddControl(Control: TGTKControl); begin gtk_box_pack_start(PGtkBox(FWidget), Control.FWidget, True, True, 0); end; procedure TGTKBox.AddControlEnd(Control: TGTKControl); begin gtk_box_pack_end(PGtkBox(FWidget), Control.FWidget, True, True, 0); end; procedure TGTKBox.AddControlEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer); begin gtk_box_pack_start(PGtkBox(FWidget), Control.FWidget, Expand, Fill, Padding); end; procedure TGTKBox.AddControlEndEx(Control: TGTKControl; Expand, Fill: boolean; Padding: integer); begin gtk_box_pack_end(PGtkBox(FWidget), Control.FWidget, Expand, Fill, Padding); end; function TGTKBox.GetHomogeneous: boolean; begin Result := gtk_box_get_homogeneous(PGtkBox(FWidget)); end; procedure TGTKBox.SetHomogeneous(Value: boolean); begin gtk_box_set_homogeneous(PGtkBox(FWidget), Value); end; function TGTKBox.GetSpacing: integer; begin Result := gtk_box_get_spacing(PGtkBox(FWidget)); end; procedure TGTKBox.SetSpacing(Value: integer); begin gtk_box_set_spacing(PGtkBox(FWidget), Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKHBox.Create(AOwner: TComponent); begin inherited Create(AOwner); if ClassName = 'TGTKHBox' then begin FWidget := gtk_box_new(GTK_ORIENTATION_HORIZONTAL, 0); Show; end; end; destructor TGTKHBox.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKVBox.Create(AOwner: TComponent); begin inherited Create(AOwner); if ClassName = 'TGTKVBox' then begin FWidget := gtk_box_new(GTK_ORIENTATION_VERTICAL, 0); Show; end; end; destructor TGTKVBox.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKEventBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_event_box_new; Show; end; destructor TGTKEventBox.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKGrid.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_grid_new(); Show; end; destructor TGTKGrid.Destroy; begin inherited Destroy; end; function TGTKGrid.GetRowSpacing: integer; begin Result := gtk_grid_get_row_spacing(PGtkGrid(FWidget)); end; procedure TGTKGrid.SetRowSpacing(Value: integer); begin gtk_grid_set_row_spacing(PGtkGrid(FWidget), Value); end; function TGTKGrid.GetColSpacing: integer; begin Result := gtk_grid_get_column_spacing(PGtkGrid(FWidget)); end; procedure TGTKGrid.SetColSpacing(Value: integer); begin gtk_grid_set_column_spacing(PGtkGrid(FWidget), Value); end; function TGTKGrid.GetRowHomogeneous: boolean; begin Result := gtk_grid_get_row_homogeneous(PGtkGrid(FWidget)); end; function TGTKGrid.GetColHomogeneous: boolean; begin Result := gtk_grid_get_column_homogeneous(PGtkGrid(FWidget)); end; procedure TGTKGrid.SetRowHomogeneous(Value: boolean); begin gtk_grid_set_row_homogeneous(PGtkGrid(FWidget), Value); end; procedure TGTKGrid.SetColHomogeneous(Value: boolean); begin gtk_grid_set_column_homogeneous(PGtkGrid(FWidget), Value); end; procedure TGTKGrid.AddControl(Column, Row, NumCols, NumRows: integer; Control: TGTKControl); begin gtk_grid_attach(PGtkGrid(FWidget), Control.FWidget, Column, Row, NumCols, NumRows); end; (********************************************************************************************************************************) (********************************************************************************************************************************) end.