This build fixes the TControl descendants both design and runtime (and I
tested it, works lovely with truetype fonts).
Right now though the TControl's STILL need to have their fontname explicitely
set, intriguingly this doesn't affect designtime, only runtime (odd!)
TLabel still works ONLY at designtime, I would not be surprised if the two
issues are somehow related.
Probably means I am still missing a call somewhere, but this is progress nay ?
Ciao
A.J.
--
A.J. Venter
Chief Software Architect
OpenLab International
www.getopenlab.com
www.silentcoder.co.za
+27 82 726 5103
===================================================================
--- lcl/interfaces/gtk/gtkwscontrols.pp (revision 8836)
+++ lcl/interfaces/gtk/gtkwscontrols.pp (working copy)
@@ -30,7 +30,7 @@
uses
{$IFDEF GTK2}
- Gtk2, Glib2, Gdk2,
+ Gtk2, Glib2, Gdk2,Pango,
{$ELSE}
Gtk, Glib, Gdk,
{$ENDIF}
@@ -392,6 +392,12 @@
const AFont: TFont);
var
Widget: PGtkWidget;
+{$IFDEF Gtk2}
+ PangoDescStr,DescOpts : String;
+ NewFontDescription : PPangoFontDescription;
+ Size : Integer;
+ Name : String;
+{$ENDIF}
begin
if not AWinControl.HandleAllocated then exit;
Widget:=pGtkWidget(AWinControl.handle);
@@ -399,13 +405,55 @@
exit;
if AFont.IsDefault then exit;
+{$IFDEF Gtk}
DebugLn('TGtkWSWinControl.SetFont ',DbgSName(AWinControl));
GtkWidgetSet.SetWidgetFont(Widget,Afont);
GtkWidgetSet.SetWidgetColor(Widget,AWinControl.font.color, clNone,
[GTK_STATE_NORMAL,GTK_STATE_ACTIVE,
GTK_STATE_PRELIGHT,GTK_STATE_SELECTED]);
+{$ENDIF}
+{$IFDEF Gtk2}
+
+ If Afont.IsDefault then Exit;
+
+ If AFont.Size = 0 then
+ Size := 10
+ else
+ Size := AFont.Size;
+
+ if (length(AFont.Name) = 0) or
+ (upperCase(AFont.Name) = 'DEFAULT') then
+ Name := 'Sans'
+ else
+ Name := AFont.Name;
+ DebugLn('TGtkWSWinControl.SetFont(GTK2) ',DbgSName(AWinControl));
+ PangoDescStr := Name;
+ DescOpts := '';
+ If FSBold in AFont.Style then
+ DescOpts := DescOpts + ' bold';
+ If FSItalic in AFont.Style then
+ DescOpts := DescOpts + ' italic';
+ If FSUnderline in AFont.Style then
+ DescOpts := DescOpts + ' underline';
+ If FSStrikeOut in AFont.Style then
+ DescOpts := DescOpts + ' strikethrough';
+
+ PangoDescStr := PangoDescStr+DescOpts+' '+intToStr(Size);
+//Pango does not appear to have a way to set the character set in the
+//font description but seems to default to UTF-8 this probably
+//requires some or other todo item.
+try
+ NewFontDescription := PPangoFontDescription(PangoDescStr);
+ NewFontDescription :=pango_font_description_from_string(PChar(PangoDescStr));
+ gtk_widget_modify_font(Widget,NewFontDescription);
+ pango_font_description_free(NewFontDescription);
+except
+ debugln('COULD NOT SET FONT');
end;
+{$ENDIF}
+end;
+
procedure TGtkWSWinControl.SetPos(const AWinControl: TWinControl;
const ALeft, ATop: Integer);
var
Index: lcl/interfaces/gtk2/gtk2int.pas
===================================================================
--- lcl/interfaces/gtk2/gtk2int.pas (revision 8836)
+++ lcl/interfaces/gtk2/gtk2int.pas (working copy)
@@ -54,6 +54,7 @@
TGtk2WidgetSet = class(TGtkWidgetSet)
protected
+ procedure SetWidgetFont(const AWidget: PGTKWidget; const Afont: tFont);
procedure AppendText(Sender: TObject; Str: PChar);
function CreateComponent(Sender : TObject): THandle; override;
function GetText(Sender: TComponent; var Text: String): Boolean;
@@ -120,6 +121,7 @@
property Sorted : boolean read FSorted write SetSorted;
property Owner: TWinControl read FOwner;
end;
+
{$IfDef GTK2_2}
procedure gdk_display_get_pointer(display : PGdkDisplay; screen :PGdkScreen; x :Pgint; y : Pgint; mask : PGdkModifierType); cdecl; external gdklib;
Index: lcl/interfaces/gtk2/gtk2object.inc
===================================================================
--- lcl/interfaces/gtk2/gtk2object.inc (revision 8836)
+++ lcl/interfaces/gtk2/gtk2object.inc (working copy)
@@ -959,6 +959,63 @@
Applies a Message to the sender
------------------------------------------------------------------------------}
+
+Procedure TGTK2WidgetSet.SetWidgetFont(const AWidget: PGTKWidget; const Afont: tFont);
+Var
+ PangoDescStr,DescOpts : String;
+ NewFontDescription : PPangoFontDescription;
+ Size : Integer;
+ Name : String;
+Begin
+{$IFDEF GTK2}
+ If Afont.IsDefault then Exit;
+
+ If AFont.Size = 0 then
+ Size := 10
+ else
+ Size := AFont.Size;
+
+ if (length(AFont.Name) = 0) or
+ (upperCase(AFont.Name) = 'DEFAULT') then
+ Name := 'Sans'
+ else
+ Name := AFont.Name;
+ DebugLn('Setting font name: '+Name);
+ PangoDescStr := Name;
+ DescOpts := '';
+ If FSBold in AFont.Style then
+ DescOpts := DescOpts + ' bold';
+ If FSItalic in AFont.Style then
+ DescOpts := DescOpts + ' italic';
+ If FSUnderline in AFont.Style then
+ DescOpts := DescOpts + ' underline';
+ If FSStrikeOut in AFont.Style then
+ DescOpts := DescOpts + ' strikethrough';
+
+ PangoDescStr := PangoDescStr+DescOpts+' '+intToStr(Size);
+//Pango does not appear to have a way to set the character set in the
+//font description but seems to default to UTF-8 this probably
+//requires some or other todo item.
+try
+ NewFontDescription := PPangoFontDescription(PangoDescStr);
+ NewFontDescription :=pango_font_description_from_string(PChar(PangoDescStr));
+ gtk_widget_modify_font(AWidget,NewFontDescription);
+ pango_font_description_free(NewFontDescription);
+except
+ debugln('COULD NOT SET FONT');
+end;
+{$ENDIF}
+end;
+{------------------------------------------------------------------------------
+Procedure: TGtk2Widget.SetWidgetFont
+ Params: AWidget - The widget to set the font for
+ AFont - The font to set
+
+ Sets the widget font
+Contributed by: A.J. Venter ([EMAIL PROTECTED])
+------------------------------------------------------------------------------}
+
+
procedure TGTK2WidgetSet.SetCallback(const AMsg: LongInt; const AGTKObject: PGTKObject; const ALCLObject: TObject);
procedure ConnectSenderSignal(const AnObject:PGTKObject; const ASignal: PChar;
Index: lcl/interfaces/gtk2/gtk2wsbuttons.pp
===================================================================
--- lcl/interfaces/gtk2/gtk2wsbuttons.pp (revision 8836)
+++ lcl/interfaces/gtk2/gtk2wsbuttons.pp (working copy)
@@ -44,6 +44,8 @@
TGtk2WSButton = class(TWSButton)
private
protected
+ class procedure SetFont(const AWinControl: TWinControl; const AFont : tFont); override;
+
public
end;
@@ -52,6 +54,8 @@
TGtk2WSBitBtn = class(TWSBitBtn)
private
protected
+ class procedure SetFont(const AWinControl: TWinControl; const AFont : tFont); override;
+
public
end;
@@ -66,6 +70,37 @@
implementation
+procedure TGtkWSButton.SetFont(const AWinControl: TWinControl; const AFont : TFont);
+var
+ Widget: PGTKWidget;
+ LblWidget: PGtkWidget;
+begin
+ Widget:= PGtkWidget(AWinControl.Handle);
+ {$IFDEF GTK2}
+ LblWidget := (PGtkBin(Widget)^.Child);
+ if LblWidget<>nil then
+ Gtk2WidgetSet.SetWidgetFont(LblWidget, AFont);
+end;
+
+procedure TGtkWSBitBtn.SetFont(const AWinControl: TWinControl;
+ const AFont: TFont);
+ var
+ WidgetInfo: PWidgetInfo;
+ BitBtnInfo: PBitBtnWidgetInfo;
+ Widget: PGTKWidget;
+begin
+ if not AWinControl.HandleAllocated then exit;
+ if AFont.IsDefault then exit;
+ Widget:= PGtkWidget(AWinControl.Handle);
+ WidgetInfo := GetWidgetInfo(Widget);
+ BitBtnInfo := WidgetInfo^.UserData;
+ if (BitBtnInfo=nil) or (BitBtnInfo^.LabelWidget = nil) then Exit;
+ Gtk2WidgetSet.SetWidgetFont(AWinControl,AFont);
+end;
+
+
+
+
initialization
////////////////////////////////////////////////////
