(* GTK-Kylix Library: GTKStdCtrls - Standard visual controls (such as buttons, labels, entry) Version 0.6.24 (last updated 2008-11-17) 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 GTKStdCtrls; interface uses gtk2, glib2, lazglib2, lazgobject2, Classes, GTKControls, GTKConsts, GTKClasses; type (****************************************** TGTKBUTTON **************************************************************************) TGTKBorderStyle = (bsNormal, bsHalf, bsNone); TGTKButton = class(TGTKBin) private FOnClick: TNotifyEvent; function GetCaption: string; function GetUseStock: boolean; function GetUseUnderline: boolean; function GetBorderStyle: TGTKBorderStyle; procedure SetCaption(Value: string); procedure SetUseStock(Value: boolean); procedure SetUseUnderline(Value: boolean); procedure SetBorderStyle(Value: TGTKBorderStyle); public constructor Create(AOwner: TComponent); override; constructor CreateFromStock(AOwner: TComponent; const StockID: PChar); destructor Destroy; override; published property Caption: string read GetCaption write SetCaption; property OnClick: TNotifyEvent read FOnClick write FOnClick; property UseStock: boolean read GetUseStock write SetUseStock; property UseUnderline: boolean read GetUseUnderline write SetUseUnderline; property BorderStyle: TGTKBorderStyle read GetBorderStyle write SetBorderStyle; end; (****************************************** TGTKMISC ****************************************************************************) TGTKMisc = class(TGTKControl) private function GetXAlign: Single; function GetYAlign: Single; function GetXPadding: integer; function GetYPadding: integer; procedure SetXAlign(Value: Single); procedure SetYAlign(Value: Single); procedure SetXPadding(Value: integer); procedure SetYPadding(Value: integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure SetAlignment(XAlign, YAlign : Single); procedure SetPadding(XPadding, YPadding : integer); published property XAlign: Single read GetXAlign write SetXAlign; property YAlign: Single read GetYAlign write SetYAlign; property XPadding: integer read GetXPadding write SetXPadding; property YPadding: integer read GetYPadding write SetYPadding; end; (****************************************** TGTKLABEL **************************************************************************) TGTKAlignment = (taLeftJustify, taRightJustify, taCenter, taFill); TGTKLabel = class(TGTKMisc) private FLinked: boolean; function GetCaption: string; function GetAlignment: TGTKAlignment; function GetUseMarkup: boolean; function GetLineWrap: boolean; function GetUseUnderline: boolean; function GetSelectable: boolean; procedure SetCaption(Value: string); procedure SetAlignment(Value: TGTKAlignment); procedure SetUseMarkup(Value: boolean); procedure SetLineWrap(Value: boolean); procedure SetUseUnderline(Value: boolean); procedure SetFocusControl(Value: TGTKControl); procedure SetSelectable(Value: boolean); public constructor Create(AOwner: TComponent); override; constructor CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget); destructor Destroy; override; procedure SetMarkup(const Text: string); published property Caption: string read GetCaption write SetCaption; property Alignment: TGTKAlignment read GetAlignment write SetAlignment; property UseMarkup: boolean read GetUseMarkup write SetUseMarkup; property LineWrap: boolean read GetLineWrap write SetLineWrap; property UseUnderline: boolean read GetUseUnderline write SetUseUnderline; property FocusControl: TGTKControl write SetFocusControl; property Selectable: boolean read GetSelectable write SetSelectable; end; (****************************************** TGTKTOGGLEBUTTON ********************************************************************) TGTKToggleButton = class(TGTKButton) private FOnToggled: TNotifyEvent; function GetCaption: string; function GetChecked: boolean; function GetDrawIndicator: boolean; function GetInconsistent: boolean; procedure SetCaption(Value: string); procedure SetChecked(Value: boolean); procedure SetDrawIndicator(Value: boolean); procedure SetInconsistent(Value: boolean); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Caption: string read GetCaption write SetCaption; property Checked: boolean read GetChecked write SetChecked; property DrawIndicator: boolean read GetDrawIndicator write SetDrawIndicator; property OnToggled: TNotifyEvent read FOnToggled write FOnToggled; property Inconsistent: boolean read GetInconsistent write SetInconsistent; property UseUnderline; end; (****************************************** TGTKCHECKBUTTON *********************************************************************) TGTKCheckButton = class(TGTKToggleButton) public constructor Create(AOwner: TComponent); override; constructor CreateWithLabel(AOwner: TComponent; const ALabel: string); destructor Destroy; override; published property Caption; property Checked; property DrawIndicator; property OnToggled; property UseUnderline; end; (****************************************** TGTKRADIOBUTTON *********************************************************************) TGTKRadioButton = class(TGTKToggleButton) public constructor Create(AOwner: TComponent); override; constructor CreateWithLabel(AOwner: TComponent; const ALabel: string); destructor Destroy; override; procedure SetRadioGroup(RadioButton: TGTKRadioButton); published property Caption; property Checked; property DrawIndicator; property OnToggled; end; (****************************************** TGTKFRAME ***************************************************************************) TGTKFrame = class(TGTKBin) private function GetCaption: string; function GetShadowType: TGTKShadowType; procedure SetCaption(Value: string); procedure SetShadowType(Value: TGTKShadowType); public constructor Create(AOwner: TComponent); override; constructor CreateWithoutLabel(AOwner: TComponent); destructor Destroy; override; published property Caption: string read GetCaption write SetCaption; property ShadowType: TGTKShadowType read GetShadowType write SetShadowType; end; (****************************************** TGTKEDITABLE ************************************************************************) TGTKEditable = class(TGTKControl) private FOnChanged: TNotifyEvent; function GetEditable: boolean; function GetPosition: integer; procedure SetEditable(Value: boolean); procedure SetPosition(Value: integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure CutClipboard; procedure CopyClipboard; procedure PasteClipboard; procedure DeleteSelection; procedure SelectRegion(StartPosition, EndPosition: integer); procedure InsertText(AText: string; Position: integer); procedure DeleteText(StartPosition, EndPosition: integer); function GetChars(StartPosition, EndPosition: integer): string; published property Editable: boolean read GetEditable write SetEditable; property CursorPosition: integer read GetPosition write SetPosition; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; end; (****************************************** TGTKENTRY ************************************************************************) TGTKEntry = class(TGTKEditable) private FLinked: boolean; function GetText: string; function GetMaxLength: integer; function GetVisibility: boolean; procedure SetText(Value: string); procedure SetMaxLength(Value: integer); procedure SetVisibility(Value: boolean); public constructor Create(AOwner: TComponent); override; constructor CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget); destructor Destroy; override; procedure SelectAll; published property Text: string read GetText write SetText; property MaxLength: integer read GetMaxLength write SetMaxLength; property Visibility: boolean read GetVisibility write SetVisibility; end; (****************************************** TGTKCOMBO **************************************************************************) TGTKCombo = class(TGTKHBox) private procedure ItemsChanged(Sender: TObject); function GetAllowEmpty: boolean; function GetMatchValue: boolean; function GetCaseSensitive: boolean; procedure SetAllowEmpty(Value: boolean); procedure SetMatchValue(Value: boolean); procedure SetCaseSensitive(Value: boolean); public Items: TGList; Entry: TGTKEntry; constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure UpdateItems; procedure SetPolicy(MatchValue, AllowEmpty: boolean); procedure DisableActivate; published property AllowEmpty: boolean read GetAllowEmpty write SetAllowEmpty; property MatchValue: boolean read GetMatchValue write SetMatchValue; property CaseSensitive: boolean read GetCaseSensitive write SetCaseSensitive; end; (****************************************** TGTKSPINEDIT ************************************************************************) TGTKSpinEdit = class(TGTKEntry) private FAdjustment: PGtkAdjustment; function GetDigits: integer; procedure SetDigits(AValue: integer); function GetMin: Double; procedure SetMin(AValue: Double); function GetMax: Double; procedure SetMax(AValue: Double); function GetIncrementStep: Double; procedure SetIncrementStep(AValue: Double); function GetIncrementPage: Double; procedure SetIncrementPage(AValue: Double); function GetValue: Double; procedure SetValue(AValue: Double); function GetAsInteger: integer; procedure SetAsInteger(AValue: integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Digits: integer read GetDigits write SetDigits; property Min: Double read GetMin write SetMin; property Max: Double read GetMax write SetMax; property IncrementStep: Double read GetIncrementStep write SetIncrementStep; property IncrementPage: Double read GetIncrementPage write SetIncrementPage; property Value: Double read GetValue write SetValue; property AsInteger: integer read GetAsInteger write SetAsInteger; property AsFloat: Double read GetValue write SetValue; end; procedure TGTKButton_OnClick(button: PGtkButton; user_data: Pgpointer); cdecl; (********************************************************************************************************************************) (********************************************************************************************************************************) implementation procedure TGTKButton_OnClick(button: PGtkButton; user_data: Pgpointer); cdecl; begin if Assigned(TGTKButton(user_data).FOnClick) then TGTKButton(user_data).FOnClick(TGTKButton(user_data)); end; constructor TGTKButton.Create(AOwner: TComponent); begin inherited Create(AOwner); FOnClick := nil; if ClassName = 'TGTKButton' then begin FWidget := gtk_button_new_with_mnemonic(PChar(SCDefaultButtonCaption)); g_signal_connect_data(PGObject(FWidget), 'clicked', TGCallback(@TGTKButton_OnClick), Self, nil, G_CONNECT_DEFAULT); Show; end; end; constructor TGTKButton.CreateFromStock(AOwner: TComponent; const StockID: PChar); begin inherited Create(AOwner); FOnClick := nil; if ClassName = 'TGTKButton' then begin FWidget := gtk_button_new_from_stock(StockID); g_signal_connect_data(PGObject(FWidget), 'clicked', TGCallback(@TGTKButton_OnClick), Self, nil, G_CONNECT_DEFAULT); Show; end; end; destructor TGTKButton.Destroy; begin inherited Destroy; end; function TGTKButton.GetCaption: string; begin Result := String(gtk_label_get_text(PGtkLabel(ChildControl))); end; procedure TGTKButton.SetCaption(Value: string); begin gtk_label_set_text_with_mnemonic(PGtkLabel(ChildControl), PChar(Value)); end; function TGTKButton.GetUseStock: boolean; begin Result := gtk_button_get_use_stock(PGtkButton(FWidget)); end; procedure TGTKButton.SetUseStock(Value: boolean); begin gtk_button_set_use_stock(PGtkButton(FWidget), Value); end; function TGTKButton.GetUseUnderline: boolean; begin Result := gtk_button_get_use_underline(PGtkButton(FWidget)); end; procedure TGTKButton.SetUseUnderline(Value: boolean); begin gtk_button_set_use_underline(PGtkButton(FWidget), Value); end; function TGTKButton.GetBorderStyle: TGTKBorderStyle; begin Result := TGTKBorderStyle(gtk_button_get_relief(PGtkButton(FWidget))); end; procedure TGTKButton.SetBorderStyle(Value: TGTKBorderStyle); begin gtk_button_set_relief(PGtkButton(FWidget), integer(Value)); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKMisc.Create(AOwner: TComponent); begin inherited Create(AOwner); end; destructor TGTKMisc.Destroy; begin inherited Destroy; end; procedure TGTKMisc.SetAlignment(XAlign, YAlign : Single); begin gtk_misc_set_alignment(PGtkMisc(FWidget), XAlign, YAlign); end; procedure _gtk_misc_get_alignment(misc:PGtkMisc; xalign:Pgfloat; yalign:Pgfloat); cdecl; external gtklib name 'gtk_misc_get_alignment'; procedure _gtk_misc_get_padding(misc:PGtkMisc; xpad:Pgint; ypad:Pgint); cdecl; external gtklib name 'gtk_misc_get_padding'; function TGTKMisc.GetXAlign: Single; var axalign: gfloat; begin axalign := 0.0; _gtk_misc_get_alignment(PGtkMisc(FWidget), @axalign, nil); Result := axalign; end; procedure TGTKMisc.SetXAlign(Value: Single); begin SetAlignment(Value, YAlign); end; function TGTKMisc.GetYAlign: Single; var ayalign: gfloat; begin ayalign := 0.0; _gtk_misc_get_alignment(PGtkMisc(FWidget), nil, @ayalign); Result := ayalign; end; procedure TGTKMisc.SetYAlign(Value: Single); begin SetAlignment(XAlign, Value); end; procedure TGTKMisc.SetPadding(XPadding, YPadding : integer); begin gtk_misc_set_padding(PGtkMisc(FWidget), XPadding, YPadding); end; function TGTKMisc.GetXPadding: integer; var xpad: gint; begin xpad := 0; _gtk_misc_get_padding(PGtkMisc(FWidget), @xpad, nil); Result := xpad; end; procedure TGTKMisc.SetXPadding(Value: integer); begin SetPadding(Value, YPadding); end; function TGTKMisc.GetYPadding: integer; var ypad: gint; begin ypad := 0; _gtk_misc_get_padding(PGtkMisc(FWidget), nil, @ypad); Result := ypad; end; procedure TGTKMisc.SetYPadding(Value: integer); begin SetPadding(XPadding, Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKLabel.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_label_new(nil); FLinked := False; Show; end; constructor TGTKLabel.CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget); begin inherited Create(AOwner); FWidget := Widget; FLinked := True; Show; end; destructor TGTKLabel.Destroy; begin if not FLinked then inherited Destroy; end; function TGTKLabel.GetCaption: string; begin Result := String(gtk_label_get_text(PGtkLabel(FWidget))); end; procedure TGTKLabel.SetCaption(Value: string); begin gtk_label_set_text(PGtkLabel(FWidget), PChar(Value)); end; function TGTKLabel.GetAlignment: TGTKAlignment; begin Result := TGTKAlignment(gtk_label_get_justify(PGtkLabel(FWidget))); end; procedure TGTKLabel.SetAlignment(Value: TGTKAlignment); begin gtk_label_set_justify(PGtkLabel(FWidget), TGtkJustification(Value)); end; procedure TGTKLabel.SetMarkup(const Text: string); begin gtk_label_set_markup(PGtkLabel(FWidget), PChar(Text)); end; function TGTKLabel.GetUseMarkup: boolean; begin Result := gtk_label_get_use_markup(PGtkLabel(FWidget)); end; procedure TGTKLabel.SetUseMarkup(Value: boolean); begin gtk_label_set_use_markup(PGtkLabel(FWidget), Value); end; function TGTKLabel.GetLineWrap: boolean; begin Result := gtk_label_get_line_wrap(PGtkLabel(FWidget)); end; procedure TGTKLabel.SetLineWrap(Value: boolean); begin gtk_label_set_line_wrap(PGtkLabel(FWidget), Value); end; function TGTKLabel.GetUseUnderline: boolean; begin Result := gtk_label_get_use_underline(PGtkLabel(FWidget)); end; procedure TGTKLabel.SetUseUnderline(Value: boolean); begin gtk_label_set_use_underline(PGtkLabel(FWidget), Value); end; procedure TGTKLabel.SetFocusControl(Value: TGTKControl); begin gtk_label_set_mnemonic_widget(PGtkLabel(FWidget), Value.FWidget); end; function TGTKLabel.GetSelectable: boolean; begin Result := gtk_label_get_selectable(PGtkLabel(FWidget)); end; procedure TGTKLabel.SetSelectable(Value: boolean); begin gtk_label_set_selectable(PGtkLabel(FWidget), Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TGTKToggleButton_OnToggled(ToggleButton: PGtkToggleButton; user_data: Pgpointer); cdecl; begin if Assigned(TGTKToggleButton(user_data).FOnToggled) then TGTKToggleButton(user_data).FOnToggled(TGTKToggleButton(user_data)); end; constructor TGTKToggleButton.Create(AOwner: TComponent); begin inherited Create(AOwner); FOnToggled := nil; if ClassName = 'TGTKToggleButton' then begin FWidget := gtk_toggle_button_new_with_label(PChar(SCDefaultToggleButtonCaption)); g_signal_connect_data(PGObject(FWidget), 'toggled', TGCallback(@TGTKToggleButton_OnToggled), Self, nil, G_CONNECT_DEFAULT); Show; end; end; destructor TGTKToggleButton.Destroy; begin inherited Destroy; end; function TGTKToggleButton.GetCaption: string; begin Result := String(gtk_label_get_text(PGtkLabel(ChildControl))); end; procedure TGTKToggleButton.SetCaption(Value: string); begin gtk_label_set_text(PGtkLabel(ChildControl), PChar(Value)); end; function TGTKToggleButton.GetChecked: boolean; begin Result := gtk_toggle_button_get_active(PGtkToggleButton(FWidget)); end; procedure TGTKToggleButton.SetChecked(Value: boolean); begin gtk_toggle_button_set_active(PGtkToggleButton(FWidget), Value); end; function TGTKToggleButton.GetDrawIndicator: boolean; begin Result := gtk_toggle_button_get_mode(PGtkToggleButton(FWidget)); end; procedure TGTKToggleButton.SetDrawIndicator(Value: boolean); begin gtk_toggle_button_set_mode(PGtkToggleButton(FWidget), Value); end; function TGTKToggleButton.GetInconsistent: boolean; begin Result := gtk_toggle_button_get_inconsistent(PGtkToggleButton(FWidget)); end; procedure TGTKToggleButton.SetInconsistent(Value: boolean); begin gtk_toggle_button_set_inconsistent(PGtkToggleButton(FWidget), Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKCheckButton.Create(AOwner: TComponent); begin inherited Create(AOwner); if ClassName = 'TGTKCheckButton' then begin FWidget := gtk_check_button_new_with_mnemonic(PChar(SCDefaultCheckButtonCaption)); g_signal_connect_data(PGObject(FWidget), 'toggled', TGCallback(@TGTKToggleButton_OnToggled), Self, nil, G_CONNECT_DEFAULT); Show; end; end; constructor TGTKCheckButton.CreateWithLabel(AOwner: TComponent; const ALabel: string); begin inherited Create(AOwner); if ClassName = 'TGTKCheckButton' then begin FWidget := gtk_check_button_new_with_mnemonic(PChar(ALabel)); g_signal_connect_data(PGObject(FWidget), 'toggled', TGCallback(@TGTKToggleButton_OnToggled), Self, nil, G_CONNECT_DEFAULT); Show; end; end; destructor TGTKCheckButton.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKRadioButton.Create(AOwner: TComponent); begin inherited Create(AOwner); if ClassName = 'TGTKRadioButton' then begin FWidget := gtk_radio_button_new_with_label(nil, PChar(SCDefaultRadioButtonCaption)); g_signal_connect_data(PGObject(FWidget), 'toggled', TGCallback(@TGTKToggleButton_OnToggled), Self, nil, G_CONNECT_DEFAULT); Show; end; end; constructor TGTKRadioButton.CreateWithLabel(AOwner: TComponent; const ALabel: string); begin inherited Create(AOwner); if ClassName = 'TGTKRadioButton' then begin FWidget := gtk_radio_button_new_with_mnemonic(nil, PChar(ALabel)); g_signal_connect_data(PGObject(FWidget), 'toggled', TGCallback(@TGTKToggleButton_OnToggled), Self, nil, G_CONNECT_DEFAULT); Show; end; end; destructor TGTKRadioButton.Destroy; begin inherited Destroy; end; procedure TGTKRadioButton.SetRadioGroup(RadioButton: TGTKRadioButton); begin if Assigned(RadioButton) then gtk_radio_button_set_group(PGtkRadioButton(FWidget), gtk_radio_button_get_group(PGtkRadioButton(RadioButton.FWidget))) else gtk_radio_button_set_group(PGtkRadioButton(FWidget), nil); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKFrame.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_frame_new(PChar(SCDefaultFrameCaption)); Show; end; constructor TGTKFrame.CreateWithoutLabel(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_frame_new(nil); Show; end; destructor TGTKFrame.Destroy; begin inherited Destroy; end; function TGTKFrame.GetCaption: string; begin Result := String(gtk_frame_get_label(PGtkFrame(FWidget))); end; procedure TGTKFrame.SetCaption(Value: string); begin gtk_label_set_text(PGtkLabel(gtk_frame_get_label_widget(PGtkFrame(FWidget))), PChar(Value)); end; function TGTKFrame.GetShadowType: TGTKShadowType; begin Result := TGTKShadowType(gtk_frame_get_shadow_type(PGtkFrame(FWidget))); end; procedure TGTKFrame.SetShadowType(Value: TGTKShadowType); begin gtk_frame_set_shadow_type(PGtkFrame(FWidget), gtk2.TGtkShadowType(Value)); end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TGTKEditable_Changed(editable: PGtkEditable; user_data: gpointer); cdecl; begin if Assigned(TGTKEditable(user_data).FOnChanged) then TGTKEditable(user_data).FOnChanged(TGTKEditable(user_data)); end; constructor TGTKEditable.Create(AOwner: TComponent); begin inherited Create(AOwner); FOnChanged := nil; end; destructor TGTKEditable.Destroy; begin inherited Destroy; end; function TGTKEditable.GetEditable: boolean; begin Result := gtk_editable_get_editable(PGtkEditable(FWidget)); end; procedure TGTKEditable.SetEditable(Value: boolean); begin gtk_entry_set_editable(PGtkEntry(FWidget), Value); end; procedure TGTKEditable.CutClipboard; begin gtk_editable_cut_clipboard(PGtkEditable(FWidget)); end; procedure TGTKEditable.CopyClipboard; begin gtk_editable_copy_clipboard(PGtkEditable(FWidget)); end; procedure TGTKEditable.PasteClipboard; begin gtk_editable_paste_clipboard(PGtkEditable(FWidget)); end; procedure TGTKEditable.DeleteSelection; begin gtk_editable_delete_selection(PGtkEditable(FWidget)); end; procedure TGTKEditable.InsertText(AText: string; Position: integer); var pos: gint; begin pos := Position; gtk_editable_insert_text(PGtkEditable(FWidget), PChar(AText), Length(AText), @pos); end; procedure TGTKEditable.DeleteText(StartPosition, EndPosition: integer); begin gtk_editable_delete_text(PGtkEditable(FWidget), StartPosition, EndPosition); end; function TGTKEditable.GetChars(StartPosition, EndPosition: integer): string; begin Result := String(gtk_editable_get_chars(PGtkEditable(FWidget), StartPosition, EndPosition)); end; procedure TGTKEditable.SelectRegion(StartPosition, EndPosition: integer); begin gtk_editable_select_region(PGtkEditable(FWidget), StartPosition, EndPosition); end; function TGTKEditable.GetPosition: integer; begin Result := gtk_editable_get_position(PGtkEditable(FWidget)); end; procedure TGTKEditable.SetPosition(Value: integer); begin gtk_editable_set_position(PGtkEditable(FWidget), Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKEntry.Create(AOwner: TComponent); begin inherited Create(AOwner); FLinked := False; FWidget := gtk_entry_new; Show; g_signal_connect_data(PGObject(FWidget), 'changed', TGCallback(@TGTKEditable_Changed), Self, nil, G_CONNECT_DEFAULT); end; constructor TGTKEntry.CreateFromWidget(AOwner: TComponent; Widget: PGtkWidget); begin inherited Create(AOwner); FLinked := True; FWidget := Widget; g_signal_connect_data(PGObject(FWidget), 'changed', TGCallback(@TGTKEditable_Changed), Self, nil, G_CONNECT_DEFAULT); end; destructor TGTKEntry.Destroy; begin if not FLinked then inherited Destroy; end; function TGTKEntry.GetText: string; begin Result := String(gtk_entry_get_text(PGtkEntry(FWidget))); end; procedure TGTKEntry.SetText(Value: string); begin gtk_entry_set_text(PGtkEntry(FWidget), PChar(Value)); end; function TGTKEntry.GetMaxLength: integer; begin Result := gtk_entry_get_max_length(PGtkEntry(FWidget)); end; procedure TGTKEntry.SetMaxLength(Value: integer); begin gtk_entry_set_max_length(PGtkEntry(FWidget), Value); end; function TGTKEntry.GetVisibility: boolean; begin Result := gtk_entry_get_visibility(PGtkEntry(FWidget)); end; procedure TGTKEntry.SetVisibility(Value: boolean); begin gtk_entry_set_visibility(PGtkEntry(FWidget), Value); end; procedure TGTKEntry.SelectAll; begin SelectRegion(0, Length(Text)); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKCombo.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_combo_new; Items := TGList.Create(Self); Items.Notify := @ItemsChanged; Entry := TGTKEntry.CreateFromWidget(Self, PGtkCombo(FWidget)^.entry); Show; end; destructor TGTKCombo.Destroy; begin Items.Free; inherited Destroy; end; procedure TGTKCombo.UpdateItems; begin gtk_combo_set_popdown_strings(PGtkCombo(FWidget), GLIB2.PGList(Items.FList)); end; function TGTKCombo.GetAllowEmpty: boolean; var b: gboolean; begin b := False; g_object_get(PGObject(FWidget), 'allow-empty', [@b, nil]); Result := b; end; procedure TGTKCombo.SetAllowEmpty(Value: boolean); begin g_object_set(PGObject(FWidget), 'allow-empty', [Ord(Value), nil]); end; function TGTKCombo.GetMatchValue: boolean; var b: gboolean; begin b := False; g_object_get(PGObject(FWidget), 'value-in-list', [@b, nil]); Result := b; end; procedure TGTKCombo.SetMatchValue(Value: boolean); begin g_object_set(PGObject(FWidget), 'value-in-list', [Ord(Value), nil]); end; procedure TGTKCombo.SetPolicy(MatchValue, AllowEmpty: boolean); begin gtk_combo_set_value_in_list(PGtkCombo(FWidget), MatchValue, AllowEmpty); end; function TGTKCombo.GetCaseSensitive: boolean; var b: gboolean; begin b := False; g_object_get(PGObject(FWidget), 'case-sensitive', [@b, nil]); Result := b; end; procedure TGTKCombo.SetCaseSensitive(Value: boolean); begin gtk_combo_set_case_sensitive(PGtkCombo(FWidget), Value); end; procedure TGTKCombo.DisableActivate; begin gtk_combo_disable_activate(PGtkCombo(FWidget)); end; procedure TGTKCombo.ItemsChanged(Sender: TObject); begin UpdateItems; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKSpinEdit.Create(AOwner: TComponent); begin inherited Create(AOwner); FAdjustment := PGtkAdjustment(gtk_adjustment_new(0, 0, 0, 1, 10, 0)); FWidget := gtk_spin_button_new(FAdjustment, 1, 0); Show; end; destructor TGTKSpinEdit.Destroy; begin inherited Destroy; end; function TGTKSpinEdit.GetDigits: integer; begin Result := gtk_spin_button_get_digits(PGtkSpinButton(FWidget)); end; procedure TGTKSpinEdit.SetDigits(AValue: integer); begin gtk_spin_button_set_digits(PGtkSpinButton(FWidget), AValue); end; function TGTKSpinEdit.GetMin: Double; var amin: Double; begin amin := 0; gtk_spin_button_get_range(PGtkSpinButton(FWidget), @amin, nil); Result := amin; end; procedure TGTKSpinEdit.SetMin(AValue: Double); begin gtk_spin_button_set_range(PGtkSpinButton(FWidget), AValue, Max); end; function TGTKSpinEdit.GetMax: Double; var amax: Double; begin amax := 1; gtk_spin_button_get_range(PGtkSpinButton(FWidget), nil, @amax); Result := amax; end; procedure TGTKSpinEdit.SetMax(AValue: Double); begin gtk_spin_button_set_range(PGtkSpinButton(FWidget), Min, AValue); end; function TGTKSpinEdit.GetIncrementStep: Double; var astep: Double; begin astep := 1; gtk_spin_button_get_increments(PGtkSpinButton(FWidget), @astep, nil); Result := astep; end; procedure TGTKSpinEdit.SetIncrementStep(AValue: Double); begin gtk_spin_button_set_increments(PGtkSpinButton(FWidget), AValue, IncrementPage); end; function TGTKSpinEdit.GetIncrementPage: Double; var apage: Double; begin apage := 1; gtk_spin_button_get_increments(PGtkSpinButton(FWidget), nil, @apage); Result := apage; end; procedure TGTKSpinEdit.SetIncrementPage(AValue: Double); begin gtk_spin_button_set_increments(PGtkSpinButton(FWidget), IncrementStep, AValue); end; function TGTKSpinEdit.GetValue: Double; begin Result := gtk_spin_button_get_value(PGtkSpinButton(FWidget)); end; procedure TGTKSpinEdit.SetValue(AValue: Double); begin gtk_spin_button_set_value(PGtkSpinButton(FWidget), AValue); end; function TGTKSpinEdit.GetAsInteger: integer; begin Result := gtk_spin_button_get_value_as_int(PGtkSpinButton(FWidget)); end; procedure TGTKSpinEdit.SetAsInteger(AValue: integer); begin gtk_spin_button_set_value(PGtkSpinButton(FWidget), AValue); end; (********************************************************************************************************************************) (********************************************************************************************************************************) end.