diff options
Diffstat (limited to 'libgtk_kylix/GTKControls.pas')
| -rw-r--r-- | libgtk_kylix/GTKControls.pas | 1050 |
1 files changed, 1050 insertions, 0 deletions
diff --git a/libgtk_kylix/GTKControls.pas b/libgtk_kylix/GTKControls.pas new file mode 100644 index 0000000..8004857 --- /dev/null +++ b/libgtk_kylix/GTKControls.pas @@ -0,0 +1,1050 @@ +(* + GTK-Kylix Library: GTKControls - Basic objects + Version 0.6.22 (last updated 2007-12-19) + Copyright (C) 2007 Tomas Bzatek <tbzatek@users.sourceforge.net> + + 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); + 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: gulong; + FOnKeyDown: TGDKKeyEvent; + FOnKeyUp: TGDKKeyEvent; + FOnEnter: TGDKFocusEvent; + FOnExit: TGDKFocusEvent; + FOnMouseDown: TGDKMouseEvent; + FOnMouseUp: TGDKMouseEvent; + FOnDblClick: TGDKMouseEvent; + FOnExpose: TGDKExposeEvent; + 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); + 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 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; +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 := True; + 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.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. |