(* GTK-Kylix Library: GTKExtCtrls - Extended visual controls Version 0.6.22 (last updated 2004-11-20) Copyright (C) 2004 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 GTKExtCtrls; { $WEAKPACKAGEUNIT} interface uses gtk2, gdk2, glib2, Classes, GTKControls, GTKConsts, GTKStdCtrls, GTKUtils, GTKMenus; // Quick jump: QForms QControls QStdCtrls QExtCtrls type (****************************************** TGTKSEPARATOR ***********************************************************************) TGTKSeparator = class(TGTKControl) public constructor Create(AOwner: TComponent); override; destructor Destroy; override; end; (****************************************** TGTKHSEPARATOR **********************************************************************) TGTKHSeparator = class(TGTKSeparator) public constructor Create(AOwner: TComponent); override; end; (****************************************** TGTKVSEPARATOR **********************************************************************) TGTKVSeparator = class(TGTKSeparator) public constructor Create(AOwner: TComponent); override; end; (****************************************** TGTKHANDLEBOX ***********************************************************************) TGTKHandleBox = class(TGTKBin) private function GetShadowType: TGTKShadowType; function GetHandlePosition: TGTKPosition; function GetSnapEdge: TGTKPosition; procedure SetShadowType(Value: TGTKShadowType); procedure SetHandlePosition(Value: TGTKPosition); procedure SetSnapEdge(Value: TGTKPosition); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property ShadowType: TGTKShadowType read GetShadowType write SetShadowType; property HandlePosition: TGTKPosition read GetHandlePosition write SetHandlePosition; property SnapEdge: TGTKPosition read GetSnapEdge write SetSnapEdge; end; (****************************************** TGTKPROGRESSBAR *********************************************************************) TGTKProgressBarOrientation = (poLeftToRight, poRightToLeft, poBottomToTop, poTopToBottom); TGTKProgressBar = class(TGTKControl) private FMax: Int64; function GetText: string; function GetFraction: Double; function GetPulseStep: Double; function GetOrientation: TGTKProgressBarOrientation; function GetValue: Int64; procedure SetText(Value: string); procedure SetFraction(Value: Double); procedure SetPulseStep(Value: Double); procedure SetOrientation(Value: TGTKProgressBarOrientation); procedure SetValue(Value: Int64); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure Pulse; published property Text: string read GetText write SetText; property Fraction: Double read GetFraction write SetFraction; property PulseStep: Double read GetPulseStep write SetPulseStep; property Orientation: TGTKProgressBarOrientation read GetOrientation write SetOrientation; property Max: Int64 read FMax write FMax; property Value: Int64 read GetValue write SetValue; end; (****************************************** TGTKPANED ***************************************************************************) TGTKPaned = class(TGTKContainer) private FChild1, FChild2: TGTKControl; FOnResize: TNotifyEvent; function GetPosition: integer; procedure SetPosition(Value: integer); procedure SetChild1(Value: TGTKControl); procedure SetChild2(Value: TGTKControl); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Child1: TGTKControl read FChild1 write SetChild1; property Child2: TGTKControl read FChild2 write SetChild2; property Position: integer read GetPosition write SetPosition; property OnResize: TNotifyEvent read FOnResize write FOnResize; end; (****************************************** TGTKHPANED **************************************************************************) TGTKHPaned = class(TGTKPaned) public constructor Create(AOwner: TComponent); override; end; (****************************************** TGTKVPANED **************************************************************************) TGTKVPaned = class(TGTKPaned) public constructor Create(AOwner: TComponent); override; end; (****************************************** TGTKNOTEBOOK ************************************************************************) TGTKNotebook = class(TGTKContainer) private FOnSwitchPage: TNotifyEvent; function GetPageIndex: integer; function GetTabPosition: TGTKPosition; function GetShowTabs: boolean; function GetShowBorder: boolean; function GetScrollable: boolean; procedure SetPageIndex(Value: integer); procedure SetTabPosition(Value: TGTKPosition); procedure SetShowTabs(Value: boolean); procedure SetShowBorder(Value: boolean); procedure SetScrollable(Value: boolean); public constructor Create(AOwner: TComponent); virtual; destructor Destroy; virtual; function AppendPage(Child: TGTKControl; Caption: string): integer; procedure RemovePage(PageNo: integer); function GetCaption(PageNo: integer): string; procedure SetCaption(PageNo: integer; Caption: string); procedure NextPage; procedure PrevPage; function GetExpandTab(PageNo: integer): boolean; procedure SetExpandTab(PageNo: integer; Value: boolean); function GetFillTab(PageNo: integer): boolean; procedure SetFillTab(PageNo: integer; Value: boolean); function GetTabLabel(PageNo: integer): TGTKLabel; published property PageIndex: integer read GetPageIndex write SetPageIndex; property TabPosition: TGTKPosition read GetTabPosition write SetTabPosition; property ShowTabs: boolean read GetShowTabs write SetShowTabs; property ShowBorder: boolean read GetShowBorder write SetShowBorder; property Scrollable: boolean read GetScrollable write SetScrollable; property OnSwitchPage: TNotifyEvent read FOnSwitchPage write FOnSwitchPage; end; (****************************************** TGTKOPTIONMENU **********************************************************************) TGTKOptionMenu = class(TGTKButton) private FItems: TGTKMenuItem; FOnChanged: TNotifyEvent; procedure ItemsChanged(Sender: TObject); function GetItemIndex: integer; procedure SetItemIndex(Value: integer); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; published property Items: TGTKMenuItem read FItems; property ItemIndex: integer read GetItemIndex write SetItemIndex; property OnChanged: TNotifyEvent read FOnChanged write FOnChanged; end; (****************************************** TGTKSCROLLEDWINDOW ******************************************************************) TGTKScrollBarPolicy = (sbAlways, sbAutomatic, sbNever); TGTKScrolledWindow = class(TGTKBin) private function GetHorizScrollBarPolicy: TGTKScrollBarPolicy; function GetVertScrollBarPolicy: TGTKScrollBarPolicy; procedure SetHorizScrollBarPolicy(Value: TGTKScrollBarPolicy); procedure SetVertScrollBarPolicy(Value: TGTKScrollBarPolicy); function GetShadowType: TGTKShadowType; procedure SetShadowType(Value: TGTKShadowType); public constructor Create(AOwner: TComponent); override; destructor Destroy; override; procedure AddWithViewPort(Control: TGTKControl); published property HorizScrollBarPolicy: TGTKScrollBarPolicy read GetHorizScrollBarPolicy write SetHorizScrollBarPolicy; property VertScrollBarPolicy: TGTKScrollBarPolicy read GetVertScrollBarPolicy write SetVertScrollBarPolicy; property ShadowType: TGTKShadowType read GetShadowType write SetShadowType; end; (****************************************** TGTKBUTTONBOX ***********************************************************************) TGTKButtonBoxLayout = (blDefault, blSpread, blEdge, blStart, blEnd); TGTKButtonBox = class(TGTKBox) private function GetLayout: TGTKButtonBoxLayout; procedure SetLayout(Value: TGTKButtonBoxLayout); public constructor Create(AOwner: TComponent); override; published property Layout: TGTKButtonBoxLayout read GetLayout write SetLayout; end; (****************************************** TGTKHBUTTONBOX **********************************************************************) TGTKHButtonBox = class(TGTKButtonBox) public constructor Create(AOwner: TComponent); override; end; (****************************************** TGTKVBUTTONBOX **********************************************************************) TGTKVButtonBox = class(TGTKButtonBox) public constructor Create(AOwner: TComponent); override; end; (********************************************************************************************************************************) (********************************************************************************************************************************) implementation (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKSeparator.Create(AOwner: TComponent); begin inherited Create(AOwner); end; destructor TGTKSeparator.Destroy; begin inherited Destroy; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKHSeparator.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_hseparator_new; Show; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKVSeparator.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_vseparator_new; Show; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKHandleBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_handle_box_new; Show; end; destructor TGTKHandleBox.Destroy; begin inherited Destroy; end; function TGTKHandleBox.GetShadowType: TGTKShadowType; begin Result := TGTKShadowType(gtk_handle_box_get_shadow_type(PGtkHandleBox(FWidget))); end; procedure TGTKHandleBox.SetShadowType(Value: TGTKShadowType); begin gtk_handle_box_set_shadow_type(PGtkHandleBox(FWidget), gtk2.TGtkShadowType(Value)); end; function TGTKHandleBox.GetHandlePosition: TGTKPosition; begin Result := TGTKPosition(gtk_handle_box_get_handle_position(PGtkHandleBox(FWidget))); end; procedure TGTKHandleBox.SetHandlePosition(Value: TGTKPosition); begin gtk_handle_box_set_handle_position(PGtkHandleBox(FWidget), Integer(Value)); end; function TGTKHandleBox.GetSnapEdge: TGTKPosition; begin Result := TGTKPosition(gtk_handle_box_get_snap_edge(PGtkHandleBox(FWidget))); end; procedure TGTKHandleBox.SetSnapEdge(Value: TGTKPosition); begin gtk_handle_box_set_snap_edge(PGtkHandleBox(FWidget), Integer(Value)); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKProgressBar.Create(AOwner: TComponent); begin inherited Create(AOwner); FMax := 100; FWidget := gtk_progress_bar_new; Show; end; destructor TGTKProgressBar.Destroy; begin inherited Destroy; end; procedure TGTKProgressBar.Pulse; begin gtk_progress_bar_pulse(PGtkProgressBar(FWidget)); end; function TGTKProgressBar.GetText: string; begin Result := PgcharToString(gtk_progress_bar_get_text(PGtkProgressBar(FWidget))); end; procedure TGTKProgressBar.SetText(Value: string); begin gtk_progress_bar_set_text(PGtkProgressbar(FWidget), StringToPgchar(Value)); end; function TGTKProgressBar.GetFraction: Double; begin Result := gtk_progress_bar_get_fraction(PGtkProgressbar(FWidget)); end; procedure TGTKProgressBar.SetFraction(Value: Double); begin gtk_progress_bar_set_fraction(PGtkProgressbar(FWidget), Value); end; function TGTKProgressBar.GetPulseStep: Double; begin Result := gtk_progress_bar_get_pulse_step(PGtkProgressbar(FWidget)); end; procedure TGTKProgressBar.SetPulseStep(Value: Double); begin gtk_progress_bar_set_pulse_step(PGtkProgressbar(FWidget), Value); end; function TGTKProgressBar.GetOrientation: TGTKProgressBarOrientation; begin Result := TGTKProgressBarOrientation(gtk_progress_bar_get_orientation(PGtkProgressBar(FWidget))); end; procedure TGTKProgressBar.SetOrientation(Value: TGTKProgressBarOrientation); begin gtk_progress_bar_set_orientation(PGtkProgressbar(FWidget), gtk2.TGtkProgressBarOrientation(Value)); end; function TGTKProgressBar.GetValue: Int64; begin Result := Round(Fraction * Max); end; procedure TGTKProgressBar.SetValue(Value: Int64); begin if FMax = 0 then Fraction := 0 else Fraction := Value / FMax; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TGTKPaned_resize(widget : PGtkWidget; allocation : PGtkAllocation; user_data : gpointer); cdecl; begin if Assigned(TGTKPaned(user_data).FOnResize) then TGTKPaned(user_data).FOnResize(TGTKPaned(user_data)); end; constructor TGTKPaned.Create(AOwner: TComponent); begin inherited Create(AOwner); FChild1 := nil; FChild2 := nil; end; destructor TGTKPaned.Destroy; begin inherited Destroy; end; procedure TGTKPaned.SetChild1(Value: TGTKControl); begin gtk_paned_pack1(PGtkPaned(FWidget), Value.FWidget, True, False); g_signal_connect(PGtkObject(Value.FWidget), 'size-allocate', G_CALLBACK(@TGTKPaned_resize), Self); end; procedure TGTKPaned.SetChild2(Value: TGTKControl); begin gtk_paned_pack2(PGtkPaned(FWidget), Value.FWidget, True, False); end; function TGTKPaned.GetPosition: integer; begin Result := gtk_paned_get_position(PGtkPaned(FWidget)); end; procedure TGTKPaned.SetPosition(Value: integer); begin gtk_paned_set_position(PGtkPaned(FWidget), Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKHPaned.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_hpaned_new; Show; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKVPaned.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_vpaned_new; Show; end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TGTKNotebook_switch_page(notebook: PGtkNotebook; page: PGtkNotebookPage; page_num: guint; user_data: gpointer); cdecl; begin if Assigned(user_data) and Assigned(TGTKNotebook(user_data).FOnSwitchPage) then TGTKNotebook(user_data).FOnSwitchPage(user_data); end; constructor TGTKNotebook.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_notebook_new; FOnSwitchPage := nil; g_signal_connect_after(PGtkObject(FWidget), 'switch-page', G_CALLBACK(@TGTKNotebook_switch_page), Self); Show; end; destructor TGTKNotebook.Destroy; begin inherited Destroy; end; function TGTKNotebook.AppendPage(Child: TGTKControl; Caption: string): integer; begin Result := gtk_notebook_append_page(PGtkNotebook(FWidget), Child.FWidget, nil); gtk_notebook_set_tab_label_text(PGtkNotebook(FWidget), Child.FWidget, StringToPgchar(Caption)); end; function TGTKNotebook.GetCaption(PageNo: integer): string; begin Result := PgcharToString(gtk_notebook_get_tab_label_text(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo))); end; procedure TGTKNotebook.SetCaption(PageNo: integer; Caption: string); begin gtk_notebook_set_tab_label_text(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), StringToPgchar(Caption)); end; procedure TGTKNotebook.RemovePage(PageNo: integer); begin gtk_notebook_remove_page(PGtkNotebook(FWidget), PageNo); end; function TGTKNotebook.GetPageIndex: integer; begin Result := gtk_notebook_get_current_page(PGtkNotebook(FWidget)); end; procedure TGTKNotebook.SetPageIndex(Value: integer); begin gtk_notebook_set_page(PGtkNotebook(FWidget), Value); end; procedure TGTKNotebook.NextPage; begin gtk_notebook_next_page(PGtkNotebook(FWidget)); end; procedure TGTKNotebook.PrevPage; begin gtk_notebook_prev_page(PGtkNotebook(FWidget)); end; function TGTKNotebook.GetTabPosition: TGTKPosition; begin Result := TGTKPosition(gtk_notebook_get_tab_pos(PGtkNotebook(FWidget))); end; procedure TGTKNotebook.SetTabPosition(Value: TGTKPosition); begin gtk_notebook_set_tab_pos(PGtkNotebook(FWidget), Integer(Value)); end; function TGTKNotebook.GetShowTabs: boolean; begin Result := gtk_notebook_get_show_tabs(PGtkNotebook(FWidget)); end; procedure TGTKNotebook.SetShowTabs(Value: boolean); begin gtk_notebook_set_show_tabs(PGtkNotebook(FWidget), Value); end; function TGTKNotebook.GetShowBorder: boolean; begin Result := gtk_notebook_get_show_border(PGtkNotebook(FWidget)); end; procedure TGTKNotebook.SetShowBorder(Value: boolean); begin gtk_notebook_set_show_border(PGtkNotebook(FWidget), Value); end; function TGTKNotebook.GetScrollable: boolean; begin Result := gtk_notebook_get_scrollable(PGtkNotebook(FWidget)); end; procedure TGTKNotebook.SetScrollable(Value: boolean); begin gtk_notebook_set_scrollable(PGtkNotebook(FWidget), Value); end; function TGTKNotebook.GetExpandTab(PageNo: integer): boolean; var expand, fill: Pgboolean; packtype: PGtkPackType; begin gtk_notebook_query_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), expand, fill, packtype); Result := expand <> nil; end; procedure TGTKNotebook.SetExpandTab(PageNo: integer; Value: boolean); begin gtk_notebook_set_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), Value, GetFillTab(PageNo), GTK_PACK_START); end; function TGTKNotebook.GetFillTab(PageNo: integer): boolean; var expand, fill: Pgboolean; packtype: PGtkPackType; begin gtk_notebook_query_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), expand, fill, packtype); Result := fill <> nil; end; procedure TGTKNotebook.SetFillTab(PageNo: integer; Value: boolean); begin gtk_notebook_set_tab_label_packing(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo), GetExpandTab(PageNo), Value, GTK_PACK_START); end; function TGTKNotebook.GetTabLabel(PageNo: integer): TGTKLabel; begin Result := TGTKLabel.CreateFromWidget(Self, gtk_notebook_get_tab_label(PGtkNotebook(FWidget), gtk_notebook_get_nth_page(PGtkNotebook(FWidget), PageNo))); end; (********************************************************************************************************************************) (********************************************************************************************************************************) procedure TGTKOptionMenu_changed(optionmenu: PGtkOptionMenu; user_data: pgpointer); cdecl; begin if Assigned(TGTKOptionMenu(user_data).FOnChanged) then TGTKOptionMenu(user_data).FOnChanged(TGTKOptionMenu(user_data)); end; constructor TGTKOptionMenu.Create(AOwner: TComponent); begin inherited Create(AOwner); FOnChanged := nil; FWidget := gtk_option_menu_new; g_signal_connect(PGtkObject(FWidget), 'changed', G_CALLBACK(@TGTKOptionMenu_changed), Self); Show; FItems := TGTKMenuItem.Create(Self); FItems.FParentMenu := Self; FItems.Notify := ItemsChanged; end; destructor TGTKOptionMenu.Destroy; begin FItems.Notify := nil; FItems.Free; inherited Destroy; end; procedure TGTKOptionMenu.ItemsChanged(Sender: TObject); begin if Assigned(FItems.FMenu) and (gtk_option_menu_get_menu(PGtkOptionMenu(FWidget)) <> FItems.FMenu) then gtk_option_menu_set_menu(PGtkOptionMenu(FWidget), FItems.FMenu); end; function TGTKOptionMenu.GetItemIndex: integer; begin Result := gtk_option_menu_get_history(PGtkOptionMenu(FWidget)); end; procedure TGTKOptionMenu.SetItemIndex(Value: integer); begin gtk_option_menu_set_history(PGtkOptionMenu(FWidget), Value); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKScrolledWindow.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_scrolled_window_new(nil, nil); Show; end; destructor TGTKScrolledWindow.Destroy; begin inherited Destroy; end; function TGTKScrolledWindow.GetHorizScrollBarPolicy: TGTKScrollBarPolicy; var hscrollbar, vscrollbar: tGtkPolicyType; begin gtk_scrolled_window_get_policy(PGtkScrolledWindow(FWidget), @hscrollbar, @vscrollbar); Result := TGTKScrollBarPolicy(hscrollbar); end; procedure TGTKScrolledWindow.SetHorizScrollBarPolicy(Value: TGTKScrollBarPolicy); begin gtk_scrolled_window_set_policy(PGtkScrolledWindow(FWidget), TGtkPolicyType(Value), TGtkPolicyType(VertScrollBarPolicy)); end; function TGTKScrolledWindow.GetVertScrollBarPolicy: TGTKScrollBarPolicy; var hscrollbar, vscrollbar: tGtkPolicyType; begin gtk_scrolled_window_get_policy(PGtkScrolledWindow(FWidget), @hscrollbar, @vscrollbar); Result := TGTKScrollBarPolicy(vscrollbar); end; procedure TGTKScrolledWindow.SetVertScrollBarPolicy(Value: TGTKScrollBarPolicy); begin gtk_scrolled_window_set_policy(PGtkScrolledWindow(FWidget), TGtkPolicyType(HorizScrollBarPolicy), TGtkPolicyType(Value)); end; function TGTKScrolledWindow.GetShadowType: TGTKShadowType; begin Result := TGTKShadowType(gtk_scrolled_window_get_shadow_type(PGtkScrolledWindow(FWidget))); end; procedure TGTKScrolledWindow.SetShadowType(Value: TGTKShadowType); begin gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(FWidget), gtk2.TGtkShadowType(Value)); end; procedure TGTKScrolledWindow.AddWithViewPort(Control: TGTKControl); begin gtk_scrolled_window_add_with_viewport(PGtkScrolledWindow(FWidget), Control.FWidget); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKButtonBox.Create(AOwner: TComponent); begin inherited Create(AOwner); end; function TGTKButtonBox.GetLayout: TGTKButtonBoxLayout; begin Result := TGTKButtonBoxLayout(gtk_button_box_get_layout(PGtkButtonBox(FWidget))); end; procedure TGTKButtonBox.SetLayout(Value: TGTKButtonBoxLayout); begin gtk_button_box_set_layout(PGtkButtonBox(FWidget), Integer(Value)); end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKHButtonBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_hbutton_box_new; Show; end; (********************************************************************************************************************************) (********************************************************************************************************************************) constructor TGTKVButtonBox.Create(AOwner: TComponent); begin inherited Create(AOwner); FWidget := gtk_vbutton_box_new; Show; end; (********************************************************************************************************************************) (********************************************************************************************************************************) end.