paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-11 13:28:04 +02:00
Code Issues Packages Projects Releases Wiki Activity

Gtk3: Implemented LCLGtkSpinButton to fix sizing of GtkSpinButton, especially autosize.

Browse Source
This commit is contained in:
zeljan1 2025-01-19 20:22:04 +01:00
parent 14cab142ef
commit 24bf163157
4 changed files with 299 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

151
lcl/interfaces/gtk3/gtk3lclspinbutton.inc Normal file
View File

@ -0,0 +1,151 @@
{%MainUnit gtk3widgets.pas}
const
GTK_SPIN_BUTTON_CLASS_SIZE = SizeOf(TGtkSpinButtonClass);
GTK_SPIN_BUTTON_INSTANCE_SIZE = SizeOf(TGtkSpinButton);
procedure LCLGtkSpinButtonGetPreferredWidth(widget: PGtkWidget; min_width, nat_width: Pgint); cdecl;
var
AControl: TGtk3Widget;
ParentClass: PGtkWidgetClass;
begin
if not Assigned(min_width) or not Assigned(nat_width) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredWidth invalid params.');
Exit;
end;
if not Gtk3IsWidget(widget) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredWidth widget param is not PGtkWidget.');
Exit;
end;
ParentClass := PGtkWidgetClass(g_type_class_peek_parent(widget^.g_type_instance.g_class));
if not Assigned(ParentClass) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredWidth cannot get ParentClass !');
Exit;
end;
// Call parent class implementation
ParentClass^.get_preferred_width(widget, min_width, nat_width);
// writeln('LCLSpinButton preferred min_width=',min_width^,' natural w=',nat_width^);
AControl := TGtk3Widget(HwndFromGtkWidget(widget));
if not Assigned(AControl) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredWidth cannot get TGtk3Widget for widget parameter.');
Exit;
end;
// Custom width handling, gtk's spin button is very ugly about width.
// Gtk's minimum size for GtkSpinButton is 102 px at 96 dpi, so pretty big.
// 75 with applied css is 1 char and +- buttons
// 90 should be LCL default, so we see at least two numbers with default font.
if AControl.LCLWidth = 0 then
begin
min_width^ := Max(min_width^ div 2, AControl.LCLObject.Width);
nat_width^ := Max(min_width^ div 2, AControl.LCLObject.Width);
end else
begin
min_width^ := Max(min_width^ div 2, AControl.LCLWidth);
nat_width^ := Max(min_width^ div 2, AControl.LCLWidth);
end;
end;
procedure LCLGtkSpinButtonGetPreferredHeight(widget: PGtkWidget; min_height, nat_height: Pgint); cdecl;
var
AControl: TGtk3Widget;
ParentClass: PGtkWidgetClass;
begin
if not Assigned(min_height) or not Assigned(nat_height) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredHeight invalid params.');
Exit;
end;
if not Gtk3IsWidget(widget) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredHeight widget param is not PGtkWidget.');
Exit;
end;
ParentClass := PGtkWidgetClass(g_type_class_peek_parent(widget^.g_type_instance.g_class));
if not Assigned(ParentClass) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredHeight cannot get ParentClass !');
Exit;
end;
// Call parent class implementation
ParentClass^.get_preferred_height(widget, min_height, nat_height);
AControl := TGtk3Widget(HwndFromGtkWidget(widget));
if not Assigned(AControl) then
begin
DebugLn('Error: LCLGtkSpinButtonGetPreferredHeight cannot get TGtk3Widget for widget parameter.');
Exit;
end;
// we respect ws height if autosize is true.
if AControl.LCLObject.AutoSize then
exit;
if AControl.LCLHeight = 0 then
begin
min_height^ := Max(min_height^ div 2, AControl.LCLObject.Height);
nat_height^ := Max(min_height^ div 2, AControl.LCLObject.Height);
end else
begin
min_height^ := Max(min_height^ div 2, AControl.LCLHeight);
nat_height^ := Max(min_height^ div 2, AControl.LCLHeight);
end;
end;
procedure LCLGtkSpinButtonClassInit(klass: PGTypeClass; {%H-}data: Pointer); cdecl;
var
AWidgetClass: PGtkWidgetClass;
begin
AWidgetClass := PGtkWidgetClass(klass);
AWidgetClass^.get_preferred_width := @LCLGtkSpinButtonGetPreferredWidth;
AWidgetClass^.get_preferred_height := @LCLGtkSpinButtonGetPreferredHeight;
end;
procedure LCLGtkSpinButtonInstanceInit(instance: PGTypeInstance; {%H-}klass: PGTypeClass); cdecl;
// var
// buttonWidget: PGtkSpinButton;
begin
//buttonWidget := PGtkSpinButton(instance);
// Custom initialization logic (if needed)
//AStyleContext := buttonwidget^.get_style_context;
//AStyleContext^.get_
end;
var
LCLGtkSpinButtonType: TGType = 0;
function LCLGtkSpinButtonGetType: TGType; cdecl;
const
lcl_spin_button_type_info: TGTypeInfo = (
class_size: GTK_SPIN_BUTTON_CLASS_SIZE;
base_init: nil;
base_finalize: nil;
class_init: @LCLGtkSpinButtonClassInit;
class_finalize: nil;
class_data: nil;
instance_size: GTK_SPIN_BUTTON_INSTANCE_SIZE;
n_preallocs: 0;
instance_init: @LCLGtkSpinButtonInstanceInit;
value_table: nil;
);
begin
if LCLGtkSpinButtonType = 0 then
LCLGtkSpinButtonType := g_type_register_static(gtk_spin_button_get_type, 'LCLGtkSpinButton', @lcl_spin_button_type_info, G_TYPE_FLAG_NONE);
Result := LCLGtkSpinButtonType;
end;
function LCLGtkSpinButtonNew: PGtkSpinButton;
begin
Result := PGtkSpinButton(g_object_new(LCLGtkSpinButtonGetType(),'wrap',[gboolean(False), nil]));
end;

2
lcl/interfaces/gtk3/gtk3object.inc
View File

@ -527,7 +527,7 @@ begin
if OverlayScrolling then
ApplyCustomScrollbarStyles(Max(0, Floor(PrefH / 2) - 1));
//ApplyCustomSpinButtonCSS;
ApplyCustomSpinButtonCSS;
header^.get_preferred_height(@MinH, @PrefH);
FSystemMetricsList.Items[SM_CYCAPTION] := Max(MinH, PrefH);

140
lcl/interfaces/gtk3/gtk3widgets.pas
View File

@ -240,7 +240,9 @@ type
class procedure EntryChanged({%H-}AEntry: PGtkEntryBuffer; AData: GPointer); cdecl; static;
class procedure InsertText(editable: PGtkEditable; aNewText: PgChar; anewtextlen: gint;
var pos:Pgint; data: gpointer);cdecl; static;
class procedure EntrySizeAllocate(AWidget: PGtkWidget; AGdkRect: PGdkRectangle; Data: gpointer); cdecl; static;
protected
procedure ConnectSizeAllocateSignal(ToWidget: PGtkWidget); override;
function EatArrowKeys(const AKey: Word): Boolean; override;
function getText: String; override;
procedure setText(const AValue: String); override;
@ -263,6 +265,8 @@ type
{ TGtk3SpinEdit }
TGtk3SpinEdit = class(TGtk3Entry)
strict private
class procedure SpinValueChanged({%H-}aSpin: PGtkSpinButton; aData: gpointer); cdecl; static;
private
function GetMaximum: Double;
function GetMinimum: Double;
@ -278,6 +282,7 @@ type
function CreateWidget(const {%H-}Params: TCreateParams):PGtkWidget; override;
function EatArrowKeys(const {%H-}AKey: Word): Boolean; override;
public
procedure InitializeWidget; override;
function IsWidgetOk: Boolean; override;
procedure SetRange(AMin, AMax: Double);
property Minimum: Double read GetMinimum;
@ -1043,6 +1048,7 @@ end;
{$i gtk3lclcombobox.inc}
{$i gtk3lclentry.inc}
{$i gtk3lclbutton.inc}
{$i gtk3lclspinbutton.inc}
class function TGtk3Widget.WidgetEvent(widget: PGtkWidget; event: PGdkEvent; data: GPointer): gboolean; cdecl;
begin
@ -3675,10 +3681,41 @@ end;
class procedure TGtk3Entry.EntryChanged({%H-}AEntry: PGtkEntryBuffer; AData: GPointer); cdecl;
var
Msg: TLMessage;
S:String;
I:Integer;
ASpin: TGtk3SpinEdit;
fl: double;
begin
FillChar(Msg{%H-}, SizeOf(Msg), 0);
Msg.Msg := CM_TEXTCHANGED;
TGtk3Widget(AData).DeliverMessage(Msg);
if [wtSpinEdit] * TGtk3Widget(AData).WidgetType <> [] then
begin
ASpin := TGtk3SpinEdit(AData);
if not TGtk3Widget(AData).InUpdate then
begin
S := TGtk3SpinEdit(adata).getText;
I := 0;
if (ASpin.NumDigits = 0) then
begin
if TryStrToInt(S, I) then
begin
if (I >= Round(TGtk3SpinEdit(adata).Minimum)) and (I<= Round(TGtk3SpinEdit(adata).Maximum)) then
PGtkSpinButton(TGtk3SpinEdit(adata).Widget)^.set_value(I);
end;
end else
begin
fl := 0;
if TryStrToFloat(S, fl) then
begin
if (fl >= TGtk3SpinEdit(adata).Minimum) and (fl<= TGtk3SpinEdit(adata).Maximum) then
PGtkSpinButton(TGtk3SpinEdit(adata).Widget)^.set_value(fl);
end;
end;
end;
exit; // value-changed should trigger
end;
if not TGtk3Widget(AData).InUpdate then
TGtk3Widget(AData).DeliverMessage(Msg);
end;
class procedure TGtk3Entry.InsertText(editable: PGtkEditable; aNewText: PgChar; anewtextlen: gint;
@ -3686,10 +3723,22 @@ class procedure TGtk3Entry.InsertText(editable: PGtkEditable; aNewText: PgChar;
var
i:integer;
edt:TGtk3Entry;
//s: string;
begin
if not Assigned(data) then
exit;
edt := TGtk3Entry(data);
if [wtSpinEdit] * TGtk3Widget(data).WidgetType <> [] then
begin
(*
if pos <> nil then
s := pos^.ToString
else
s := 'nil';
writeln('SpinEdit.InsertText text=',edt.getText,' newText="',aNewText,'"',' newLen=',anewTextLen,' pos=',s);
*)
end else
if (edt.LCLObject as TCustomEdit).NumbersOnly then
begin
for i := 0 to anewtextlen-1 do
@ -3703,6 +3752,74 @@ begin
end;
end;
class procedure TGtk3Entry.EntrySizeAllocate(AWidget:PGtkWidget;AGdkRect:
PGdkRectangle;Data:gpointer);cdecl;
var
Msg: TLMSize;
NewSize: TSize;
ACtl: TGtk3Entry;
AState: TGdkWindowState;
Alloc: TGtkAllocation;
begin
if AWidget=nil then ;
ACtl := TGtk3Entry(Data);
{$IF DEFINED(GTK3DEBUGENTRY) OR DEFINED(GTK3DEBUGENTRY)}
with AGdkRect^ do
DebugLn('**** EntrySizeAllocate **** ....',dbgsName(ACtl.LCLObject),
' ',Format('GTK x %d y %d w %d h %d',[x, y, width, height]),
Format(' LCL W=%d H=%d LLW %d LLH %d',[ACtl.LCLObject.Width, ACtl.LCLObject.Height, ACtl.LCLWidth, ACtl.LCLHeight]));
{$ENDIF}
with Alloc do
begin
x := AGdkRect^.x;
y := AGdkRect^.y;
Width := AGdkRect^.width;
Height := AGdkRect^.height;
end;
//fix layout, especially for GtkSpinButton
if [wtSpinEdit] * ACtl.WidgetType <> [] then
gtk_widget_set_clip(AWidget, @Alloc);
if not Assigned(ACtl.LCLObject) then exit;
// return size w/o frame
NewSize.cx := AGdkRect^.width;
NewSize.cy := AGdkRect^.height;
if not (csDesigning in ACtl.LCLObject.ComponentState) then
begin
if ACtl.InUpdate then
exit;
end;
if ((NewSize.cx <> ACtl.LCLObject.Width) or (NewSize.cy <> ACtl.LCLObject.Height) or
ACtl.LCLObject.ClientRectNeedsInterfaceUpdate) then
begin
ACtl.LCLObject.DoAdjustClientRectChange;
end;
FillChar(Msg{%H-}, SizeOf(Msg), #0);
Msg.Msg := LM_SIZE;
Msg.SizeType := SIZE_RESTORED;
Msg.SizeType := Msg.SizeType or Size_SourceIsInterface;
Msg.Width := Word(NewSize.cx);
Msg.Height := Word(NewSize.cy);
ACtl.DeliverMessage(Msg);
end;
procedure TGtk3Entry.ConnectSizeAllocateSignal(ToWidget:PGtkWidget);
begin
g_signal_connect_data(ToWidget,'size-allocate',TGCallback(@EntrySizeAllocate), Self, nil, G_CONNECT_DEFAULT);
end;
function TGtk3Entry.getText: String;
begin
if IsValidHandle and IsWidgetOk then
@ -3901,7 +4018,9 @@ begin
PrivateSelection := -1;
ASpin := TCustomSpinEdit(LCLObject);
FWidgetType := FWidgetType + [wtSpinEdit];
Result := TGtkSpinButton.new_with_range(ASpin.MinValue, ASpin.MaxValue, ASpin.Increment);
Result := LCLGtkSpinButtonNew;
PGtkSpinButton(Result)^.set_range(ASpin.MinValue, ASpin.MaxValue);
PGtkSpinButton(Result)^.set_increments(ASpin.Increment, ASpin.Increment * 10); //page param gtk default is 10 * step.
end;
function TGtk3SpinEdit.EatArrowKeys(const AKey: Word): Boolean;
@ -3909,6 +4028,23 @@ begin
Result := False;
end;
class procedure TGtk3SpinEdit.SpinValueChanged(aSpin:PGtkSpinButton;aData:
gpointer);cdecl;
var
Msg: TLMessage;
begin
FillChar(Msg{%H-}, SizeOf(Msg), 0);
Msg.Msg := CM_TEXTCHANGED;
if not TGtk3Widget(AData).InUpdate then
TGtk3Widget(AData).DeliverMessage(Msg);
end;
procedure TGtk3SpinEdit.InitializeWidget;
begin
inherited InitializeWidget;
g_signal_connect_data(Widget, 'value-changed', TGCallback(@SpinValueChanged), Self, nil, G_CONNECT_DEFAULT);
end;
function TGtk3SpinEdit.IsWidgetOk: Boolean;
begin
Result := (Widget <> nil) and Gtk3IsSpinButton(Widget);

10
lcl/interfaces/lcl.lpk
View File

@ -131,7 +131,7 @@ end;"/>
<License Value="modified LGPL-2
"/>
<Version Major="4" Minor="99"/>
<Files Count="551">
<Files Count="553">
<Item1>
<Filename Value="carbon/agl.pp"/>
<AddToUsesPkgSection Value="False"/>
@ -2718,6 +2718,14 @@ end;"/>
<Filename Value="gtk3/gtk3lclentry.inc"/>
<Type Value="Include"/>
</Item551>
<Item552>
<Filename Value="gtk3/gtk3lclbutton.inc"/>
<Type Value="Include"/>
</Item552>
<Item553>
<Filename Value="gtk3/gtk3lclspinbutton.inc"/>
<Type Value="Include"/>
</Item553>
</Files>
<CompatibilityMode Value="True"/>
<LazDoc Paths="../../docs/xml/lcl"/>