paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-30 19:03:41 +02:00
Code Issues Packages Projects Releases Wiki Activity
a13572de2b
lazarus/lcl/interfaces/gtk2/gtk2wsstdctrls.pp
mattias de37ee0a8f lcl: gtk2: simplified unit dependencies
2023-08-25 12:34:07 +02:00

3043 lines
108 KiB
ObjectPascal
Raw Blame History

{
*****************************************************************************
* Gtk2WSStdCtrls.pp *
* ----------------- *
* *
* *
*****************************************************************************
*****************************************************************************
This file is part of the Lazarus Component Library (LCL)
See the file COPYING.modifiedLGPL.txt, included in this distribution,
for details about the license.
*****************************************************************************
}
unit Gtk2WSStdCtrls;
{$mode objfpc}{$H+}
{$PACKRECORDS c}
interface
uses
// RTL
glib2, gdk2, gtk2,
Classes, SysUtils, Math,
// LazUtils
LazLoggerBase, LazTracer, LazStringUtils,
// LCL
Controls, Graphics, StdCtrls, LMessages, LCLType, LazUTF8,
LCLMessageGlue, Forms,
// Widgetset
WSControls, WSProc, WSStdCtrls, Gtk2Int, Gtk2Def,
Gtk2CellRenderer, Gtk2Globals, Gtk2Proc, InterfaceBase,
Gtk2WSControls, Gtk2Extra;
type
{ !!! Both are used: TGtkComboBoxEntry (with entry) and TGtkComboBox (without entry),
but not the old TGtkCombo !!! }
PGtkComboBoxPrivate = ^TGtkComboBoxPrivate;
TGtkComboBoxPrivate = record
model: PGtkTreeModel;
col_column,
row_column: gint;
wrap_width: gint;
active_row: PGtkTreeRowReference;
tree_view: PGtkWidget;
column: PGtkTreeViewColumn;
cell_view: PGtkWidget;
cell_view_frame: PGtkWidget;
button: PGtkwidget;
box: PGtkWidget;
arrow: PGtkWidget;
serarator: PGtkWidget;
popup_widget: PGtkWidget;
popup_window: PGtkWidget;
popup_frame: PGtkWidget;
scrolled_window: PGtkwidget;
end;
{ TGtk2WSScrollBar }
TGtk2WSScrollBar = class(TWSScrollBar)
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetKind(const AScrollBar: TCustomScrollBar; const {%H-}AIsHorizontal: Boolean); override;
class procedure SetParams(const AScrollBar: TCustomScrollBar); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class procedure ScrollBy(const AWinControl: TWinControl; DeltaX, DeltaY: integer); override;
end;
{ TGtk2WSCustomGroupBox }
TGtk2WSCustomGroupBox = class(TWSCustomGroupBox)
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
class procedure SetLabel(AFrame: PGtkFrame; AText: String);
class function GetFrameWidget(AEventBox: PGtkEventBox): PGtkFrame;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetColor(const AWinControl: TWinControl); override;
class function GetDefaultClientRect(const AWinControl: TWinControl;
const {%H-}aLeft, {%H-}aTop, aWidth, aHeight: integer; var aClientRect: TRect
): boolean; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); override;
end;
{ TGtk2WSGroupBox }
TGtk2WSGroupBox = class(TWSGroupBox)
published
end;
{ TGtk2WSCustomComboBox }
{ !!! Both are used: TGtkComboBoxEntry (with entry) and TGtkComboBox (without entry),
but not the old TGtkCombo !!! }
TGtk2WSCustomComboBox = class(TWSCustomComboBox)
protected
class procedure ReCreateCombo(const ACustomComboBox: TCustomComboBox; const AWithEntry: Boolean; const AWidgetInfo: PWidgetInfo); virtual;
class procedure SetRenderer(const ACustomComboBox: TCustomComboBox; AWidget: PGtkWidget; AWidgetInfo: PWidgetInfo); virtual;
class procedure SetCallbacks(const AWinControl: tWinControl; const AWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
class procedure SetSensitivity(AWinControl: TWinControl; AWidget: PGtkWidget);
published
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean); override;
class function GetDroppedDown(const ACustomComboBox: TCustomComboBox): Boolean; override;
class function GetSelStart(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetSelLength(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetItemIndex(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetMaxLength(const ACustomComboBox: TCustomComboBox): integer; override;
class function GetText(const AWinControl: TWinControl; var AText: String): Boolean; override;
class procedure SetArrowKeysTraverseList(const {%H-}ACustomComboBox: TCustomComboBox;
{%H-}NewTraverseList: boolean); override;
class procedure SetDroppedDown(const ACustomComboBox: TCustomComboBox; ADroppedDown: Boolean); override;
class procedure SetSelStart(const ACustomComboBox: TCustomComboBox; NewStart: integer); override;
class procedure SetSelLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
class procedure SetItemIndex(const ACustomComboBox: TCustomComboBox; NewIndex: integer); override;
class procedure SetMaxLength(const ACustomComboBox: TCustomComboBox; NewLength: integer); override;
class procedure SetStyle(const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle); override;
class procedure SetReadOnly(const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean); override;
class function GetItems(const ACustomComboBox: TCustomComboBox): TStrings; override;
class procedure Sort(const ACustomComboBox: TCustomComboBox; {%H-}AList: TStrings; IsSorted: boolean); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
class function CanFocus(const AWinControl: TWinControl): boolean; override;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure DestroyHandle(const AWinControl: TWinControl); override;
end;
{ TGtk2WSComboBox }
TGtk2WSComboBox = class(TWSComboBox)
published
end;
{ TGtk2WSCustomListBox }
TGtk2WSCustomListBox = class(TWSCustomListBox)
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class function GetIndexAtXY(const ACustomListBox: TCustomListBox; {%H-}X, Y: integer): integer; override;
class function GetItemIndex(const ACustomListBox: TCustomListBox): integer; override;
class function GetItemRect(const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect): boolean; override;
class function GetScrollWidth(const ACustomListBox: TCustomListBox): Integer; override;
class function GetSelCount(const ACustomListBox: TCustomListBox): integer; override;
class function GetSelected(const ACustomListBox: TCustomListBox; const AIndex: integer): boolean; override;
class function GetStrings(const ACustomListBox: TCustomListBox): TStrings; override;
class function GetTopIndex(const ACustomListBox: TCustomListBox): integer; override;
class procedure SelectItem(const ACustomListBox: TCustomListBox; AnIndex: integer; ASelected: boolean); override;
class procedure SetBorder(const ACustomListBox: TCustomListBox); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetItemIndex(const ACustomListBox: TCustomListBox; const AIndex: integer); override;
class procedure SetScrollWidth(const ACustomListBox: TCustomListBox; const AScrollWidth: Integer); override;
class procedure SetSelectionMode(const ACustomListBox: TCustomListBox; const {%H-}AExtendedSelect,
AMultiSelect: boolean); override;
class procedure SetStyle(const ACustomListBox: TCustomListBox); override;
class procedure SetSorted(const {%H-}ACustomListBox: TCustomListBox; AList: TStrings; ASorted: boolean); override;
class procedure SetTopIndex(const ACustomListBox: TCustomListBox; const NewTopIndex: integer); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
{ TGtk2WSListBox }
TGtk2WSListBox = class(TWSListBox)
published
end;
{ TGtk2WSCustomEdit }
TGtk2WSCustomEdit = class(TWSCustomEdit)
published
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override;
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override;
class procedure SetCharCase(const {%H-}ACustomEdit: TCustomEdit; {%H-}NewCase: TEditCharCase); override;
class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetPasswordChar(const ACustomEdit: TCustomEdit; {%H-}NewChar: char); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetSelText(const ACustomEdit: TCustomEdit; const NewSelText: string); override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetAlignment(const ACustomEdit: TCustomEdit; const AAlignment: TAlignment); override;
class procedure Cut(const ACustomEdit: TCustomEdit); override;
class procedure Copy(const ACustomEdit: TCustomEdit); override;
class procedure Paste(const ACustomEdit: TCustomEdit); override;
class procedure Undo(const ACustomEdit: TCustomEdit); override;
end;
{ TGtk2WSCustomMemo }
TGtk2WSCustomMemo = class(TWSCustomMemo)
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class function GetSelStart(const ACustomEdit: TCustomEdit): integer; override;
class function GetSelLength(const ACustomEdit: TCustomEdit): integer; override;
class function GetStrings(const ACustomMemo: TCustomMemo): TStrings; override;
class procedure SetAlignment(const ACustomEdit: TCustomEdit; const AAlignment: TAlignment); override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetSelStart(const ACustomEdit: TCustomEdit; NewStart: integer); override;
class procedure SetSelLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetWantTabs(const ACustomMemo: TCustomMemo; const NewWantTabs: boolean); override;
class procedure SetEchoMode(const {%H-}ACustomEdit: TCustomEdit; {%H-}NewMode: TEchoMode); override;
class procedure SetPasswordChar(const {%H-}ACustomEdit: TCustomEdit; {%H-}NewChar: char); override;
class procedure SetWordWrap(const ACustomMemo: TCustomMemo; const NewWordWrap: boolean); override;
class procedure SetCharCase(const {%H-}ACustomEdit: TCustomEdit; {%H-}NewCase: TEditCharCase); override;
class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
class procedure SetReadOnly(const ACustomEdit: TCustomEdit; NewReadOnly: boolean); override;
class procedure SetSelText(const ACustomEdit: TCustomEdit; const NewSelText: string); override;
class procedure SetText(const AWinControl: TWinControl; const AText: string); override;
class procedure SetScrollbars(const ACustomMemo: TCustomMemo; const NewScrollbars: TScrollStyle); override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function GetCaretPos(const ACustomEdit: TCustomEdit): TPoint; override;
class procedure SetCaretPos(const ACustomEdit: TCustomEdit; const NewPos: TPoint); override;
end;
{ TGtk2WSEdit }
TGtk2WSEdit = class(TWSEdit)
published
end;
{ TGtk2WSMemo }
TGtk2WSMemo = class(TWSMemo)
published
end;
{ TGtk2WSCustomLabel }
{
TGtk2WSCustomLabel = class(TWSCustomLabel)
private
protected
public
end;
}
{ TGtk2WSLabel }
{
TGtk2WSLabel = class(TWSLabel)
private
protected
public
end;
}
{ TGtk2WSButtonControl }
TGtk2WSButtonControl = class(TWSButtonControl)
published
end;
{ TGtk2WSButton }
TGtk2WSButton = class(TWSButton)
protected
class function GetButtonWidget(AEventBox: PGtkEventBox): PGtkButton;
class function GetLabelWidget(AEventBox: PGtkEventBox): PGtkLabel;
public
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function GetText(const {%H-}AWinControl: TWinControl; var {%H-}AText: String): Boolean; override;
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override;
class procedure SetShortcut(const AButton: TCustomButton; const {%H-}ShortCutK1, {%H-}ShortCutK2: TShortcut); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
end;
{ TGtk2WSCustomCheckBox }
TGtk2WSCustomCheckBox = class(TWSCustomCheckBox)
protected
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo); virtual;
published
class function CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function RetrieveState(const ACustomCheckBox: TCustomCheckBox): TCheckBoxState; override;
class procedure SetShortCut(const ACustomCheckBox: TCustomCheckBox; const ShortCutK1, {%H-}ShortCutK2: TShortCut); override;
class procedure SetState(const ACustomCheckBox: TCustomCheckBox;
const NewState: TCheckBoxState); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
class procedure ShowHide(const AWinControl: TWinControl); override;
end;
{ TGtk2WSCheckBox }
TGtk2WSCheckBox = class(TWSCheckBox)
published
end;
{ TGtk2WSToggleBox }
TGtk2WSToggleBox = class(TWSToggleBox)
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
end;
{ TGtk2WSRadioButton }
TGtk2WSRadioButton = class(TWSRadioButton)
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
end;
{ TGtk2WSCustomStaticText }
TGtk2WSCustomStaticText = class(TWSCustomStaticText)
protected
class function GetLabelWidget(AFrame: PGtkFrame): PGtkLabel;
class function GetBoxWidget(AFrame: PGtkFrame): PGtkEventBox;
published
class function CreateHandle(const AWinControl: TWinControl; const AParams: TCreateParams): TLCLIntfHandle; override;
class procedure SetAlignment(const ACustomStaticText: TCustomStaticText;
const NewAlignment: TAlignment); override;
class procedure GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean); override;
class function GetText(const {%H-}AWinControl: TWinControl; var {%H-}AText: String): Boolean; override;
class procedure SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
class procedure SetColor(const AWinControl: TWinControl); override;
class procedure SetFont(const AWinControl: TWinControl; const AFont: TFont); override;
class procedure SetStaticBorderStyle(const ACustomStaticText: TCustomStaticText; const NewBorderStyle: TStaticBorderStyle); override;
class procedure SetText(const AWinControl: TWinControl; const AText: String); override;
end;
{ TGtk2WSStaticText }
TGtk2WSStaticText = class(TWSStaticText)
published
end;
{$DEFINE MEMOHEADER}
{$I gtk2memostrings.inc}
{$UNDEF MEMOHEADER}
function GetComboBoxEntry(Widget: PGtkWidget): PGtkEntry;
implementation
const
StaticBorderShadowMap: array[TStaticBorderStyle] of TGtkShadowType =
(
GTK_SHADOW_NONE,
GTK_SHADOW_ETCHED_IN,
GTK_SHADOW_IN
);
function GetComboBoxEntry(Widget: PGtkWidget): PGtkEntry;
begin
if GtkWidgetIsA(Widget, GTK_TYPE_COMBO_BOX_ENTRY) then
Result := PGtkEntry(GTK_BIN(Widget)^.child)
else
Result := nil;
end;
procedure gtkDefaultPopupMenuDeactivate({%H-}Widget: PGtkWidget; {%H-}data: gPointer); cdecl;
begin
LastMouse.Button := 0;
LastMouse.ClickCount := 0;
LastMouse.Down := False;
LastMouse.MousePos := Point(0, 0);
LastMouse.Time := 0;
LastMouse.WinControl := nil;
end;
function gtkDefaultPopupMenuCloseFix({%H-}Widget: PGtkWidget; Menu: PGtkMenu;
{%H-}data: gPointer): gboolean; cdecl;
begin
Result:=CallBackDefaultReturn;
// needed because closing popup menu without clicking on any menu item
// freezes various controls, eg SpeedButton
g_signal_connect(PGtkObject(Menu), 'deactivate',
gtk_signal_func(@gtkDefaultPopupMenuDeactivate), nil);
end;
{$I gtk2memostrings.inc}
{ TGtk2WSCustomListBox }
procedure StoreFirstSelectedPath({%H-}model:PGtkTreeModel; path:PGtkTreePath;
{%H-}iter:PGtkTreeIter; data:gpointer); cdecl;
begin
//DebugLn(['StoreFirstSelectedPath ',PInteger(Data)^,' ',gtk_tree_path_get_indices(Path)^]);
if PInteger(Data)^ < 0 then
PInteger(Data)^ := gtk_tree_path_get_indices(Path)^;
end;
class function TGtk2WSCustomListBox.GetItemIndex(
const ACustomListBox: TCustomListBox): integer;
var
Widget: PGtkWidget;
Path: PGtkTreePath;
Column: PGtkTreeViewColumn;
Selection: PGtkTreeSelection;
begin
Result := -1;
if not WSCheckHandleAllocated(ACustomListBox, 'GetItemIndex') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
if GtkWidgetIsA(Widget, gtk_tree_view_get_type) then
begin
Path:=nil;
Column:=nil;
gtk_tree_view_get_cursor(PGtkTreeView(Widget), Path, column);
if Path <> nil then
begin
Result := gtk_tree_path_get_indices(Path)^;
if Result = 0 then
begin
Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget));
if not gtk_tree_selection_path_is_selected(Selection, Path) then
Result := -1;
end;
gtk_tree_path_free(Path);
end else
Result := -1;
end;
end;
class function TGtk2WSCustomListBox.GetItemRect(
const ACustomListBox: TCustomListBox; Index: integer; var ARect: TRect
): boolean;
var
Widget: PGtkWidget;
Column: PGtkTreeViewColumn;
Path: PGtkTreePath;
AGdkRect: TGdkRectangle;
begin
Result := False;
FillChar(ARect, SizeOf(ARect), 0);
if not WSCheckHandleAllocated(ACustomListBox, 'GetItemIndex') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
if GtkWidgetIsA(Widget, gtk_tree_view_get_type) and (Index >= 0) then
begin
Path := gtk_tree_path_new_from_indices(Index, -1);
Column := gtk_tree_view_get_column(PGtkTreeView(Widget), 0);
FillChar(AGdkRect{%H-}, SizeOf(AGdkRect), 0);
gtk_tree_view_get_cell_area(PGtkTreeView(Widget), Path, Column, @AGdkRect);
ARect := Rect(AGdkRect.x, AGdkRect.y, AGdkRect.x + AGdkRect.width, AGdkRect.y + AGdkRect.height);
gtk_tree_path_free(Path);
Result := True;
end;
end;
class function TGtk2WSCustomListBox.GetScrollWidth(const ACustomListBox: TCustomListBox): Integer;
var
Adjustment: PGtkAdjustment;
begin
Adjustment := gtk_scrolled_window_get_hadjustment({%H-}PGtkScrolledWindow(ACustomListBox.Handle));
Result := Trunc(Adjustment^.upper);
end;
class function TGtk2WSCustomListBox.GetTopIndex(const ACustomListBox: TCustomListBox): integer;
begin
Result := GetIndexAtXY(ACustomListBox, 0, 1);
end;
class procedure TGtk2WSCustomListBox.SelectItem(
const ACustomListBox: TCustomListBox; AnIndex: integer; ASelected: boolean);
var
Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary)
Selection: PGtkTreeSelection;
ListStoreModel: PGtkTreeModel;
Iter : TGtkTreeIter;
begin
if not WSCheckHandleAllocated(ACustomListBox, 'SelectItem') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
ListStoreModel := gtk_tree_view_get_model(PGtkTreeView(Widget));
Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget));
if gtk_tree_model_iter_nth_child(ListStoreModel, @Iter, nil, AnIndex) then
begin
if gtk_tree_view_get_model(PGtkTreeView(Widget)) = nil then
Exit; // we are in the midst of a begin update end update pair and the following will fail and cause gtk debug messages
case ASelected of
True:
if not gtk_tree_selection_iter_is_selected(Selection, @Iter) then
gtk_tree_selection_select_iter(Selection, @Iter);
False:
if gtk_tree_selection_iter_is_selected(Selection, @Iter) then
gtk_tree_selection_unselect_iter(Selection, @Iter);
end;
end;
end;
class procedure TGtk2WSCustomListBox.SetBorder(
const ACustomListBox: TCustomListBox);
begin
gtk_scrolled_window_set_shadow_type({%H-}PGtkScrolledWindow(ACustomListBox.Handle),
BorderStyleShadowMap[ACustomListBox.BorderStyle]);
end;
class procedure TGtk2WSCustomListBox.SetColor(const AWinControl: TWinControl);
var
AWidget: PGTKWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
Exit;
AWidget := {%H-}PGtkWidget(AWinControl.Handle);
AWidget := GetOrCreateWidgetInfo(AWidget)^.CoreWidget;
Gtk2WidgetSet.SetWidgetColor(AWidget,
AWinControl.Font.Color,
AWinControl.Color,
[GTK_STATE_NORMAL, GTK_STATE_ACTIVE, GTK_STATE_PRELIGHT, GTK_STYLE_BASE]);
end;
class procedure TGtk2WSCustomListBox.SetItemIndex(
const ACustomListBox: TCustomListBox; const AIndex: integer);
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Selection: PGtkTreeSelection;
Path: PGtkTreePath;
begin
if not WSCheckHandleAllocated(ACustomListBox, 'SetItemIndex') then
Exit;
WidgetInfo := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle));
Widget := WidgetInfo^.CoreWidget;
if not GtkWidgetIsA(Widget, gtk_tree_view_get_type) then
raise Exception.Create('');
Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget));
Inc(WidgetInfo^.ChangeLock);
if (AIndex < 0) then
Path := nil
else
Path := gtk_tree_path_new_from_indices(AIndex, -1);
// if singleselection mode then selection = itemindex
if Path <> nil then
begin
if PGtkTreeView(Widget)^.priv^.tree <> nil then
gtk_tree_view_set_cursor(PGtkTreeView(Widget), Path, nil, False);
end
else
begin
Path := gtk_tree_path_new_from_indices(0, -1);
if PGtkTreeView(Widget)^.priv^.tree <> nil then
gtk_tree_view_set_cursor(PGtkTreeView(Widget), Path, nil, False);
gtk_tree_selection_unselect_all(Selection);
end;
if Path <> nil then
gtk_tree_path_free(Path);
Dec(WidgetInfo^.ChangeLock);
end;
class procedure TGtk2WSCustomListBox.SetScrollWidth(
const ACustomListBox: TCustomListBox; const AScrollWidth: Integer);
const
BoolToPolicy: array[Boolean] of TGtkPolicyType = (GTK_POLICY_NEVER, GTK_POLICY_ALWAYS);
var
Adjustment: PGtkAdjustment;
ScrolledWindow: PGtkScrolledWindow;
begin
ScrolledWindow := {%H-}PGtkScrolledWindow(ACustomListBox.Handle);
gtk_scrolled_window_set_policy(ScrolledWindow, BoolToPolicy[AScrollWidth > PgtkWidget(ScrolledWindow)^.allocation.width], GTK_POLICY_AUTOMATIC);
Adjustment := gtk_scrolled_window_get_hadjustment(ScrolledWindow);
Adjustment^.upper := AScrollWidth;
gtk_adjustment_changed(Adjustment);
end;
class procedure TGtk2WSCustomListBox.SetSelectionMode(
const ACustomListBox: TCustomListBox; const AExtendedSelect,
AMultiSelect: boolean);
var
Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary)
Selection: PGtkTreeSelection;
begin
if not WSCheckHandleAllocated(ACustomListBox, 'SetSelectionMode') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget));
case AMultiSelect of
True : gtk_tree_selection_set_mode(Selection, GTK_SELECTION_MULTIPLE);
False: gtk_tree_selection_set_mode(Selection, GTK_SELECTION_SINGLE);
//GTK_SELECTION_NONE,
//GTK_SELECTION_SINGLE,
//GTK_SELECTION_BROWSE,
//GTK_SELECTION_MULTIPLE
end;
end;
class procedure TGtk2WSCustomListBox.SetStyle(
const ACustomListBox: TCustomListBox);
var
AStyle: PtrInt;
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(ACustomListBox, 'SetStyle') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
AStyle := {%H-}PtrInt(g_object_get_data(PGObject(Widget), 'lclcustomlistboxstyle'));
if (AStyle <> Ord(ACustomListBox.Style)) then
RecreateWnd(ACustomListBox);
end;
class procedure TGtk2WSCustomListBox.SetSorted(const ACustomListBox: TCustomListBox;
AList: TStrings; ASorted: boolean);
begin
if AList is TGtkListStoreStringList then
TGtkListStoreStringList(AList).Sorted := ASorted
//else if AList is TGtkCListStringList then
// TGtkCListStringList(AList).Sorted := ASorted
else
raise Exception.Create('');
end;
class procedure TGtk2WSCustomListBox.SetTopIndex(
const ACustomListBox: TCustomListBox; const NewTopIndex: integer);
var
Widget: PGtkWidget;
ListStoreModel: PGtkTreeModel;
Iter: TGtkTreeIter;
TreeView: PGtkTreeView;
APath: Pointer;
begin
if not WSCheckHandleAllocated(ACustomListBox, 'SetTopIndex') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
TreeView := PGtkTreeView(Widget);
ListStoreModel := gtk_tree_view_get_model(TreeView);
if not gtk_tree_model_iter_nth_child(ListStoreModel, @Iter, nil, NewTopIndex)
then exit;
APath := gtk_tree_model_get_path(ListStoreModel, @Iter);
gtk_tree_view_scroll_to_cell(TreeView, APath, NULL, true, 0.0, 0.0);
gtk_tree_path_free(APath);
end;
class procedure TGtk2WSCustomListBox.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetFont') then
Exit;
Widget := GetWidgetInfo({%H-}Pointer(AWinControl.Handle))^.CoreWidget;
Gtk2WidgetSet.SetWidgetColor(Widget, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED,
GTK_STYLE_TEXT]);
Gtk2WidgetSet.SetWidgetFont(Widget, AFont);
end;
class procedure TGtk2WSCustomListBox.ShowHide(const AWinControl: TWinControl);
begin
// issue #27276
if AWinControl.HandleAllocated and AWinControl.HandleObjectShouldBeVisible and
(TCustomListBox(AWinControl).ItemIndex = -1) then
SetItemIndex(TCustomListBox(AWinControl), TCustomListBox(AWinControl).ItemIndex);
// issue #28341
if AWinControl.HandleObjectShouldBeVisible then
SetFont(AWinControl, AWinControl.Font);
Gtk2WidgetSet.SetVisible(AWinControl, AWinControl.HandleObjectShouldBeVisible);
InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
end;
function gtk2ListBoxSelectionChangedAfter({%H-}Widget: PGtkWidget;
WidgetInfo: PWidgetInfo): gboolean; cdecl;
var
Mess: TLMessage;
begin
Result := CallBackDefaultReturn;
if WidgetInfo^.ChangeLock > 0 then
Exit;
{$IFDEF EventTrace}
EventTrace('gtk2ListSelectionChangedAfter', WidgetInfo^.LCLObject);
{$ENDIF}
FillChar(Mess{%H-},SizeOf(Mess),0);
Mess.msg := LM_SelChange;
DeliverMessage(WidgetInfo^.LCLObject, Mess);
end;
class function TGtk2WSCustomListBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
TVWidget: PGtkWidget;
p: PGtkWidget; // ptr to the newly created GtkWidget
liststore : PGtkListStore;
Selection: PGtkTreeSelection;
renderer : PGtkCellRenderer;
column : PGtkTreeViewColumn;
WidgetInfo: PWidgetInfo;
begin
Result := TGtk2WSBaseScrollingWinControl.CreateHandle(AWinControl, AParams);
p := {%H-}PGtkWidget(Result);
if Result = 0 then exit;
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(p,dbgsName(AWinControl));
{$ENDIF}
GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(p)^.hscrollbar, GTK_CAN_FOCUS);
GTK_WIDGET_UNSET_FLAGS(PGtkScrolledWindow(p)^.vscrollbar, GTK_CAN_FOCUS);
// by default horz scrollbar is invisible. it is set by SetScrollWidth
gtk_scrolled_window_set_policy(PGtkScrolledWindow(p),
GTK_POLICY_NEVER, GTK_POLICY_AUTOMATIC);
//Set BorderStyle according to the provided Params
if (AParams.ExStyle and WS_EX_CLIENTEDGE) > 0 then
gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(p), GTK_SHADOW_ETCHED_IN)
else
gtk_scrolled_window_set_shadow_type(PGtkScrolledWindow(p), GTK_SHADOW_NONE);
gtk_widget_show(p);
liststore := gtk_list_store_new (2, [G_TYPE_STRING, G_TYPE_POINTER, nil]);
TVWidget:= gtk_tree_view_new_with_model (GTK_TREE_MODEL (liststore));
g_object_unref (G_OBJECT (liststore));
renderer := LCLIntfCellRenderer_New();
column := gtk_tree_view_column_new_with_attributes ('LISTITEMS', renderer,
['text', 0, nil]);
gtk_cell_layout_set_cell_data_func(PGtkCellLayout(column), renderer,
@LCLIntfCellRenderer_CellDataFunc, nil, nil);
gtk_tree_view_append_column (GTK_TREE_VIEW (TVWidget), column);
gtk_tree_view_column_set_clickable (GTK_TREE_VIEW_COLUMN (column), TRUE);
gtk_tree_view_set_headers_visible(GTK_TREE_VIEW (TVWidget), False);
gtk_container_add(GTK_CONTAINER(p), TVWidget);
gtk_widget_show(TVWidget);
SetMainWidget(p, TVWidget);
WidgetInfo := GetWidgetInfo(p);
WidgetInfo^.CoreWidget := TVWidget;
Selection := gtk_tree_view_get_selection(PGtkTreeView(TVWidget));
case TCustomListBox(AWinControl).MultiSelect of
True : gtk_tree_selection_set_mode(Selection, GTK_SELECTION_MULTIPLE);
False: gtk_tree_selection_set_mode(Selection, GTK_SELECTION_SINGLE);
end;
if TListBox(AWinControl).Style = lbOwnerDrawFixed then
begin
gtk_tree_view_column_set_sizing(column, GTK_TREE_VIEW_COLUMN_FIXED);
gtk_tree_view_set_fixed_height_mode(PGtkTreeView(TVWidget), True);
end;
g_signal_connect_after(Selection, 'changed',
G_CALLBACK(@gtk2ListBoxSelectionChangedAfter), WidgetInfo);
g_object_set_data(PGObject(TVWidget), 'lclcustomlistboxstyle', {%H-}gPointer(Ord(TListBox(AWinControl).Style)));
// Sets the callbacks
if not AWinControl.HandleObjectShouldBeVisible and not (csDesigning in AWinControl.ComponentState) then
gtk_widget_hide(p);
SetCallbacks(p, WidgetInfo);
end;
class procedure TGtk2WSCustomListBox.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
end;
class function TGtk2WSCustomListBox.GetIndexAtXY(
const ACustomListBox: TCustomListBox; X, Y: integer): integer;
var
aTreeView: PGtkTreeView;
aTreeColumn: PGtkTreeViewColumn;
aTreePath: PGtkTreePath;
begin
Result := -1;
if not WSCheckHandleAllocated(ACustomListBox, 'GetIndexAtXY') then
Exit;
case ACustomListBox.fCompStyle of
csListBox, csCheckListBox:
begin
aTreeView:=GTK_TREE_VIEW(GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget);
aTreePath:=nil;
aTreeColumn:=nil;
if gtk_tree_view_get_path_at_pos(aTreeView, 0, Y, aTreePath, aTreeColumn, nil, nil)
then begin
Result := gtk_tree_path_get_indices(aTreePath)[0];
gtk_tree_path_free(aTreePath);
exit;
end;
end;
end;
end;
class function TGtk2WSCustomListBox.GetSelCount(const ACustomListBox: TCustomListBox): integer;
var
Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary)
Selection: PGtkTreeSelection;
ListStoreModel: PGtkTreeModel;
Rows: PGList;
begin
Result := 0;
if not WSCheckHandleAllocated(ACustomListBox, 'GetSelCount') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget));
Rows := gtk_tree_selection_get_selected_rows(Selection, @ListStoreModel);
Result := g_list_length(Rows);
g_list_free(Rows);
end;
class function TGtk2WSCustomListBox.GetSelected(
const ACustomListBox: TCustomListBox; const AIndex: integer): boolean;
var
Widget: PGtkWidget; // pointer to gtk-widget (local use when neccessary)
Selection: PGtkTreeSelection;
ListStoreModel: PGtkTreeModel;
Item : TGtkTreeIter;
begin
Result := False; { assume: nothing found }
if not WSCheckHandleAllocated(ACustomListBox, 'GetSelected') then
Exit;
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
ListStoreModel := gtk_tree_view_get_model(PGtkTreeView(Widget));
Selection := gtk_tree_view_get_selection(PGtkTreeView(Widget));
if gtk_tree_view_get_model(PGtkTreeView(Widget)) = nil then
Exit;
if gtk_tree_model_iter_nth_child(ListStoreModel, @Item, nil, AIndex) then
Result := gtk_tree_selection_iter_is_selected(Selection, @Item);
end;
class function TGtk2WSCustomListBox.GetStrings(
const ACustomListBox: TCustomListBox): TStrings;
var
Widget: PGtkWidget;// pointer to gtk-widget
begin
Result:=nil;
if not WSCheckHandleAllocated(ACustomListBox, 'GetStrings') then
Exit;
case ACustomListBox.fCompStyle of
{csCListBox:
begin
Widget:= GetOrCreateWidgetInfo(Pointer(Handle))^.CoreWidget;
Result := TGtkCListStringList.Create(PGtkCList(Widget));
if ACustomListBox is TCustomListBox then
TGtkCListStringList(Result).Sorted :=
TCustomListBox(ACustomListBox).Sorted;
end;
}
csCheckListBox, csListBox:
begin
Widget := GetOrCreateWidgetInfo({%H-}Pointer(ACustomListBox.Handle))^.CoreWidget;
Result := TGtkListStoreStringList.Create(
gtk_tree_view_get_model(PGtkTreeView(Widget)),
Ord(ACustomListBox.fCompStyle = csCheckListBox),
ACustomListBox);
TGtkListStoreStringList(Result).Sorted := ACustomListBox.Sorted;
end;
else
raise Exception.Create('TGtk2WSCustomListBox.GetStrings');
end;
end;
{ TGtk2WSCustomCheckBox }
class procedure TGtk2WSCustomCheckBox.SetCallbacks(const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
TGtk2Widgetset(WidgetSet).SetCallback(LM_CHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
end;
class function TGtk2WSCustomCheckBox.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams
): TLCLIntfHandle;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
begin
{ ToDo verify if the check box has correct z-order and disable GTK_WIDGET_NO_WINDOW if not.}
Widget := gtk_check_button_new_with_label(AParams.Caption);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
Result := THandle({%H-}PtrUInt(Widget));
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate({%H-}PGtkWidget(Result), @Allocation);
if AParams.Style and WS_VISIBLE = 0 then
gtk_widget_hide({%H-}PGtkWidget(Result))
else
gtk_widget_show({%H-}PGtkWidget(Result));
Set_RC_Name(AWinControl, {%H-}PGtkWidget(Result));
SetCallbacks({%H-}PGtkWidget(Result), WidgetInfo);
end;
class procedure TGtk2WSCustomCheckBox.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
GetGTKDefaultWidgetSize(AWinControl,PreferredWidth,PreferredHeight,
WithThemeSpace);
end;
class function TGtk2WSCustomCheckBox.RetrieveState(
const ACustomCheckBox: TCustomCheckBox): TCheckBoxState;
var
ToggleButton: PGtkToggleButton;
begin
ToggleButton:={%H-}PGtkToggleButton(ACustomCheckBox.Handle);
if gtk_toggle_button_get_inconsistent(ToggleButton) then
Result := cbGrayed
else
if gtk_toggle_button_get_active(ToggleButton) then
Result := cbChecked
else
Result := cbUnchecked;
end;
class procedure TGtk2WSCustomCheckBox.SetShortCut(const ACustomCheckBox: TCustomCheckBox;
const ShortCutK1, ShortCutK2: TShortCut);
begin
Accelerate(ACustomCheckBox, {%H-}PGtkWidget(ACustomCheckBox.Handle), ShortcutK1,
'clicked'
//'activate_item'
);
end;
class procedure TGtk2WSCustomCheckBox.SetState(
const ACustomCheckBox: TCustomCheckBox; const NewState: TCheckBoxState);
var
GtkObject: PGtkObject;
ToggleButton: PGtkToggleButton;
begin
//debugln('TGtk2WSCustomCheckBox.SetState A ',DbgSName(ACustomCheckBox),' State=',dbgs(ord(ACustomCheckBox.State)));
GtkObject := {%H-}PGtkObject(ACustomCheckBox.Handle);
LockOnChange(GtkObject,1);
ToggleButton:=PGtkToggleButton(GtkObject);
gtk_toggle_button_set_inconsistent(ToggleButton, NewState=cbGrayed);
gtk_toggle_button_set_active(ToggleButton, NewState=cbChecked);
LockOnChange(GtkObject,-1);
end;
class procedure TGtk2WSCustomCheckBox.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
Widget: PGTKWidget;
LblWidget: PGtkWidget;
begin
if not AWinControl.HandleAllocated then exit;
Widget := {%H-}PGtkWidget(AWinControl.Handle);
LblWidget := (pGtkBin(Widget)^.Child);
if LblWidget <> nil then
begin
Gtk2WidgetSet.SetWidgetFont(LblWidget, AFont);
Gtk2WidgetSet.SetWidgetColor(LblWidget, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
end;
end;
class procedure TGtk2WSCustomCheckBox.SetText(const AWinControl: TWinControl;
const AText: String);
var
BoxWidget: PGtkWidget;
B: Boolean;
P: PGChar;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText') then Exit;
BoxWidget := {%H-}PGtkWidget(AWinControl.Handle);
if AText = '' then
begin
gtk_button_set_label(PGtkButton(BoxWidget), '');
gtk_widget_hide(PGtkBin(BoxWidget)^.child);
end else
begin
P := gtk_label_get_text(PGtkLabel(PGtkBin(BoxWidget)^.child));
B := (StrPas(P) <> AText);
gtk_widget_show(PGtkBin(BoxWidget)^.child);
gtk_button_set_label(PGtkButton(BoxWidget), PChar(Ampersands2Underscore(EscapeUnderscores(AText))));
gtk_button_set_use_underline(PGtkButton(BoxWidget), True);
if B then
begin
SetColor(AWinControl);
SetFont(AWinControl, AWinControl.Font);
end;
end;
end;
class procedure TGtk2WSCustomCheckBox.ShowHide(const AWinControl: TWinControl);
begin
// gtk2 doesn't set font properly
// so we are doing it one more time before showing. Issues #21172, #23152
if AWinControl.HandleObjectShouldBeVisible then
begin
SetFont(AWinControl, AWinControl.Font);
AWinControl.InvalidatePreferredSize();
AWinControl.AdjustSize();
end;
TGtk2WSWinControl.ShowHide(AWinControl);
end;
{$I gtk2wscustommemo.inc}
{ TGtk2WSCustomEdit }
class procedure TGtk2WSCustomEdit.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
with TGtk2Widgetset(Widgetset) do
begin
SetCallback(LM_CHANGED, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_ACTIVATE, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_CUT, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_COPY, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
SetCallback(LM_PASTE, PGtkObject(AGtkWidget), AWidgetInfo^.LCLObject);
end;
g_signal_connect_after(PGtkObject(AGtkWidget), 'populate-popup',
gtk_signal_func(@gtkDefaultPopupMenuCloseFix), AWidgetInfo);
end;
class procedure TGtk2WSCustomEdit.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
begin
GetGTKDefaultWidgetSize(AWinControl,PreferredWidth,PreferredHeight,
WithThemeSpace);
//debugln('TGtkWSCustomEdit.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;
class procedure TGtk2WSCustomEdit.SetColor(const AWinControl: TWinControl);
var
AWidget: PGTKWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then Exit;
AWidget := {%H-}PGtkWidget(AWinControl.Handle);
// don't change selected state
Gtk2WidgetSet.SetWidgetColor(AWidget, clNone, AWinControl.Color,
[GTK_STATE_NORMAL, GTK_STYLE_BASE]);
end;
class procedure TGtk2WSCustomEdit.SetText(const AWinControl: TWinControl;
const AText: string);
var
Widget: PGtkWidget;
Mess : TLMessage;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetText') then
Exit;
if TCustomEdit(AWinControl).NumbersOnly and not IsNumber(AText) then
Exit;
{$IFDEF VerboseTWinControlRealText}
DebugLn(['TGtkWSCustomEdit.SetText START ',DbgSName(AWinControl),' AText="',AText,'"']);
{$ENDIF}
Widget:={%H-}PGtkWidget(AWinControl.Handle);
// some gtk2 versions fire the change event twice
// lock the event and send the message afterwards
// see bug http://bugs.freepascal.org/view.php?id=14615
LockOnChange(PgtkObject(Widget), +1);
try
if GTK_IS_SPIN_BUTTON(Widget) then
gtk_entry_set_text(@PGtkSpinButton(Widget)^.entry, PChar(AText))
else
gtk_entry_set_text(PGtkEntry(Widget), PChar(AText));
finally
LockOnChange(PgtkObject(Widget), -1);
end;
SetSelStart(TCustomEdit(AWinControl), 0);
{$IFDEF VerboseTWinControlRealText}
DebugLn(['TGtkWSCustomEdit.SetText SEND TEXTCHANGED message ',DbgSName(AWinControl),' New="',gtk_entry_get_text(PGtkEntry(AWinControl.Handle)),'"']);
{$ENDIF}
FillByte(Mess{%H-},SizeOf(Mess),0);
Mess.Msg := CM_TEXTCHANGED;
DeliverMessage(AWinControl, Mess);
{$IFDEF VerboseTWinControlRealText}
DebugLn(['TGtkWSCustomEdit.SetText END ',DbgSName(AWinControl),' New="',gtk_entry_get_text(PGtkEntry(AWinControl.Handle)),'"']);
{$ENDIF}
end;
class procedure TGtk2WSCustomEdit.SetSelText(const ACustomEdit: TCustomEdit;
const NewSelText: string);
var
Widget: PGtkWidget;
Entry: PGtkEntry;
Text: string;
SelStart: Integer;
Mess : TLMessage;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'SetSelText') then
Exit;
if ACustomEdit.NumbersOnly and not IsNumber(NewSelText) then
Exit;
Widget:={%H-}PGtkWidget(ACustomEdit.Handle);
if GTK_IS_SPIN_BUTTON(Widget) then
Entry := @PGtkSpinButton(Widget)^.entry
else
Entry := PGtkEntry(Widget);
Text := gtk_entry_get_text(Entry);
SelStart := GetSelStart(ACustomEdit);
Text := UTF8Copy(Text, 1, SelStart) + NewSelText +
UTF8Copy(Text, SelStart + GetSelLength(ACustomEdit) + 1, MaxInt);
SelStart := SelStart + UTF8Length(NewSelText);
// some gtk2 versions fire the change event twice
// lock the event and send the message afterwards
// see bug http://bugs.freepascal.org/view.php?id=14615
LockOnChange(PgtkObject(Widget), +1);
try
gtk_entry_set_text(Entry, PChar(Text));
finally
LockOnChange(PgtkObject(Widget), -1);
end;
SetSelStart(ACustomEdit, SelStart);
FillByte(Mess{%H-},SizeOf(Mess),0);
Mess.Msg := CM_TEXTCHANGED;
DeliverMessage(ACustomEdit, Mess);
end;
class procedure TGtk2WSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit;
NewCase: TEditCharCase);
begin
// TODO: TGtk2WSCustomEdit.SetCharCase: implement me!
end;
class procedure TGtk2WSCustomEdit.SetMaxLength(const ACustomEdit: TCustomEdit;
NewLength: integer);
var
Widget: PGtkWidget;
begin
Widget:={%H-}PGtkWidget(ACustomEdit.Handle);
if GtkWidgetIsA(Widget, GTK_TYPE_ENTRY) then
gtk_entry_set_max_length(GTK_ENTRY(Widget), guint16(NewLength));
end;
function CellEntryKeyDown({%H-}Widget: PGtkWidget; Event : pgdkeventkey;
{%H-}Data: gPointer) : GBoolean; cdecl;
begin
Result := (Event^.keyval = GDK_KEY_UP) or (Event^.keyval = GDK_KEY_DOWN);
end;
class function TGtk2WSCustomEdit.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Widget: PGtkWidget; // ptr to the newly created GtkWidget
WidgetInfo: PWidgetInfo;
CellEditable: PGtkCellEditable;
begin
Widget := gtk_entry_new();
gtk_editable_set_editable(PGtkEditable(Widget), not TCustomEdit(AWinControl).ReadOnly);
if AParams.Style and WS_VISIBLE = 0 then
gtk_widget_hide(Widget)
else
gtk_widget_show(Widget);
Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
if Result = 0 then
Exit;
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
Set_RC_Name(AWinControl, Widget);
SetCallbacks(Widget, WidgetInfo);
if Result <> 0 then
begin
// hook into GtkEntry interface, so it won't focus another control
// by pressing VK_UP or VK_DOWN. issue #11115
CellEditable := GTK_CELL_EDITABLE(Widget);
g_signal_connect(CellEditable, 'key_press_event',
TGTKSignalFunc(@CellEntryKeyDown), AWinControl);
gtk_entry_set_has_frame({%H-}PGtkEntry(Result),
TCustomEdit(AWinControl).BorderStyle <> bsNone);
// don't select it on focus since LCL do this itself
g_object_set(gtk_widget_get_settings({%H-}PGtkWidget(Result)),
'gtk-entry-select-on-focus', [0, nil]);
end;
end;
class function TGtk2WSCustomEdit.GetCaretPos(const ACustomEdit: TCustomEdit
): TPoint;
var
Entry: PGtkEntry;
AInfo: PWidgetInfo;
begin
Result := Point(0,0);
if not WSCheckHandleAllocated(ACustomEdit, 'GetCaretPos') then
Exit;
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
if gtk_widget_has_focus(PGtkWidget(Entry)) then
Result.X := Max(Entry^.current_pos, Entry^.selection_bound)
else begin
AInfo := GetWidgetInfo(PGtkWidget(Entry));
if AInfo <> nil then
Result.X := AInfo^.CursorPos + AInfo^.SelLength;
end;
end;
class function TGtk2WSCustomEdit.GetSelStart(const ACustomEdit: TCustomEdit
): integer;
var
Entry: PGtkEntry;
AInfo: PWidgetInfo;
begin
Result := 0;
if not WSCheckHandleAllocated(ACustomEdit, 'GetSelStart') then
Exit;
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
if gtk_widget_has_focus(PGtkWidget(Entry)) then
Result := Min(Entry^.current_pos, Entry^.selection_bound)
else begin
AInfo := GetWidgetInfo(PGtkWidget(Entry));
if AInfo <> nil then
Result := AInfo^.CursorPos;
end;
end;
class function TGtk2WSCustomEdit.GetSelLength(const ACustomEdit: TCustomEdit
): integer;
var
Entry: PGtkEntry;
AInfo: PWidgetInfo;
begin
Result := 0;
if not WSCheckHandleAllocated(ACustomEdit, 'GetSelLength') then
Exit;
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
if gtk_widget_has_focus(PGtkWidget(Entry)) then
Result := ABS(Entry^.current_pos - Entry^.selection_bound)
else begin
AInfo := GetWidgetInfo(PGtkWidget(Entry));
if AInfo <> nil then
Result := AInfo^.SelLength;
end;
end;
class procedure TGtk2WSCustomEdit.SetCaretPos(const ACustomEdit: TCustomEdit;
const NewPos: TPoint);
var
NewStart: Integer;
Entry: PGtkEntry;
WidgetInfo: PWidgetInfo;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'SetCaretPos') then
Exit;
SetSelLength(ACustomEdit, 0);
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
// make gtk2 consistent with others. issue #11802
// if GetCaretPos(ACustomEdit).X = NewPos.X then exit;
if Entry^.text_max_length > 0 then
NewStart := Min(NewPos.X, Entry^.text_max_length)
else
NewStart := Min(NewPos.X, Entry^.text_length);
WidgetInfo := GetWidgetInfo(Entry);
WidgetInfo^.CursorPos := NewStart;
gtk_editable_set_position(PGtkEditable(Entry), NewStart);
end;
class procedure TGtk2WSCustomEdit.SetEchoMode(const ACustomEdit: TCustomEdit;
NewMode: TEchoMode);
var
Entry: PGtkEntry;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'SetEchoMode') then
Exit;
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
if NewMode in [emNone,emPassword] then begin
gtk_entry_set_visibility(Entry,false);
SetPasswordChar(ACustomEdit,ACustomEdit.PasswordChar);
end else begin
gtk_entry_set_visibility(Entry,true);
end;
end;
class procedure TGtk2WSCustomEdit.SetPasswordChar(
const ACustomEdit: TCustomEdit; NewChar: char);
var
PWChar: Integer;
Entry: PGtkEntry;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'SetPasswordChar') then
Exit;
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
if ACustomEdit.EchoMode=emNone then
PWChar:=0
else begin
PWChar:=ord(ACustomEdit.PasswordChar);
if (PWChar<192) or (PWChar=ord('*')) then
PWChar:=9679;
end;
gtk_entry_set_invisible_char(Entry,PWChar);
end;
class procedure TGtk2WSCustomEdit.SetReadOnly(const ACustomEdit: TCustomEdit;
NewReadOnly: boolean);
var
Widget: PGtkWidget;
begin
Widget := {%H-}PGtkWidget(ACustomEdit.Handle);
if GTK_IS_EDITABLE(Widget) then
gtk_editable_set_editable(PGtkEditable(Widget), not NewReadOnly);
end;
class procedure TGtk2WSCustomEdit.SetSelStart(const ACustomEdit: TCustomEdit;
NewStart: integer);
var
NewPos: Integer;
Entry: PGtkEntry;
WidgetInfo: PWidgetInfo;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'SetSelStart') then
Exit;
SetSelLength(ACustomEdit, 0);
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
// make gtk2 consistent with others. issue #11802
// if GetSelStart(ACustomEdit) = NewStart then exit;
if Entry^.text_max_length > 0 then
NewPos := Min(NewStart, Entry^.text_max_length)
else
NewPos := Min(NewStart, Entry^.text_length);
WidgetInfo := GetWidgetInfo(Entry);
WidgetInfo^.CursorPos := NewPos;
gtk_editable_set_position(PGtkEditable(Entry), NewPos);
end;
class procedure TGtk2WSCustomEdit.SetSelLength(
const ACustomEdit: TCustomEdit; NewLength: integer);
var
Entry: PGtkEntry;
SelStart: Integer;
WidgetInfo: PWidgetInfo;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'SetSelLength') then
Exit;
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
SelStart := GetSelStart(ACustomEdit);
WidgetInfo := GetWidgetInfo(Entry);
if WidgetInfo^.CursorPos = 0 then
WidgetInfo^.CursorPos := SelStart;
WidgetInfo^.SelLength := NewLength;
gtk_entry_select_region(Entry,
SelStart + NewLength,
SelStart );
end;
class procedure TGtk2WSCustomEdit.SetAlignment(const ACustomEdit: TCustomEdit;
const AAlignment: TAlignment);
var
Entry: PGtkEntry;
Alignment: GFloat;
begin
Entry := {%H-}PGtkEntry(ACustomEdit.Handle);
case AAlignment of
taLeftJustify: Alignment := 0;
taRightJustify: Alignment := 1;
taCenter: Alignment := 0.5;
end;
gtk_entry_set_alignment(Entry, Alignment);
end;
class procedure TGtk2WSCustomEdit.Cut(const ACustomEdit: TCustomEdit);
var
ATextView: PGtkTextView;
ABuffer: PGtkTextBuffer;
AStart, AStop: PGtkTextIter;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'Cut') then
Exit;
if ACustomEdit.FCompStyle = csMemo then
begin
ATextView := GTK_TEXT_VIEW(GetWidgetInfo({%H-}PGtkWidget(ACustomEdit.Handle))^.CoreWidget);
ABuffer := gtk_text_view_get_buffer(ATextView);
if ABuffer <> nil then
begin
AStart := nil;
AStop := nil;
if gtk_text_buffer_get_selection_bounds(ABuffer, AStart, AStop) then
gtk_text_buffer_cut_clipboard(ABuffer, gtk_clipboard_get(GDK_SELECTION_CLIPBOARD), not ACustomEdit.ReadOnly);
end;
end else
gtk_editable_cut_clipboard({%H-}PGtkEditable(ACustomEdit.Handle));
end;
class procedure TGtk2WSCustomEdit.Copy(const ACustomEdit: TCustomEdit);
var
ATextView: PGtkTextView;
ABuffer: PGtkTextBuffer;
AStart, AStop: PGtkTextIter;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'Copy') then
Exit;
if ACustomEdit.FCompStyle = csMemo then
begin
ATextView := GTK_TEXT_VIEW(GetWidgetInfo({%H-}PGtkWidget(ACustomEdit.Handle))^.CoreWidget);
ABuffer := gtk_text_view_get_buffer(ATextView);
if ABuffer <> nil then
begin
AStart := nil;
AStop := nil;
if gtk_text_buffer_get_selection_bounds(ABuffer, AStart, AStop) then
gtk_text_buffer_copy_clipboard(ABuffer, gtk_clipboard_get(GDK_SELECTION_CLIPBOARD));
end;
end else
gtk_editable_copy_clipboard({%H-}PGtkEditable(ACustomEdit.Handle));
end;
class procedure TGtk2WSCustomEdit.Paste(const ACustomEdit: TCustomEdit);
var
ATextView: PGtkTextView;
ABuffer: PGtkTextBuffer;
begin
if not WSCheckHandleAllocated(ACustomEdit, 'Paste') then
Exit;
if ACustomEdit.FCompStyle = csMemo then
begin
ATextView := GTK_TEXT_VIEW(GetWidgetInfo({%H-}PGtkWidget(ACustomEdit.Handle))^.CoreWidget);
ABuffer := gtk_text_view_get_buffer(ATextView);
if ABuffer <> nil then
gtk_text_buffer_paste_clipboard(ABuffer,
gtk_clipboard_get(GDK_SELECTION_CLIPBOARD), nil, not ACustomEdit.ReadOnly);
end else
gtk_editable_paste_clipboard({%H-}PGtkEditable(ACustomEdit.Handle));
end;
class procedure TGtk2WSCustomEdit.Undo(const ACustomEdit: TCustomEdit);
begin
if not WSCheckHandleAllocated(ACustomEdit, 'Undo') then
Exit;
//TODO: I cannot find anything usefull in gtk2 to do this, seem
//that we have to make our own implementation.
end;
class procedure TGtk2WSCustomComboBox.ReCreateCombo(
const ACustomComboBox: TCustomComboBox; const AWithEntry: Boolean;
const AWidgetInfo: PWidgetInfo);
var
ComboWidget: PGtkWidget;
Model: PGtkTreeModel;
Index: Integer;
Box: PGtkWidget;
ItemList: TGtkListStoreStringList;
LCLIndex: PLongint;
begin
Box:={%H-}PGtkWidget(ACustomComboBox.Handle);
ComboWidget := AWidgetInfo^.CoreWidget;
// keep the model (increase ref count)
Model := gtk_combo_box_get_model(PGtkComboBox(ComboWidget));
g_object_ref(G_OBJECT(Model));
// keep items
ItemList := ACustomComboBox.Items as TGtkListStoreStringList;
LCLIndex := AWidgetInfo^.UserData;
if not Assigned(LCLIndex) then begin
//debugln('Gtk2WSCustomComboBox ReCreateCombo: LCLIndex unassigned!');
LCLIndex := New(PLongint);
LCLIndex^ := -1;
AWidgetInfo^.UserData := LCLIndex;
AWidgetInfo^.DataOwner := True;
end;
Index := GetItemIndex(ACustomComboBox);
if PGtkComboBoxPrivate(PGtkComboBox(ComboWidget)^.priv)^.button <> nil then
FreeWidgetInfo(PGtkComboBoxPrivate(PGtkComboBox(ComboWidget)^.priv)^.button);
gtk_event_box_set_above_child(PGtkEventBox(Box), false);
// don't remove Combo from Box, just destroy it and during destroy it will
// be removed by gtk code. Removing from Box and then destroyng can lead to
// double destroying since removing decrease reference and it can be the
// last reference
gtk_widget_destroy(ComboWidget);
// create the new widget with the old model
case AWithEntry of
True : ComboWidget := gtk_combo_box_entry_new_with_model(Model, 0);
False: ComboWidget := gtk_combo_box_new_with_model(Model);
end;
SetSensitivity(ACustomCombobox, ComboWidget);
// undone the above increase of the ref count
g_object_set_data(PGObject(ComboWidget),GtkListItemLCLListTag,ItemList);
g_object_unref (G_OBJECT(Model));
SetMainWidget(Box, GTK_BIN(ComboWidget)^.child);
AWidgetInfo^.CoreWidget := ComboWidget;
g_object_set_data(Pointer(ComboWidget), 'widgetinfo', AWidgetInfo);
SetItemIndex(ACustomComboBox, Index);
if AWithEntry then begin
SetMaxLength(ACustomComboBox, TComboBox(ACustomComboBox).MaxLength);
end;
SetRenderer(ACustomComboBox, ComboWidget, AWidgetInfo);
gtk_container_add(PGtkContainer(Box), ComboWidget);
gtk_widget_show_all(Box);
if ACustomComboBox.HandleObjectShouldBeVisible then
gtk_widget_show(Box)
else
gtk_widget_hide(Box);
if csDesigning in ACustomComboBox.ComponentState then
gtk_event_box_set_above_child(PGtkEventBox(Box), true);
SetCallbacks(ACustomComboBox, Box, AWidgetInfo);
end;
class procedure TGtk2WSCustomComboBox.SetRenderer(
const ACustomComboBox: TCustomComboBox; AWidget: PGtkWidget; AWidgetInfo: PWidgetInfo);
var
renderer : PGtkCellRenderer;
begin
renderer := LCLIntfCellRenderer_New();
g_object_set_data(G_OBJECT(renderer), 'widgetinfo', AWidgetInfo);
gtk_cell_layout_clear(PGtkCellLayout(AWidget));
gtk_cell_layout_pack_start(PGtkCellLayout(AWidget), renderer, True);
if not ACustomComboBox.Style.IsOwnerDrawn then
gtk_cell_layout_set_attributes(PGtkCellLayout(AWidget), renderer, ['text', 0, nil]);
gtk_cell_layout_set_cell_data_func(PGtkCellLayout(AWidget), renderer,
@LCLIntfCellRenderer_CellDataFunc, AWidgetInfo, nil);
end;
procedure GtkComboFocus({%H-}AWidget: PGtkWidget; WidgetInfo: PWidgetInfo); cdecl;
begin
LCLSendSetFocusMsg(TControl(WidgetInfo^.LCLObject));
end;
{used only for gtk2 < 2.10 }
procedure GtkPopupShowCB({%H-}AMenu: PGtkMenuShell; WidgetInfo: PWidgetInfo); cdecl;
begin
g_object_set_data(PGObject(WidgetInfo^.CoreWidget),
'popup-shown-compat',GPointer(PtrUInt(1)));
LCLSendSetFocusMsg(TControl(WidgetInfo^.LCLObject));
// let the LCL change the items on the fly:
LCLSendDropDownMsg(TControl(WidgetInfo^.LCLObject));
end;
{used only for gtk2 < 2.10 }
procedure GtkPopupHideCB({%H-}AMenu: PGtkMenuShell; WidgetInfo: PWidgetInfo); cdecl;
begin
g_object_set_data(PGObject(WidgetInfo^.CoreWidget),
'popup-shown-compat',GPointer(PtrUInt(0)));
LCLSendCloseUpMsg(TControl(WidgetInfo^.LCLObject));
end;
function GtkPopupCloseUp(WidgetInfo: Pointer): gboolean; cdecl;
begin
LCLSendCloseUpMsg(TControl(PWidgetInfo(WidgetInfo)^.LCLObject));
Result := gtk_False;// stop the timer
end;
procedure GtkNotifyCB(AObject: PGObject; pspec: PGParamSpec; WidgetInfo: PWidgetInfo); cdecl;
var
AValue: TGValue;
AMenu: PGtkWidget;
ComboBox: TCustomComboBox;
begin
if pspec^.name = 'popup-shown' then
begin
LCLSendSetFocusMsg(TControl(WidgetInfo^.LCLObject));
FillChar(AValue{%H-}, SizeOf(AValue), 0); // fill by zeros
g_value_init(@AValue, G_TYPE_BOOLEAN); // initialize for boolean
g_object_get_property(AObject, pspec^.name, @AValue); // get property value
if AValue.data[0].v_int = 0 then // if 0 = False then it is close up
gtk_timeout_add(0,@GtkPopupCloseUp, WidgetInfo)
else // in other case it is drop down
begin
ComboBox:=WidgetInfo^.LCLObject as TCustomComboBox;
ComboBox.IntfGetItems;
LCLSendDropDownMsg(ComboBox);
AMenu := PGtkComboBoxPrivate(PGtkComboBox(WidgetInfo^.CoreWidget)^.priv)^.popup_widget;
if GTK_IS_MENU(AMenu) then
gtk_menu_reposition(PGtkMenu(AMenu));
end;
end;
end;
procedure GtkChangedCB({%H-}AWidget: PGtkWidget; WidgetInfo: PWidgetInfo); cdecl;
var
LCLIndex: PLongint;
Index, GtkIndex: Integer;
begin
if WidgetInfo^.ChangeLock > 0 then Exit;
LCLSendChangedMsg(TControl(WidgetInfo^.LCLObject));
Index := -1;
LCLIndex := WidgetInfo^.UserData;
if Assigned(LCLIndex) then
Index := LCLIndex^
else
debugln('Gtk2WSCustomComboBox GtkChangedCB: LCLIndex unassigned!');
GtkIndex := gtk_combo_box_get_active(GTK_COMBO_BOX(WidgetInfo^.CoreWidget));
if Index <> GtkIndex then begin
LCLSendSelectionChangedMsg(TControl(WidgetInfo^.LCLObject));
if Assigned(LCLIndex) then
LCLIndex^ := GtkIndex;
end;
end;
{procedure GtkSelectedCB(AWidget: PGtkWidget; WidgetInfo: PWidgetInfo); cdecl;
begin
if WidgetInfo^.UserData <> nil then Exit;
LCLSendSelectionChangedMsg(TControl(WidgetInfo^.LCLObject));
end;}
class procedure TGtk2WSCustomComboBox.SetCallbacks(
const AWinControl: TWinControl; const AWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
var
AGtkObject: PGtkObject;
AEntry: PGtkObject;
AButton: PGtkObject;
APrivate: PGtkComboBoxPrivate;
AMenu: PGtkObject;
BtnPressID: guint;
HandlerID: guint;
ComboWidget: PGtkComboBox;
InputObject: PGtkObject;
begin
ComboWidget:=PGtkComboBox(AWidgetInfo^.CoreWidget);
AGtkObject := PGtkObject(AWidget);
AEntry := PGtkObject(GetComboBoxEntry(PGtkWidget(ComboWidget)));
APrivate := PGtkComboBoxPrivate(ComboWidget^.priv);
AButton := PGtkObject(APrivate^.button);
//DebugLn(['TGtk2WSCustomComboBox.SetCallbacks ',dbgsName(AWinControl),' AButton=',GetWidgetClassName(PGtkWidget(AButton)),' ComboWidget=',GetWidgetClassName(PGtkWidget(ComboWidget))]);
// we have to remove the handler gtk sets up to get the mouse down messages
if AButton <> nil then
begin
BtnPressID := g_signal_lookup('button_press_event', GTK_TYPE_COMBO_BOX);
HandlerID := g_signal_handler_find(AButton, G_SIGNAL_MATCH_ID, BtnPressID, 0, nil, nil, nil);
if HandlerID > 0 then
g_signal_handler_disconnect(AButton, HandlerID);
end;
g_signal_connect(ComboWidget, 'changed', TGCallback(@GtkChangedCB), AWidgetInfo);
// First the combo (or the entry)
if gtk_is_combo_box_entry(ComboWidget) then
InputObject := AEntry
else
InputObject := AGtkObject;
if not TCustomComboBox(AWinControl).Style.HasEditBox then
begin
// Just a combobox without a edit should handle its own keys. Issue #32458
Gtk2WidgetSet.SetCallbackDirect(LM_KEYDOWN, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_KEYUP, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_CHAR, InputObject, AWinControl);
end;
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEMOVE, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_LBUTTONDOWN, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_LBUTTONUP, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_LBUTTONDBLCLK, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_RBUTTONDBLCLK, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MBUTTONDBLCLK, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_RBUTTONDOWN, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_RBUTTONUP, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MBUTTONDOWN, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MBUTTONUP, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEWHEEL, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEHWHEEL, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_PAINT, InputObject, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_FOCUS, InputObject, AWinControl);
// And now the same for the Button in the combo
if AButton<>nil then begin
if not TCustomComboBox(AWinControl).Style.HasEditBox then
begin
// Just a combobox without a edit should handle its own keys. Issue #32458
Gtk2WidgetSet.SetCallbackDirect(LM_KEYDOWN, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_KEYUP, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_CHAR, AButton, AWinControl);
end;
if not GtkWidgetIsA(PGtkWidget(AButton),GTK_TYPE_CELL_VIEW) then begin
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEENTER, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSELEAVE, AButton, AWinControl);
end;
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEMOVE, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_LBUTTONDOWN, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_LBUTTONUP, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_LBUTTONUP, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_RBUTTONDOWN, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_RBUTTONUP, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MBUTTONDOWN, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MBUTTONUP, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEWHEEL, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_MOUSEHWHEEL, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_PAINT, AButton, AWinControl);
Gtk2WidgetSet.SetCallbackDirect(LM_FOCUS, AButton, AWinControl);
end;
// if we are a GtkComboBoxEntry
if not GtkWidgetIsA(PGtkWidget(AEntry), GTK_TYPE_ENTRY) then
g_signal_connect(Combowidget, 'grab-focus', TGCallback(@GtkComboFocus), AWidgetInfo);
AMenu := nil;
if (APrivate^.popup_widget <> nil)
and (GTK_IS_MENU(APrivate^.popup_widget)) then
AMenu := GTK_OBJECT(APrivate^.popup_widget)
else if (APrivate^.popup_window <> nil)
and (GTK_IS_MENU(APrivate^.popup_window)) then
AMenu := GTK_OBJECT(APrivate^.popup_window);
if Assigned(AMenu) and
(gtk_major_version = 2) and (gtk_minor_version < 10) then
begin
g_signal_connect(AMenu, 'show', G_CALLBACK(@GtkPopupShowCB), AWidgetInfo);
g_signal_connect_after(AMenu, 'selection-done', G_CALLBACK(@GtkPopupHideCB), AWidgetInfo);
end;
if TCustomComboBox(AWinControl).Style.HasEditBox then
g_signal_connect_after(PGtkObject(GTK_BIN(ComboWidget)^.child), 'populate-popup',
gtk_signal_func(@gtkDefaultPopupMenuCloseFix), AWidgetInfo);
if (gtk_major_version >= 2) and (gtk_minor_version >= 10) then
g_signal_connect(ComboWidget, 'notify', TGCallback(@GtkNotifyCB), AWidgetInfo);
// g_signal_connect(ComboWidget, 'set-focus-child', TGCallback(@GtkPopupShowCB), AWidgetInfo);
g_object_set_data(G_OBJECT(AWidget), 'Menu', APrivate^.popup_widget);
end;
class procedure TGtk2WSCustomComboBox.SetSensitivity(AWinControl: TWinControl; AWidget: PGtkWidget);
var
Value: TGValue;
begin
if ((gtk_major_version = 2) and (gtk_minor_version < 14)) or
(csDesigning in AWinControl.ComponentState) then
Exit;
Value.g_type := G_TYPE_BOOLEAN;
Value.data[0].v_int := longint(gTRUE);
g_object_set_property(PGObject(AWidget), 'button-sensitivity', @Value);
end;
class procedure TGtk2WSCustomComboBox.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
var
Ignore: Integer;
begin
Ignore:=0;
GetGTKDefaultWidgetSize(AWinControl, Ignore, PreferredHeight, WithThemeSpace);
PreferredWidth := 0;
end;
class function TGtk2WSCustomComboBox.GetDroppedDown(
const ACustomComboBox: TCustomComboBox): Boolean;
var
WidgetInfo: PWidgetInfo;
Combo: PGtkComboBox;
AValue: TGValue;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Combo := PGtkComboBox(WidgetInfo^.CoreWidget);
FillChar(AValue{%H-}, SizeOf(AValue), 0);
g_value_init(@AValue, G_TYPE_BOOLEAN);
if (gtk_major_version = 2) and (gtk_minor_version < 10) then
begin
if g_object_get_data(PGObject(Combo),'popup-shown-compat') <> nil then
AValue.data[0].v_int := 1
else
AValue.data[0].v_int := 0;
end else
g_object_get_property(PGObject(Combo), 'popup-shown', @AValue);
Result := AValue.data[0].v_int <> 0;
end;
class function TGtk2WSCustomComboBox.GetSelStart(
const ACustomComboBox: TCustomComboBox): integer;
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
AStart, AEnd: gint;
begin
Result := 0;
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
// if the combo is an editable ...
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then begin
if gtk_editable_get_selection_bounds(PGtkEditable(Entry), @AStart, @AEnd) = False then
Result := gtk_editable_get_position(PGtkEditable(Entry))
else
Result := Min(AStart, AEnd);
end;
end;
class function TGtk2WSCustomComboBox.GetSelLength(
const ACustomComboBox: TCustomComboBox): integer;
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
AStart, AEnd: gint;
begin
Result := 0;
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
// if the combo is an editable ...
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then
begin
if not gtk_editable_get_selection_bounds(PGtkEditable(Entry), @AStart, @AEnd) then
Exit(0);
Result := ABS(AStart - AEnd);
end;
end;
class function TGtk2WSCustomComboBox.GetItemIndex(
const ACustomComboBox: TCustomComboBox): integer;
var
WidgetInfo: PWidgetInfo;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Result := gtk_combo_box_get_active(PGtkComboBox(WidgetInfo^.CoreWidget));
end;
class function TGtk2WSCustomComboBox.GetMaxLength(
const ACustomComboBox: TCustomComboBox): integer;
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
// if the combo is an editable ...
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then begin
Result := gtk_entry_get_max_length(Entry);
end
else begin
Result := integer({%H-}PtrUInt(g_object_get_data(PGObject(WidgetInfo^.CoreWidget), 'max-length')));
end;
end;
class function TGtk2WSCustomComboBox.GetText(const AWinControl: TWinControl;
var AText: String): Boolean;
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
Index: Integer;
begin
Result := True;
WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
// if the combo is an editable ...
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then begin
AText := gtk_entry_get_text(Entry);
exit;
end;
// if we are a fixed un-editable combo then ...
Index := GetItemIndex(TCustomComboBox(AWinControl));
if Index > -1 then AText := TCustomComboBox(AWinControl).Items.Strings[Index];
end;
class procedure TGtk2WSCustomComboBox.SetArrowKeysTraverseList(
const ACustomComboBox: TCustomComboBox; NewTraverseList: boolean);
begin
// TODO: TGtk2WSCustomComboBox.SetArrowKeysTraverseList: not supported
// This is not an option that is available for this widget
// we will have to eat the keystrokes to set this to false
end;
class procedure TGtk2WSCustomComboBox.SetDroppedDown(
const ACustomComboBox: TCustomComboBox; ADroppedDown: Boolean);
var
WidgetInfo: PWidgetInfo;
Combo: PGtkComboBox;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Combo := PGtkComboBox(WidgetInfo^.CoreWidget);
case ADroppedDown of
True : gtk_combo_box_popup(Combo);
False: gtk_combo_box_popdown(Combo);
end;
end;
class procedure TGtk2WSCustomComboBox.SetSelStart(
const ACustomComboBox: TCustomComboBox; NewStart: integer);
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then begin
//gtk_entry_select_region(Entry, NewStart, NewStart);
gtk_editable_set_position(PGtkEditable(Entry), NewStart);
end;
end;
class procedure TGtk2WSCustomComboBox.SetSelLength(
const ACustomComboBox: TCustomComboBox; NewLength: integer);
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
Start: Integer;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then begin
Start := GetSelStart(ACustomComboBox);
gtk_editable_select_region(PGtkEditable(Entry), Start, Start + NewLength);
end;
end;
class procedure TGtk2WSCustomComboBox.SetItemIndex(
const ACustomComboBox: TCustomComboBox; NewIndex: integer);
var
P: PGtkWidget;
WidgetInfo: PWidgetInfo;
LCLIndex: PLongint;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
p := WidgetInfo^.CoreWidget;
if gtk_combo_box_get_active(PGtkComboBox(p)) = NewIndex then exit;
// to be delphi compatible OnChange only fires in response to user actions not program actions
// so we use WidgetInfo^.ChangeLock as a flag to not signal the OnChange Event
Inc(WidgetInfo^.ChangeLock);
gtk_combo_box_set_active(PGtkComboBox(p), NewIndex);
if (NewIndex = -1) and gtk_is_combo_box_entry(p) then
gtk_entry_set_text(PGtkEntry(GTK_BIN(p)^.child), PChar(''));
LCLIndex := WidgetInfo^.UserData;
if not Assigned(LCLIndex) then
begin
LCLIndex := New(PLongint);
WidgetInfo^.UserData := LCLIndex;
WidgetInfo^.DataOwner := True;
end;
LCLIndex^ := NewIndex;
Dec(WidgetInfo^.ChangeLock);
end;
class procedure TGtk2WSCustomComboBox.SetMaxLength(
const ACustomComboBox: TCustomComboBox; NewLength: integer);
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry<>nil then begin
gtk_entry_set_max_length(Entry, NewLength);
end;
// We save this in the CoreWidget for when the Entry Changes styles
g_object_set_data(PGObject(WidgetInfo^.CoreWidget), 'max-length', {%H-}Pointer(PtrInt(NewLength)));
end;
class procedure TGtk2WSCustomComboBox.SetStyle(
const ACustomComboBox: TCustomComboBox; NewStyle: TComboBoxStyle);
var
WidgetInfo: PWidgetInfo;
p: PGtkWidget;
NeedEntry: Boolean;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
p := WidgetInfo^.CoreWidget;
NeedEntry := NewStyle.HasEditBox;
if gtk_is_combo_box_entry(p) = NeedEntry then Exit;
ReCreateCombo(ACustomComboBox, NeedEntry, WidgetInfo);
end;
class procedure TGtk2WSCustomComboBox.SetReadOnly(
const ACustomComboBox: TCustomComboBox; NewReadOnly: boolean);
var
WidgetInfo: PWidgetInfo;
Entry: PGtkEntry;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(ACustomComboBox.Handle));
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if (Entry<>nil) and (ACustomComboBox.Style in [csDropDown, csOwnerDrawEditableFixed, csOwnerDrawEditableVariable, csSimple]) then
gtk_entry_set_editable(PGtkEditable(Entry), not NewReadOnly);
end;
class function TGtk2WSCustomComboBox.GetItems(
const ACustomComboBox: TCustomComboBox): TStrings;
var
ComboWidget: PGtkWidget;
Handle: HWND;
begin
Handle := ACustomComboBox.Handle;
ComboWidget := GetOrCreateWidgetInfo({%H-}Pointer(Handle))^.CoreWidget;
Result := TGtkListStoreStringList(g_object_get_data(PGObject(ComboWidget),
GtkListItemLCLListTag));
end;
class procedure TGtk2WSCustomComboBox.Sort(const ACustomComboBox: TCustomComboBox;
AList: TStrings; IsSorted: boolean);
var
ComboWidget: PGtkWidget;
Handle: HWND;
begin
Handle := ACustomComboBox.Handle;
ComboWidget := GetOrCreateWidgetInfo({%H-}Pointer(Handle))^.CoreWidget;
TGtkListStoreStringList(g_object_get_data(PGObject(ComboWidget),
GtkListItemLCLListTag)).Sorted := IsSorted;
end;
class procedure TGtk2WSCustomComboBox.SetColor(const AWinControl: TWinControl);
var
WidgetInfo: PWidgetInfo;
Child: PGtkWidget; // can be GtkCellRenderer or GtkEntry
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
Exit;
WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
Child := GTK_BIN(WidgetInfo^.CoreWidget)^.child;
Gtk2WidgetSet.SetWidgetColor(Child, AWinControl.Font.Color, AWinControl.Color,
[GTK_STATE_NORMAL,GTK_STYLE_BASE]);
end;
class procedure TGtk2WSCustomComboBox.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
Entry: PGtkEntry;
WidgetInfo: PWidgetInfo;
W: PGtkWidget;
begin
if not AWinControl.HandleAllocated then exit;
WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
Entry := GetComboBoxEntry(WidgetInfo^.CoreWidget);
if Entry <> nil then
begin
Gtk2WidgetSet.SetWidgetColor(PGtkWidget(Entry), AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED,GTK_STYLE_TEXT]);
Gtk2WidgetSet.SetWidgetFont(PGtkWidget(Entry), AFont);
end else
begin
W := GTK_BIN(WidgetInfo^.CoreWidget)^.child;
if W <> nil then
begin
Gtk2WidgetSet.SetWidgetColor(W, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED,GTK_STYLE_TEXT]);
Gtk2WidgetSet.SetWidgetFont(W, AFont);
end;
end;
end;
class procedure TGtk2WSCustomComboBox.SetText(const AWinControl: TWinControl;
const AText: String);
var
WidgetInfo: PWidgetInfo;
Entry: PGtkWidget;
begin
WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
// we use user ChangeLock to not signal onchange
Inc(WidgetInfo^.ChangeLock);
if gtk_is_combo_box_entry(WidgetInfo^.CoreWidget) then
begin
Entry := GTK_BIN(WidgetInfo^.CoreWidget)^.child;
gtk_entry_set_text(PGtkEntry(Entry), PChar(AText));
end;
Dec(WidgetInfo^.ChangeLock);
end;
class procedure TGtk2WSCustomComboBox.ShowHide(const AWinControl: TWinControl);
begin
Gtk2WidgetSet.SetVisible(AWinControl, AWinControl.HandleObjectShouldBeVisible);
InvalidateLastWFPResult(AWinControl, AWinControl.BoundsRect);
end;
class function TGtk2WSCustomComboBox.CanFocus(const AWinControl: TWinControl
): boolean;
var
WidgetInfo: PWidgetInfo;
Entry: PGtkWidget;
begin
if not AWinControl.HandleAllocated then exit(false);
WidgetInfo := GetWidgetInfo({%H-}Pointer(AWinControl.Handle));
if gtk_is_combo_box_entry(WidgetInfo^.CoreWidget) then begin
Entry := GTK_BIN(WidgetInfo^.CoreWidget)^.child;
Result:=GTK_WIDGET_CAN_FOCUS(Entry);
end else begin
Result:=inherited CanFocus(AWinControl);
end;
//DebugLn(['TGtk2WSCustomComboBox.CanFocus ',dbgsName(AWinControl),' ',gtk_is_combo_box_entry(WidgetInfo^.CoreWidget),' Result=',Result]);
end;
class function TGtk2WSCustomComboBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Box, // this makes it easy to switch between GtkComBox and GtkComboBoxEntry
ComboWidget: PGtkWidget; // ptr to the newly created GtkWidget
ListStore : PGtkListStore;
WidgetInfo: PWidgetInfo;
ACustomComboBox: TCustomComboBox;
ItemList: TGtkListStoreStringList;
LCLIndex: PLongint;
begin
ACustomComboBox := TCustomComboBox(AWinControl);
Box := gtk_event_box_new;
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Box,dbgsName(AWinControl));
{$ENDIF}
WidgetInfo := CreateWidgetInfo(Box, AWinControl, AParams);
ListStore := gtk_list_store_new (2, [G_TYPE_STRING, G_TYPE_POINTER, nil]);
if ACustomComboBox.Style.HasEditBox then
ComboWidget := gtk_combo_box_entry_new_with_model(GTK_TREE_MODEL (ListStore), 0)
else
ComboWidget := gtk_combo_box_new_with_model(GTK_TREE_MODEL (ListStore));
SetSensitivity(AWinControl, ComboWidget);
g_object_unref (G_OBJECT (liststore));
gtk_container_add(PGtkContainer(Box), ComboWidget);
gtk_widget_show_all(Box);
if csDesigning in AWinControl.ComponentState then
gtk_event_box_set_above_child(PGtkEventBox(Box), true);
SetRenderer(ACustomComboBox, ComboWidget, WidgetInfo);
SetMainWidget(Box, ComboWidget);
SetMainWidget(Box, GTK_BIN(ComboWidget)^.child);
if PGtkComboBoxPrivate(PGtkComboBox(ComboWidget)^.priv)^.button <> nil then
SetMainWidget(Box, PGtkComboBoxPrivate(PGtkComboBox(ComboWidget)^.priv)^.button);
LCLIndex := New(PLongint);
//Should not set the ItemIndex value here?
LCLIndex^ := -1;
WidgetInfo^.CoreWidget := ComboWidget;
WidgetInfo^.ClientWidget := Box;
WidgetInfo^.UserData := LCLIndex;
WidgetInfo^.DataOwner := True;
//gtk_widget_add_events(Box, GDK_ALL_EVENTS_MASK);
SetCallbacks(AWinControl, Box, WidgetInfo);
// Items
ItemList:= TGtkListStoreStringList.Create(
gtk_combo_box_get_model(PGtkComboBox(ComboWidget)),0,ACustomComboBox);
g_object_set_data(PGObject(ComboWidget),GtkListItemLCLListTag,ItemList);
// This is done in InitializeWnd: ItemList.Assign(ACustomComboBox.Items);
if ACustomComboBox.Items is TStringList then
ItemList.Sorted:=TStringList(ACustomComboBox.Items).Sorted;
if AParams.Style and WS_VISIBLE = 0 then
gtk_widget_hide(Box)
else
gtk_widget_show(Box);
Result := TLCLIntfHandle({%H-}PtrUInt(Box));
end;
class procedure TGtk2WSCustomComboBox.DestroyHandle(
const AWinControl: TWinControl);
var
Handle: HWND;
ComboWidget: PGtkWidget;
begin
Handle := AWinControl.Handle;
ComboWidget := GetOrCreateWidgetInfo({%H-}Pointer(Handle))^.CoreWidget;
if PGtkComboBoxPrivate(PGtkComboBox(ComboWidget)^.priv)^.button <> nil then
FreeWidgetInfo(PGtkComboBoxPrivate(PGtkComboBox(ComboWidget)^.priv)^.button);
//DebugLn(['TGtk2WSCustomComboBox.DestroyHandle ',dbgsName(AWinControl),' ClassParent=',ClassParent.ClassName]);
// inherited DestroyHandle doesn't work, because that is determined at
// compile time, while the WS class hierarchy is created at runtime
TWSWinControlClass(Classparent).DestroyHandle(AWinControl);
end;
{ TGtk2WSCustomGroupBox }
class procedure TGtk2WSCustomGroupBox.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
end;
class procedure TGtk2WSCustomGroupBox.SetLabel(AFrame: PGtkFrame; AText: String);
var
Lbl: PGtkWidget;
begin
Lbl := gtk_frame_get_label_widget(AFrame);
if (AText = '') then
begin
if Lbl <> nil then
gtk_widget_destroy(Lbl);
end
else
begin
if Lbl = nil then
begin
Lbl := gtk_label_new(nil);
gtk_widget_show(Lbl);
gtk_frame_set_label_widget(AFrame, Lbl);
end;
Gtk2Widgetset.SetLabelCaption(PGtkLabel(Lbl), AText);
end;
end;
class function TGtk2WSCustomGroupBox.GetFrameWidget(AEventBox: PGtkEventBox): PGtkFrame;
var
GBWidget: PGTKWidget;
begin
GBWidget := PGTKWidget(AEventBox);
Result:=PGtkFrame(PGtkBin(GBWidget)^.child);
end;
class function TGtk2WSCustomGroupBox.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams
): TLCLIntfHandle;
var
{$if not defined(GtkFixedWithWindow)}
EventBox: PGtkWidget;
{$endif}
FrameBox: PGTKWidget;
TempWidget: PGTKWidget; // pointer to gtk-widget (local use when neccessary)
p : pointer; // ptr to the newly created GtkWidget
Allocation: TGTKAllocation;
WidgetInfo: PWidgetInfo;
begin
P := gtk_frame_new(nil);
SetLabel(P, AParams.Caption);
WidgetInfo := CreateWidgetInfo(P, AWinControl, AParams);
{$if defined(GtkFixedWithWindow)}
TempWidget := CreateFixedClientWidget;
gtk_container_add(GTK_CONTAINER(p), TempWidget);
WidgetInfo^.ClientWidget := TempWidget;
WidgetInfo^.CoreWidget := TempWidget;
g_object_set_data(PGObject(TempWidget), 'widgetinfo', WidgetInfo);
{$else}
EventBox := gtk_event_box_new;
gtk_event_box_set_visible_window(PGtkEventBox(EventBox), False);
TempWidget := CreateFixedClientWidget(False);
gtk_container_add(GTK_CONTAINER(EventBox), TempWidget);
gtk_container_add(GTK_CONTAINER(p), EventBox);
gtk_widget_show(EventBox);
WidgetInfo^.ClientWidget := TempWidget;
WidgetInfo^.CoreWidget := EventBox;
g_object_set_data(PGObject(TempWidget), 'widgetinfo', WidgetInfo);
g_object_set_data(PGObject(EventBox), 'widgetinfo', WidgetInfo);
{$endif}
FrameBox := gtk_event_box_new;
gtk_event_box_set_visible_window(PGtkEventBox(FrameBox), True);
gtk_container_add(GTK_CONTAINER(FrameBox), p);
g_object_set_data(PGObject(FrameBox), 'widgetinfo', WidgetInfo);
gtk_widget_show(TempWidget);
gtk_widget_show(P);
if AWinControl.HandleObjectShouldBeVisible then
gtk_widget_show(FrameBox);
Result := TLCLIntfHandle({%H-}PtrUInt(FrameBox));
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(FrameBox, @Allocation);
Set_RC_Name(AWinControl, FrameBox);
SetCallbacks(FrameBox, WidgetInfo);
end;
class procedure TGtk2WSCustomGroupBox.SetColor(const AWinControl: TWinControl);
var
GBWidget: PGTKWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
Exit;
GBWidget:={%H-}PGTKWidget(AWinControl.Handle);
{$if defined(GtkFixedWithWindow)}
Gtk2WidgetSet.SetWidgetColor(GetFixedWidget(GBWidget), clNone, AWinControl.Color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
{$endif}
Gtk2WidgetSet.SetWidgetColor(GBWidget, clNone, AWinControl.Color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
end;
class function TGtk2WSCustomGroupBox.GetDefaultClientRect(
const AWinControl: TWinControl; const aLeft, aTop, aWidth, aHeight: integer;
var aClientRect: TRect): boolean;
var
FrameBorders: TRect;
Widget: PGtkWidget;
FixedWidget: PGtkWidget;
begin
Result:=false;
//DebugLn(['TGtk2WSCustomGroupBox.GetDefaultClientRect ',DbgSName(AWinControl),' ',aWidth,'x',aHeight]);
if AWinControl.HandleAllocated then begin
Widget:={%H-}PGtkWidget(AWinControl.Handle);
FixedWidget:=PGtkWidget(GetFixedWidget(Widget));
//DebugLn(['TGtk2WSCustomGroupBox.GetDefaultClientRect Flags=',WidgetFlagsToString(Widget),' FixedFlags=',WidgetFlagsToString(FixedWidget),' FixedSize=',FixedWidget^.allocation.width,'x',FixedWidget^.allocation.height]);
if not GTK_WIDGET_RC_STYLE(FixedWidget) then
Result:=true;
end else begin
Result:=true;
end;
if Result then begin
FrameBorders:=GetStyleGroupboxFrameBorders;
aClientRect:=Rect(0,0,
Max(0,aWidth-FrameBorders.Left-FrameBorders.Right),
Max(0,aHeight-FrameBorders.Top-FrameBorders.Bottom));
end;
//if Result then DebugLn(['TGtk2WSCustomGroupBox.GetDefaultClientRect END FrameBorders=',dbgs(FrameBorders),' aClientRect=',dbgs(aClientRect)]);
end;
class procedure TGtk2WSCustomGroupBox.GetPreferredSize(
const AWinControl: TWinControl; var PreferredWidth, PreferredHeight: integer;
WithThemeSpace: Boolean);
begin
// ToDo: compute the minimum size ignoring LCL child controls
GetGTKDefaultWidgetSize(AWinControl, PreferredWidth, PreferredHeight,
WithThemeSpace);
end;
class procedure TGtk2WSCustomGroupBox.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
Frame: PGtkFrame;
Lbl: PGtkWidget;
begin
Frame := GetFrameWidget({%H-}PGTKEventBox(AWinControl.Handle));
Lbl := gtk_frame_get_label_widget(Frame);
if Lbl <> nil then
begin
Gtk2WidgetSet.SetWidgetColor(Lbl, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
Gtk2WidgetSet.SetWidgetFont(Lbl, AFont);
end;
inherited SetFont(AWinControl, AFont);
end;
class procedure TGtk2WSCustomGroupBox.SetText(const AWinControl: TWinControl;
const AText: string);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetText') then Exit;
SetLabel(GetFrameWidget({%H-}PGtkEventBox(AWinControl.Handle)), AText);
end;
class procedure TGtk2WSCustomGroupBox.SetBounds(const AWinControl: TWinControl;
const ALeft, ATop, AWidth, AHeight: Integer);
var
GroubBox: TCustomGroupBox absolute AWinControl;
Frame: PGtkFrame;
Lbl: PGtkWidget;
MinWidth: NativeInt;
begin
Frame := GetFrameWidget({%H-}PGTKEventBox(AWinControl.Handle));
Lbl := gtk_frame_get_label_widget(Frame);
if Lbl <> nil then
begin
MinWidth := Lbl^.allocation.x * 2;
if AWidth < MinWidth then
begin
SetText(AWinControl, '');
g_object_set_data(PGObject(Frame), 'lcl-groupbox-min-width', {%H-}gPointer(MinWidth));
end;
end
else if GroubBox.Caption <> '' then
begin
{%H-}gPointer(MinWidth) := g_object_get_data(PGObject(Frame), 'lcl-groupbox-min-width');
if (MinWidth > 0) and (AWidth >= MinWidth) then begin
SetText(AWinControl, GroubBox.Caption);
g_object_set_data(PGObject(Frame), 'lcl-groupbox-min-width', nil);
end;
end;
TGtk2WSWinControl.SetBounds(AWinControl, ALeft, ATop, AWidth, AHeight);
end;
function Gtk2WSButton_Clicked(AWidget: PGtkWidget; AInfo: PWidgetInfo): GBoolean; cdecl;
var
Msg: TLMessage;
begin
Result := CallBackDefaultReturn;
if AInfo^.ChangeLock > 0 then Exit;
// do not send LM_CLICKED. issue #21483
if g_object_get_data(PGObject(AWidget),'lcl-button-stop-clicked') = AWidget then
begin
g_object_set_data(PGObject(AWidget),'lcl-button-stop-clicked', nil);
exit;
end;
Msg.Msg := LM_CLICKED;
Result := DeliverMessage(AInfo^.LCLObject, Msg) = 0;
end;
function Gtk2WSButtonPressedEvent(widget: PGtkWidget; {%H-}event: pgdkEventButton; {%H-}data: gPointer): GBoolean; cdecl;
begin
Result := CallBackDefaultReturn;
// set to nil data if we pressed return before,
// otherwise LM_CLICKED won't trigger. issue #21483
g_object_set_data(PGObject(Widget),'lcl-button-stop-clicked', nil);
end;
procedure Gtk2WSButton_SizeAllocate(widget: PGtkWidget; {%H-}allocation: PGtkAllocation; {%H-}user_data: gpointer); cdecl;
var
xthickness, ythickness: gint;
inner_border: PGtkBorder;
begin
//the default GtkButton size_allocate handler takes into account
//*thickness and inner_border properties to position the child (label)
//see gtk_button_size_allocate in gtkbutton.c
//here this is reverted so the child is not padded
xthickness := widget^.style^.xthickness;
ythickness := widget^.style^.ythickness;
with PGtkBin(widget)^.child^.allocation do
begin
y := y - ythickness;
height := height + 2 * ythickness;
x := x - xthickness;
width := width + 2 * xthickness;
inner_border := nil;
if gtk_minor_version > 8 then
gtk_widget_style_get (widget, 'inner-border', @inner_border, nil);
if inner_border <> nil then
begin
x := x - inner_border^.left;
width := width + inner_border^.left + inner_border^.right;
y := y - inner_border^.top;
height := height + inner_border^.top + inner_border^.bottom;
gtk_border_free(inner_border);
end
else
begin
//if no inner-border is set, GtkButton uses a default border = (1,1,1,1)
dec(x);
dec(y);
inc(width, 2);
inc(height, 2);
end;
end;
end;
{ TGtk2WSButton }
class function TGtk2WSButton.GetButtonWidget(AEventBox: PGtkEventBox): PGtkButton;
begin
Result := PGtkButton(PGtkBin(AEventBox)^.child);
end;
class function TGtk2WSButton.GetLabelWidget(AEventBox: PGtkEventBox): PGtkLabel;
begin
Result := PGtkLabel(PGtkBin(GetButtonWidget(AEventBox))^.child);
end;
class procedure TGtk2WSButton.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
SignalConnect(AWidgetInfo^.CoreWidget, 'clicked', @Gtk2WSButton_Clicked, AWidgetInfo);
SignalConnect(AWidgetInfo^.CoreWidget, 'button-press-event', @Gtk2WSButtonPressedEvent, AWidgetInfo);
SignalConnect(AWidgetInfo^.CoreWidget, 'size-allocate', @Gtk2WSButton_SizeAllocate, AWidgetInfo);
end;
{
Under Gtk 2 we need to put a GtkEventBox under the GtkButton, because a
GtkButton has no window and that causes the Z-Order to be wrong.
}
class function TGtk2WSButton.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Button: TCustomButton;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
EventBox, BtnWidget: PGtkWidget;
begin
Button := AWinControl as TCustomButton;
//DebugLn(['TGtk2WSButton.CreateHandle ',dbgsName(Button)]);
{ Creates the container control for the button, the EventBox }
EventBox := gtk_event_box_new;
Result := TLCLIntfHandle({%H-}PtrUInt(EventBox));
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(EventBox,'button');
{$ENDIF}
{ Creates the button and inserts it into the EventBox }
BtnWidget := gtk_button_new_with_label('button');
gtk_container_add(PGtkContainer(EventBox), BtnWidget);
gtk_widget_show_all(EventBox);
{ This commented commands can be used if we have event-related
problems because of the EventBox }
// gtk_widget_add_events(EventBox, GDK_ALL_EVENTS_MASK);
// gtk_event_box_set_above_child(PGtkEventBox(EventBox), True);
{ The WidgetInfo is important for the form designer }
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), Button, AParams);
WidgetInfo^.CoreWidget := BtnWidget;
WidgetInfo^.ClientWidget := EventBox;
//DebugLn(['TGtk2WSButton.CreateHandle ',GetWidgetInfo(EventBox)=WidgetInfo,' ',GetWidgetInfo(EventBox)^.ClientWidget=BtnWidget]);
// g_object_set_data(PGObject(Result), 'widgetinfo', WidgetInfo);
SetMainWidget(EventBox, BtnWidget);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(EventBox, @Allocation);
Set_RC_Name(AWinControl, EventBox);
SetCallbacks(EventBox, WidgetInfo);
if AParams.Style and WS_VISIBLE = 0 then
gtk_widget_hide(EventBox)
else
gtk_widget_show(EventBox);
end;
class function TGtk2WSButton.GetText(const AWinControl: TWinControl; var AText: String): Boolean;
begin
// The button text is static, so let the LCL fallback to FCaption
Result := False;
end;
class procedure TGtk2WSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean);
begin
if not WSCheckHandleAllocated(AButton, 'SetDefault')
then Exit;
if ADefault
and (GTK_WIDGET_CAN_DEFAULT({%H-}pgtkwidget(AButton.Handle))) then
//gtk_widget_grab_default(pgtkwidget(handle))
else begin
{DebugLn('LM_BTNDEFAULT_CHANGED ',TCustomButton(Sender).Name,':',Sender.ClassName,' widget can not grab default ',
' visible=',GTK_WIDGET_VISIBLE(PGtkWidget(Handle)),
' realized=',GTK_WIDGET_REALIZED(PGtkWidget(Handle)),
' mapped=',GTK_WIDGET_MAPPED(PGtkWidget(Handle)),
'');}
// gtk_widget_Draw_Default(pgtkwidget(Handle)); //this isn't right but I'm not sure what to call
end;
end;
class procedure TGtk2WSButton.SetShortcut(const AButton: TCustomButton;
const ShortCutK1, ShortCutK2: TShortcut);
begin
if not WSCheckHandleAllocated(AButton, 'SetShortcut')
then Exit;
// gtk2: shortcuts are handled by the LCL
end;
class procedure TGtk2WSButton.SetText(const AWinControl: TWinControl; const AText: String);
var
BtnWidget: PGtkButton;
LblWidget: PGtkLabel;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
BtnWidget := GetButtonWidget({%H-}PGtkEventBox(AWinControl.Handle));
LblWidget := PGtkLabel(PGtkBin(BtnWidget)^.Child);
if LblWidget = nil
then begin
//DebugLn(Format('trace: [WARNING] Button %s(%s) has no label', [AWinControl.Name, AWinControl.ClassName]));
LblWidget := PGtkLabel(gtk_label_new(''));
gtk_container_add(PGtkContainer(BtnWidget), PGtkWidget(LblWidget));
end;
Gtk2WidgetSet.SetLabelCaption(LblWidget, AText);
end;
class procedure TGtk2WSButton.SetColor(const AWinControl: TWinControl);
var
BtnWidget: PGTKWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then
Exit;
BtnWidget := PGTKWidget(GetButtonWidget({%H-}PGtkEventBox(AWinControl.Handle)));
Gtk2WidgetSet.SetWidgetColor(BtnWidget, clNone, AWinControl.Color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
end;
class procedure TGtk2WSButton.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
LblWidget: PGtkWidget;
begin
if not AWinControl.HandleAllocated then exit;
LblWidget := PGtkWidget(GetLabelWidget({%H-}PGtkEventBox(AWinControl.Handle)));
if (LblWidget <> nil) then
begin
Gtk2WidgetSet.SetWidgetColor(LblWidget, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
Gtk2WidgetSet.SetWidgetFont(LblWidget, AFont);
end;
end;
class procedure TGtk2WSButton.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
begin
GetGTKDefaultWidgetSize(AWinControl,PreferredWidth,PreferredHeight,
WithThemeSpace);
//debugln('TGtkWSButton.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;
{ TGtk2WSScrollBar }
class procedure TGtk2WSScrollBar.SetCallbacks(const AGtkWidget: PGtkWidget;
const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
g_signal_connect(AGtkWidget, 'change-value', TGCallback(@Gtk2RangeScrollCB), AWidgetInfo);
g_signal_connect(AGtkWidget, 'button-press-event',
TGCallback(@Gtk2RangeScrollPressCB), AWidgetInfo);
g_signal_connect(AGtkWidget, 'button-release-event',
TGCallback(@Gtk2RangeScrollReleaseCB), AWidgetInfo);
end;
class function TGtk2WSScrollBar.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Adjustment: PGtkAdjustment = nil;
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
begin
with TScrollBar(AWinControl) do
begin
{We use Max + PageSize because the GTK scrollbar is meant to scroll from
min to max-pagesize which would be different from the behaviour on other
widgetsets.}
Adjustment := PGtkAdjustment(gtk_adjustment_new(Position, Min,
Max, SmallChange, LargeChange, PageSize));
if (Kind = sbHorizontal) then
Widget := gtk_hscrollbar_new(Adjustment)
else
Widget := gtk_vscrollbar_new(Adjustment);
gtk_range_set_update_policy(PGtkRange(Widget), GTK_UPDATE_CONTINUOUS);
end;
Result := TLCLIntfHandle({%H-}PtrUInt(Widget));
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
Set_RC_Name(AWinControl, Widget);
SetCallbacks(Widget, WidgetInfo);
end;
class procedure TGtk2WSScrollBar.SetKind(const AScrollBar: TCustomScrollBar;
const AIsHorizontal: Boolean);
begin
if not AScrollBar.HandleAllocated then
exit;
RecreateWnd(AScrollBar);
end;
class procedure TGtk2WSScrollBar.SetParams(const AScrollBar: TCustomScrollBar);
var
Range: PGtkRange;
begin
if not AScrollBar.HandleAllocated then
exit;
with AScrollBar do
begin
Range := GTK_RANGE({%H-}Pointer(Handle));
{for gtk >= 2.14 use gtk_adjustment_configure}
if (gtk_major_version >= 2) and (gtk_minor_version >= 14) then
gtk_adjustment_configure(Range^.adjustment, Position, Min, Max, SmallChange, LargeChange, PageSize)
else
begin
with Range^.adjustment^ do
begin
value := Position;
lower := Min;
upper := Max;
step_increment := SmallChange;
page_increment := LargeChange;
page_size := PageSize;
end;
gtk_adjustment_changed(Range^.adjustment);
end;
end;
end;
class procedure TGtk2WSScrollBar.ShowHide(const AWinControl: TWinControl);
begin
if not AWinControl.HandleAllocated then
exit;
if AWinControl.HandleObjectShouldBeVisible then
SetParams(TCustomScrollBar(AWinControl));
Gtk2WidgetSet.SetVisible(AWinControl,
AWinControl.HandleObjectShouldBeVisible);
end;
class procedure TGtk2WSScrollBar.ScrollBy(const AWinControl: TWinControl;
DeltaX, DeltaY: integer);
var
Scrolled: PGtkRange;
Adjustment: PGtkAdjustment;
NewPos, v: gdouble;
Delta: Integer;
begin
if not AWinControl.HandleAllocated then exit;
Scrolled := GTK_RANGE({%H-}Pointer(AWinControl.Handle));
if not GTK_IS_SCROLLBAR(Scrolled) then
exit;
if GTK_IS_HSCROLLBAR(Scrolled) then
Delta := DeltaX
else
Delta := DeltaY;
Adjustment := gtk_range_get_adjustment(Scrolled);
if (Adjustment <> nil) then
begin
v := gtk_adjustment_get_value(Adjustment);
NewPos := Adjustment^.upper - Adjustment^.page_size;
if v - Delta <= NewPos then
NewPos := v - Delta;
gtk_adjustment_set_value(Adjustment, NewPos);
end;
// gtk doesn't emit a signal when we change the value manually
Gtk2RangeScrollCB(Scrolled, GTK_SCROLL_JUMP, NewPos, GetWidgetInfo(Scrolled));
end;
{ TGtk2WSRadioButton }
class function TGtk2WSRadioButton.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Widget, TempWidget: PGtkWidget;
LabelWidget: PGtkLabel;
TempInt: Integer;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
begin
with TRadioButton(AWinControl) do
begin
// Look for our parent's control and use the first radio we find for grouping
TempWidget := nil;
if (Parent <> nil) then
begin
for TempInt := 0 to Parent.ControlCount - 1 do
begin
if (Parent.Controls[TempInt] is TRadioButton) and
TWinControl(Parent.Controls[TempInt]).HandleAllocated then
begin
TempWidget := {%H-}PGtkWidget(TWinControl(Parent.Controls[TempInt]).Handle);
Break;
end;
end;
end;
if TempWidget <> nil then
Widget := gtk_radio_button_new_with_label(PGtkRadioButton(TempWidget)^.group,'')
else
Widget := gtk_radio_button_new_with_label(nil, '');
LabelWidget := PGtkLabel(gtk_bin_get_child(PGtkBin(@PGTKToggleButton(Widget)^.Button)));
Gtk2WidgetSet.SetLabelCaption(LabelWidget, AParams.Caption);
end;
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
Result := THandle({%H-}PtrUInt(Widget));
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(Widget, @Allocation);
Set_RC_Name(AWinControl, Widget);
TGtk2WSCustomCheckBox.SetCallbacks(Widget, WidgetInfo);
end;
{ TGtk2WSToggleBox }
class function TGtk2WSToggleBox.CreateHandle(const AWinControl: TWinControl;
const AParams: TCreateParams): TLCLIntfHandle;
var
Widget: PGtkWidget;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
begin
Widget := gtk_toggle_button_new_with_label(AParams.Caption);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Widget, dbgsName(AWinControl));
{$ENDIF}
Result := THandle({%H-}PtrUInt(Widget));
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AWinControl, AParams);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate(Widget, @Allocation);
Set_RC_Name(AWinControl, Widget);
TGtk2WSCustomCheckBox.SetCallbacks(Widget, WidgetInfo);
end;
{ TGtk2WSCustomStaticText }
class function TGtk2WSCustomStaticText.GetLabelWidget(AFrame: PGtkFrame): PGtkLabel;
begin
Result := PGtkLabel(PGtkBin(GetBoxWidget(AFrame))^.child);
end;
class function TGtk2WSCustomStaticText.GetBoxWidget(AFrame: PGtkFrame): PGtkEventBox;
begin
Result := PGtkEventBox(PGtkBin(AFrame)^.child);
end;
class function TGtk2WSCustomStaticText.CreateHandle(
const AWinControl: TWinControl; const AParams: TCreateParams
): TLCLIntfHandle;
var
AStaticText: TCustomStaticText;
WidgetInfo: PWidgetInfo;
Allocation: TGTKAllocation;
EventBox, LblWidget: PGtkWidget;
begin
// TStaticText control is a Text area with frame around. Both Text and Area around
// text can have their own color
// To implement that in gtk we need:
// 1. GtkLabel to handle Text
// 2. GtkEventBox to draw color area around GtkLabel (since GtkLabel have no window)
// 3. GtkFrame to draw frame around Text area
// GtkFrame is our main widget - it is container and it contains GtkEventBox
// GtkEventBox is also containter and it contains GtkLabel
AStaticText := AWinControl as TCustomStaticText;
Result := TLCLIntfHandle({%H-}PtrUInt(gtk_frame_new(nil))); // frame is the main container - to decorate label
if Result = 0 then Exit;
gtk_frame_set_shadow_type({%H-}PGtkFrame(Result), StaticBorderShadowMap[AStaticText.BorderStyle]);
EventBox := gtk_event_box_new; // our area
LblWidget := gtk_label_new(PChar(TCustomStaticText(AWinControl).Caption)); // our text widget
gtk_container_add(PGtkContainer(EventBox), LblWidget);
SetLabelAlignment(PGtkLabel(LblWidget), AStaticText.Alignment);
gtk_widget_show(LblWidget);
gtk_widget_show(EventBox);
gtk_container_add({%H-}PGtkContainer(Result), EventBox);
{$IFDEF DebugLCLComponents}
DebugGtkWidgets.MarkCreated(Pointer(Result), dbgsName(AWinControl));
{$ENDIF}
WidgetInfo := CreateWidgetInfo({%H-}Pointer(Result), AStaticText, AParams);
WidgetInfo^.CoreWidget := EventBox;
g_object_set_data(PGObject(EventBox), 'widgetinfo', WidgetInfo);
Allocation.X := AParams.X;
Allocation.Y := AParams.Y;
Allocation.Width := AParams.Width;
Allocation.Height := AParams.Height;
gtk_widget_size_allocate({%H-}PGtkWidget(Result), @Allocation);
Set_RC_Name(AWinControl, {%H-}PGtkWidget(Result));
SetCallbacks({%H-}PGtkWidget(Result), WidgetInfo);
end;
class procedure TGtk2WSCustomStaticText.SetAlignment(const ACustomStaticText: TCustomStaticText;
const NewAlignment: TAlignment);
var
LblWidget: PGtkLabel;
begin
if not WSCheckHandleAllocated(ACustomStaticText, 'SetAlignment')
then Exit;
LblWidget := GetLabelWidget({%H-}PGtkFrame(ACustomStaticText.Handle));
SetLabelAlignment(LblWidget, NewAlignment);
end;
class procedure TGtk2WSCustomStaticText.GetPreferredSize(const AWinControl: TWinControl;
var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);
begin
GetGTKDefaultWidgetSize(AWinControl, PreferredWidth, PreferredHeight,
WithThemeSpace);
//debugln('TGtkWSCustomStaticText.GetPreferredSize ',DbgSName(AWinControl),' PreferredWidth=',dbgs(PreferredWidth),' PreferredHeight=',dbgs(PreferredHeight));
end;
class function TGtk2WSCustomStaticText.GetText(const AWinControl: TWinControl;
var AText: String): Boolean;
begin
// The text is static, so let the LCL fallback to FCaption
Result := False;
end;
class procedure TGtk2WSCustomStaticText.SetText(const AWinControl: TWinControl;
const AText: String);
var
FrameWidget: PGtkFrame;
LblWidget: PGtkLabel;
begin
if not WSCheckHandleAllocated(AWincontrol, 'SetText')
then Exit;
FrameWidget := {%H-}PGtkFrame(AWinControl.Handle);
LblWidget := GetLabelWidget(FrameWidget);
if TStaticText(AWinControl).ShowAccelChar and (AText <> '') then
Gtk2WidgetSet.SetLabelCaption(LblWidget, AText)
else
begin
gtk_label_set_text(LblWidget, PChar(AText));
gtk_label_set_pattern(LblWidget, nil);
end;
end;
class procedure TGtk2WSCustomStaticText.SetStaticBorderStyle(
const ACustomStaticText: TCustomStaticText;
const NewBorderStyle: TStaticBorderStyle);
begin
if not WSCheckHandleAllocated(ACustomStaticText, 'SetStaticBorderStyle')
then Exit;
gtk_frame_set_shadow_type({%H-}PGtkFrame(ACustomStaticText.Handle), StaticBorderShadowMap[NewBorderStyle]);
end;
class procedure TGtk2WSCustomStaticText.SetCallbacks(
const AGtkWidget: PGtkWidget; const AWidgetInfo: PWidgetInfo);
begin
TGtk2WSWinControl.SetCallbacks(PGtkObject(AGtkWidget), TComponent(AWidgetInfo^.LCLObject));
SignalConnect(AGtkWidget, 'grab_focus', @gtkActivateCB, AWidgetInfo);
end;
class procedure TGtk2WSCustomStaticText.SetColor(const AWinControl: TWinControl);
begin
if not WSCheckHandleAllocated(AWinControl, 'SetColor') then Exit;
Gtk2WidgetSet.SetWidgetColor(PGtkWidget(GetBoxWidget({%H-}PGtkFrame(AWinControl.Handle))),
clNone, AWinControl.Color,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
end;
class procedure TGtk2WSCustomStaticText.SetFont(const AWinControl: TWinControl;
const AFont: TFont);
var
Widget: PGtkWidget;
begin
if not WSCheckHandleAllocated(AWinControl, 'SetFont')
then Exit;
Widget := PGtkWidget(GetLabelWidget({%H-}PGtkFrame(AWinControl.Handle)));
Gtk2WidgetSet.SetWidgetColor(Widget, AFont.Color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
Gtk2WidgetSet.SetWidgetFont(Widget, AFont);
end;
end.
Reference in New Issue View Git Blame Copy Permalink