Drat, should have looked FIRST, it added all those Makefile stuff again.
The attached one is cleaned up - just the REAL changes this time.
On Monday 27 February 2006 20:21, A.J. Venter wrote:
> This is very nearly ready, but it still has two bugs I don't know how to
> fix - hopefully though it will provide enough of a basis that somebody can
> help me finish it off.
>
> Bugs:
> 1) Tedit doesn't display unless the font is EXPLICITELY set (e.g. my
> current catch code doesn't seem to work for it)
> 2) TLable sets the font at designtime but not at runtime
--
A.J. Venter
Chief Software Architect
OpenLab International
www.getopenlab.com
www.silentcoder.co.za
+27 82 726 5103
--- 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,8 @@
property Sorted : boolean read FSorted write SetSorted;
property Owner: TWinControl read FOwner;
end;
+
+Type PGTK2Widget = ^TGTK2WidgetSet;
{$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
////////////////////////////////////////////////////
