(* GTK-Kylix Library: GTKControls - Basic objects Version 0.6.23 (last updated 2008-11-11) 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; { $WEAKPACKAGEUNIT} interface uses gtk2, gdk2, glib2, Classes; // Quick jump: QForms QControls 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); (****************************************** 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); 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; 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); protected procedure SetParent(const Value: TGTKControl); virtual; public FWidget: PGtkWidget; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Hide; procedure HideAll; 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 SetForegroundColor(Red, Green, Blue: word); overload; procedure SetForegroundColor(State: integer; Red, Green, Blue: word); overload; procedure SetForegroundColor(State: integer; Color: PGdkColor); overload; procedure SetForegroundColor(Color: PGdkColor); overload; procedure SetBackgroundColor(Red, Green, Blue: word); overload; procedure SetBackgroundColor(State: integer; Red, Green, Blue: word); overload; procedure SetBackgroundColor(State: integer; Color: PGdkColor); overload; procedure SetBackgroundColor(Color: PGdkColor); overload; procedure SetTextColor(Red, Green, Blue: word); overload; procedure SetTextColor(State: integer; Red, Green, Blue: word); overload; procedure SetBaseColor(Red, Green, Blue: word); overload; procedure SetBaseColor(State: integer; Red, Green, Blue: word); overload; procedure Invalidate; procedure SetAlignment(XAlign, YAlign: Double); procedure SetPadding(XPad, YPad: integer); 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; 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; (****************************************** TGTKTOOLTIPS ************************************************************************) TGTKTooltips = class(TComponent) private function GetEnabled: boolean; procedure SetEnabled(Value: boolean); public FObject: PGtkTooltips; constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Enabled: boolean read GetEnabled write SetEnabled; end; (****************************************** TGTKTABLE ***************************************************************************) TGTKTableAttachOptions = set of (taoExpand, taoShrink, taoFill); TGTKTable = class(TGTKContainer) private function GetRowCount: integer; procedure SetRowCount(Value: integer); function GetColCount: integer; procedure SetColCount(Value: integer); function GetRowSpacing: integer; procedure SetRowSpacing(Value: integer); function GetColSpacing: integer; procedure SetColSpacing(Value: integer); function GetHomogeneous: boolean; procedure SetHomogeneous(Value: boolean); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetRowColCount(Rows, Cols: integer); procedure AddControl(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XPadding, YPadding: integer); procedure AddControlEx(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XAttachOptions, YAttachOptions: TGTKTableAttachOptions; XPadding, YPadding: integer); published property RowCount: integer read GetRowCount write SetRowCount; property ColCount: integer read GetColCount write SetColCount; property RowSpacing: integer read GetRowSpacing write SetRowSpacing; property ColSpacing: integer read GetColSpacing write SetColSpacing; property Homogeneous: boolean read GetHomogeneous write SetHomogeneous; 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.HideAll; begin if Parent <> nil then Parent.HideAll; FVisible := False; gtk_widget_hide_all(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) and GTK_IS_WIDGET(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 := FWidget^.allocation.width; end; function TGTKControl.GetHeight: Integer; begin Result := FWidget^.allocation.height; 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; begin Result := FWidget^.allocation.x; end; function TGTKControl.GetTop: Integer; begin Result := FWidget^.allocation.y; end; function TGTKControl.GetEnabled: boolean; begin Result := False; if (csDestroying in ComponentState) then Exit; Result := GTK_WIDGET_SENSITIVE(FWidget); 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 event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift); if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl); if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt); Accept := True; if Assigned(TGTKControl(widget).FOnMouseDown) and (event^._type = GDK_BUTTON_PRESS) then TGTKControl(widget).FOnMouseDown(TGTKControl(widget), TGDKMouseButton(event^.button - 1), Shift, Trunc(event^.x), Trunc(event^.y), Accept); if Assigned(TGTKControl(widget).FOnDblClick) and (event^._type = GDK_2BUTTON_PRESS) then TGTKControl(widget).FOnDblClick(TGTKControl(widget), 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(widget).FPopupMenu) then begin // if Assigned(TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup(TGTKMenuItem(TGTKControl(widget).FPopupMenu)); if Assigned(TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup) then TGTKMenuItem(TGTKControl(widget).FPopupMenu).OnPopup(TGTKControl(widget)); gtk_menu_popup(PGtkMenu(TGTKMenuItem(TGTKControl(widget).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(PGtkObject(FWidget), FButtonPressSignalHandler); FButtonPressSignalHandler := 0; end; end else if FButtonPressSignalHandler = 0 then FButtonPressSignalHandler := g_signal_connect_swapped(PGtkObject(FWidget), 'button-press-event', G_CALLBACK(@TGTKControl_button_press_event), Self) end; end; function TGTKControl.GetTooltip: string; var TooltipsData : PGtkTooltipsData; begin Result := ''; TooltipsData := gtk_tooltips_data_get(FWidget); if Assigned(TooltipsData) then Result := PgcharToString(TooltipsData^.tip_text); end; procedure TGTKControl.SetTooltip(Value: string); var FParentForm : TCustomGTKForm; begin FParentForm := GetParentForm(Self); if FParentForm <> nil then gtk_tooltips_set_tip(FParentForm.Tooltips.FObject, FWidget, StringToPgchar(Value), nil); end; procedure TGTKControl.SetFocus; begin if (csDestroying in ComponentState) then Exit; gtk_widget_grab_focus(FWidget); end; function TGTKControl.GetCanFocus: boolean; begin Result := False; if (csDestroying in ComponentState) then Exit; Result := GTK_WIDGET_CAN_FOCUS(FWidget); 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(G_OBJECT(FWidget), 'can-focus', Ord(Value), nil); end; function TGTKControl.GetFocused: boolean; begin Result := False; try if (csDestroying in ComponentState) or (FWidget = nil) then Exit; Result := GTK_WIDGET_HAS_FOCUS(FWidget); 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 event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift); if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl); if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK 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(PGtkObject(FWidget), 'key-press-event', G_CALLBACK(@TGTKControl_key_press_event), Self) else g_signal_handler_disconnect(PGtkObject(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(PGtkObject(FWidget), 'key-release-event', G_CALLBACK(@TGTKControl_key_release_event), Self) else g_signal_handler_disconnect(PGtkObject(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(PGtkObject(FWidget), 'focus-in-event', G_CALLBACK(@TGTKControl_focus_in_event), Self) else g_signal_handler_disconnect(PGtkObject(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(PGtkObject(FWidget), 'focus-out-event', G_CALLBACK(@TGTKControl_focus_out_event), Self) else g_signal_handler_disconnect(PGtkObject(FWidget), FFocusOutSignalHandler); end; end; procedure TGTKControl.SetForegroundColor(Red, Green, Blue: word); begin gtk_widget_modify_fg(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetForegroundColor(State: integer; Red, Green, Blue: word); begin gtk_widget_modify_fg(FWidget, State, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetForegroundColor(State: integer; Color: PGdkColor); begin gtk_widget_modify_fg(FWidget, State, Color); end; procedure TGTKControl.SetForegroundColor(Color: PGdkColor); begin gtk_widget_modify_fg(FWidget, 0, Color); end; procedure TGTKControl.SetBackgroundColor(Red, Green, Blue: word); begin gtk_widget_modify_bg(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetBackgroundColor(State: integer; Red, Green, Blue: word); begin gtk_widget_modify_bg(FWidget, State, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetBackgroundColor(State: integer; Color: PGdkColor); begin gtk_widget_modify_bg(FWidget, State, Color); end; procedure TGTKControl.SetBackgroundColor(Color: PGdkColor); begin gtk_widget_modify_bg(FWidget, 0, Color); end; procedure TGTKControl.SetTextColor(Red, Green, Blue: word); begin gtk_widget_modify_text(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetTextColor(State: integer; Red, Green, Blue: word); begin gtk_widget_modify_text(FWidget, State, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetBaseColor(Red, Green, Blue: word); begin gtk_widget_modify_base(FWidget, 0, AllocateColor(FWidget, Red, Green, Blue)); end; procedure TGTKControl.SetBaseColor(State: integer; Red, Green, Blue: word); begin gtk_widget_modify_base(FWidget, State, AllocateColor(FWidget, Red, Green, Blue)); 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(PGtkObject(FWidget), FButtonPressSignalHandler); FButtonPressSignalHandler := 0; end; end else if FButtonPressSignalHandler = 0 then FButtonPressSignalHandler := g_signal_connect_swapped(PGtkObject(FWidget), 'button-press-event', G_CALLBACK(@TGTKControl_button_press_event), Self) 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(PGtkObject(FWidget), FButtonPressSignalHandler); FButtonPressSignalHandler := 0; end; end else if FButtonPressSignalHandler = 0 then FButtonPressSignalHandler := g_signal_connect_swapped(PGtkObject(FWidget), 'button-press-event', G_CALLBACK(@TGTKControl_button_press_event), Self) end; end; function TGTKControl_button_release_event(widget: PGtkWidget; event: PGdkEventButton; user_data: gpointer):gboolean; cdecl; var Shift: TShiftState; Accept: boolean; begin Shift := []; if event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift); if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl); if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt); Accept := True; if Assigned(TGTKControl(widget).FOnMouseUp) then TGTKControl(widget).FOnMouseUp(TGTKControl(widget), 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_swapped(PGtkObject(FWidget), 'button-release-event', G_CALLBACK(@TGTKControl_button_release_event), Self) else g_signal_handler_disconnect(PGtkObject(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 event^.state and GDK_SHIFT_MASK = GDK_SHIFT_MASK then Include(Shift, ssShift); if event^.state and GDK_CONTROL_MASK = GDK_CONTROL_MASK then Include(Shift, ssCtrl); if event^.state and GDK_MOD1_MASK = GDK_MOD1_MASK then Include(Shift, ssAlt); if event^.state and GDK_BUTTON1_MASK = GDK_BUTTON1_MASK then Button := mbLeft else if event^.state and GDK_BUTTON2_MASK = GDK_BUTTON2_MASK then Button := mbMiddle else if event^.state and GDK_BUTTON3_MASK = GDK_BUTTON3_MASK then Button := mbRight else Button := mbNoButton; if Assigned(TGTKControl(widget).FOnMouseMove) then TGTKControl(widget).FOnMouseMove(TGTKControl(widget), 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_swapped(PGtkObject(FWidget), 'motion-notify-event', G_CALLBACK(@TGTKControl_motion_notify_event), Self) else g_signal_handler_disconnect(PGtkObject(FWidget), FMotionNotifyHandler); end; end; function TGTKControl.GetDefault: boolean; begin Result := False; if (csDestroying in ComponentState) then Exit; Result := GTK_WIDGET_HAS_DEFAULT(FWidget); end; procedure TGTKControl.SetDefault(Value: boolean); begin if (csDestroying in ComponentState) then Exit; GTK_WIDGET_SET_FLAGS(FWidget, GTK_CAN_DEFAULT); // gtk_widget_grab_default(FWidget); end; procedure TGTKControl.Invalidate; begin if (csDestroying in ComponentState) then Exit; gtk_widget_queue_draw(FWidget); end; procedure TGTKControl.SetAlignment(XAlign, YAlign: Double); begin gtk_misc_set_alignment(PGtkMisc(FWidget), XAlign, YAlign); end; procedure TGTKControl.SetPadding(XPad, YPad: integer); begin gtk_misc_set_padding(PGtkMisc(FWidget), XPad, YPad); 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(PGtkObject(FWidget), 'expose-event', G_CALLBACK(@TGTKControl_expose_event), Self) else g_signal_handler_disconnect(PGtkObject(FWidget), FExposeSignalHandler); end; end; function TGTKControl.GetControlState: TGTKControlState; begin Result := TGTKControlState(FWidget^.state); end; procedure TGTKControl.SetControlState(Value: TGTKControlState); begin gtk_widget_set_state(FWidget, integer(Value)); end; function TGTKControl.GetData(Key: string): Pointer; begin Result := g_object_get_data(G_OBJECT(FWidget), PChar(Key)); end; procedure TGTKControl.SetData(Key: string; Value: Pointer); begin g_object_set_data(G_OBJECT(FWidget), PChar(Key), 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; begin Result := g_list_length(gtk_container_get_children(PGtkContainer(FWidget))); 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_defaults(PGtkBox(FWidget), Control.FWidget); end; procedure TGTKBox.AddControlEnd(Control: TGTKControl); begin gtk_box_pack_end_defaults(PGtkBox(FWidget), Control.FWidget); 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_hbox_new(True, 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_vbox_new(False, 0); Show; end; end; destructor TGTKVBox.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKTooltips.Create(AOwner: TComponent); begin inherited Create(AOwner); FObject := gtk_tooltips_new; end; destructor TGTKTooltips.Destroy; begin inherited Destroy; end; function TGTKTooltips.GetEnabled: boolean; begin Result := Boolean(gtk2.enabled(FObject^)); end; procedure TGTKTooltips.SetEnabled(Value: boolean); begin if Value then gtk_tooltips_enable(FObject) else gtk_tooltips_disable(FObject); 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 TGTKTable.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_table_new(0, 0, False); Show; end; destructor TGTKTable.Destroy; begin inherited Destroy; end; function TGTKTable.GetRowCount: integer; begin Result := PGtkTable(FWidget)^.nrows; end; procedure TGTKTable.SetRowCount(Value: integer); begin SetRowColCount(Value, ColCount); end; function TGTKTable.GetColCount: integer; begin Result := PGtkTable(FWidget)^.ncols; end; procedure TGTKTable.SetColCount(Value: integer); begin SetRowColCount(RowCount, Value); end; procedure TGTKTable.SetRowColCount(Rows, Cols: integer); begin gtk_table_resize(PGtkTable(FWidget), Rows, Cols); end; function TGTKTable.GetRowSpacing: integer; begin Result := gtk_table_get_default_row_spacing(PGtkTable(FWidget)); end; procedure TGTKTable.SetRowSpacing(Value: integer); begin gtk_table_set_row_spacings(PGtkTable(FWidget), Value); end; function TGTKTable.GetColSpacing: integer; begin Result := gtk_table_get_default_col_spacing(PGtkTable(FWidget)); end; procedure TGTKTable.SetColSpacing(Value: integer); begin gtk_table_set_col_spacings(PGtkTable(FWidget), Value); end; function TGTKTable.GetHomogeneous: boolean; begin Result := gtk_table_get_homogeneous(PGtkTable(FWidget)); end; procedure TGTKTable.SetHomogeneous(Value: boolean); begin gtk_table_set_homogeneous(PGtkTable(FWidget), Value); end; procedure TGTKTable.AddControl(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XPadding, YPadding: integer); begin gtk_table_attach(PGtkTable(FWidget), Control.FWidget, Column, Column + NumCols, Row, Row + NumRows, GTK_EXPAND or GTK_SHRINK or GTK_FILL, GTK_EXPAND or GTK_SHRINK or GTK_FILL, XPadding, YPadding); end; procedure TGTKTable.AddControlEx(Column, Row, NumCols, NumRows: integer; Control: TGTKControl; XAttachOptions, YAttachOptions: TGTKTableAttachOptions; XPadding, YPadding: integer); begin gtk_table_attach(PGtkTable(FWidget), Control.FWidget, Column, Column + NumCols, Row, Row + NumRows, (GTK_EXPAND*Ord(taoExpand in XAttachOptions)) or (GTK_SHRINK*Ord(taoShrink in XAttachOptions)) or (GTK_FILL*Ord(taoFill in XAttachOptions)), (GTK_EXPAND*Ord(taoExpand in YAttachOptions)) or (GTK_SHRINK*Ord(taoShrink in YAttachOptions)) or (GTK_FILL*Ord(taoFill in YAttachOptions)), XPadding, YPadding); end; (********************************************************************************************************************************) (********************************************************************************************************************************) end.