Watch, Follow, &
Connect with Us

For forums, blogs and more please visit our
Developer Tools Community.


Welcome, Guest
Guest Settings
Help

Thread: TFontDialog does not exist in firemonkey ?



Permlink Replies: 7 - Last Post: Dec 19, 2016 2:11 AM Last Post By: franck clement
franck clement

Posts: 9
Registered: 6/18/12
TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 14, 2016 12:16 AM
Hi all,

** Delphi 10.1 Update 2 **

In my windows application, I allow the user to choose a font but I see that the TFontDialog which was present in the VCL does not exist anymore in Firemonkey.

How can I do that ?

Thanks
Franck
Dmitry Kirkinsky

Posts: 10
Registered: 11/12/02
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 14, 2016 7:27 AM   in response to: franck clement in response to: franck clement
franck clement wrote:
Hi all,

** Delphi 10.1 Update 2 **

In my windows application, I allow the user to choose a font but I see that the TFontDialog which was present in the VCL does not exist anymore in Firemonkey.

How can I do that ?

Make your own one. Here's how to get a list of font families:

{$IFDEF MSWINDOWS}
procedure GetFonts(FontList: TStringList);
var
DC: HDC;
LFont: TLogFont;
begin
FontList.BeginUpdate;
FontList.Clear;
DC := GetDC(0);
FillChar(LFont, sizeof(LFont), 0);
LFont.lfCharset := DEFAULT_CHARSET;
EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, LPARAM(FontList), 0);
ReleaseDC(0, DC);
FontList.Sort;
FontList.EndUpdate;
end;
{$ENDIF}

{$IFDEF MACOS}
procedure GetFonts(FontList: TStringList);
var
fManager: NsFontManager;
list: NSArray;
lItem: NSString;
i: Integer;
begin
FontList.BeginUpdate;
FontList.Clear;
fManager := TNsFontManager.Wrap(TNsFontManager.OCClass.sharedFontManager);
list := fManager.availableFontFamilies;
if (List <> nil) and (List.count > 0) then
begin
for i := 0 to List.Count-1 do
begin
lItem := TNSString.Wrap(List.objectAtIndex(i));
FontList.Add(String(lItem.UTF8String));
end;
end;
FontList.Sort;
FontList.EndUpdate;
end;
{$ENDIF}
franck clement

Posts: 9
Registered: 6/18/12
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 15, 2016 5:21 AM   in response to: Dmitry Kirkinsky in response to: Dmitry Kirkinsky
Good ! I can fill my font name listbox.

But now the problem is I cannot change the font family and the font size.

I've followed this example: [http://docwiki.embarcadero.com/CodeExamples/Berlin/en/FMXTFont_(Delphi)|http://docwiki.embarcadero.com/CodeExamples/Berlin/en/FMXTFont_(Delphi)]
but nothing was working.

I've replaced the line Label1.Font.Style by Label1.TextSettings.Font.Style in the event onClick of the Bold button and this is working now.

But when I change the family name or the font size, there is no change !!!!

Regards,
Franck
franck clement

Posts: 9
Registered: 6/18/12
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 15, 2016 5:30 AM   in response to: franck clement in response to: franck clement
Ok I've found

It is because the property textesettings.font.family is set to default and the font.size also at design time.

Franck
franck clement

Posts: 9
Registered: 6/18/12
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 15, 2016 6:53 AM   in response to: franck clement in response to: franck clement
Here is an example of Font dialog for windows and firemonkey:

- Insert a Listbox named FontList and fill the event OnChange
- Insert a Listbox named ListBoxSize and fill the event OnChange
- Insert 4 speedbuttons with the text B,I,U,and S and fill the events Onclick
- Add a Timer1 with interval of 100ms and fill the event OnTimer (if not, the itemindex of the listboxes do not move to the selected item)
- Add a label named LabelSample and change the TextSettings.font.Size to 10

unit FontDialog;
 
interface
 
uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Layouts, FMX.ListBox, FMX.StdCtrls,
  FMX.Controls.Presentation,Winapi.Windows;
 
type
  TMyFontDialog = class(TForm)
    Panel1: TPanel;
    BtnOK: TButton;
    BtnCancel: TButton;
    Layout1: TLayout;
    Label2: TLabel;
    FontList: TListBox;
    GroupBox1: TGroupBox;
    ListBoxSize: TListBox;
    Label1: TLabel;
    GroupBox2: TGroupBox;
    Labelsample: TLabel;
    Timer1: TTimer;
    BtnB: TSpeedButton;
    BtnI: TSpeedButton;
    BtnU: TSpeedButton;
    BtnS: TSpeedButton;
    procedure BtnCancelClick(Sender: TObject);
    procedure BtnOKClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ListBoxSizeChange(Sender: TObject);
    procedure BtnBClick(Sender: TObject);
    procedure BtnIClick(Sender: TObject);
    procedure BtnUClick(Sender: TObject);
    procedure BtnSClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FontListChange(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;
 
var
  MyFontDialog: TMyFontDialog;
 
implementation
 
{$R *.fmx}
 
//------------------------------------------------------------------------------------------------------------------------------
function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric; FontType: Integer; Data: Pointer): Integer; stdcall;
var
  S: TStrings;
  Temp: string;
begin
  S := TStrings(Data);
  Temp := LogFont.lfFaceName;
  if ((S.Count = 0) or (AnsiCompareText(S[S.Count-1], Temp) <> 0)) and (copy(temp,1,1)<>'@') then  S.Add(Temp);
  Result := 1;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.FormCreate(Sender: TObject);
Var
  DC: HDC;
  LFont: TLogFont;
  i: Integer;
  fList: TStringList;
Begin
 
  // Fill the font size
  for i:=8 to 12 do listBoxSize.items.add(inttostr(i));
  for i:=7 to 14 do listBoxSize.items.add(inttostr(i*2));
  listBoxSize.items.add('36');
  listBoxSize.items.add('48');
  listBoxSize.items.add('72');
 
  // List of font
  fList := TStringList.Create;
  DC := GetDC(0);
  FillChar(LFont, sizeof(LFont), 0);
  LFont.lfCharset := DEFAULT_CHARSET;
  EnumFontFamiliesEx(DC, LFont, @EnumFontsProc, Winapi.Windows.LPARAM(fList), 0);
  ReleaseDC(0, DC);
 
  // Fill the font list
  FontList.Items.assign(fList);
  fList.Free;
End;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.Timer1Timer(Sender: TObject);
begin
  Timer1.enabled:=false;
  listBoxSize.itemindex := listBoxSize.items.indexof(IntToStr(round(LabelSample.textsettings.font.size)));
  FontList.itemindex := FontList.items.indexof(LabelSample.textsettings.font.family);
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.FontListChange(Sender: TObject);
begin
  LabelSample.font.family:= fontList.selected.text;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.FormResize(Sender: TObject);
begin
  if height<300 then height:=300;
  if Width<470  then width :=470;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.ListBoxSizeChange(Sender: TObject);
begin
  LabelSample.font.size := StrToInt(ListBoxSize.selected.text);
end;
 
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.BtnOKClick(Sender: TObject);
begin
  modalresult:=mrok;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.BtnSClick(Sender: TObject);
begin
 if (TFontStyle.fsStrikeOut in LabelSample.Font.Style) then
    LabelSample.Font.Style := LabelSample.Font.Style - [TFontStyle.fsStrikeOut]
  else
    LabelSample.Font.Style := LabelSample.Font.Style + [TFontStyle.fsStrikeOut];
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.BtnUClick(Sender: TObject);
begin
  if (TFontStyle.fsUnderline in LabelSample.Font.Style) then
    LabelSample.Font.Style := LabelSample.Font.Style - [TFontStyle.fsUnderline]
  else
    LabelSample.Font.Style := LabelSample.Font.Style + [TFontStyle.fsUnderline];
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.BtnBClick(Sender: TObject);
begin
   if (TFontStyle.fsBold in LabelSample.Font.Style) then
      LabelSample.Font.Style := LabelSample.Font.Style - [TFontStyle.fsBold]
    else
      LabelSample.Font.Style := LabelSample.Font.Style + [TFontStyle.fsBold];
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.BtnCancelClick(Sender: TObject);
begin
  close;
end;
//------------------------------------------------------------------------------------------------------------------------------
procedure TMyFontDialog.BtnIClick(Sender: TObject);
begin
  if (TFontStyle.fsItalic in LabelSample.Font.Style) then
     LabelSample.Font.Style := LabelSample.Font.Style - [TFontStyle.fsItalic]
   else
     LabelSample.Font.Style := LabelSample.Font.Style + [TFontStyle.fsItalic];
end;
//------------------------------------------------------------------------------------------------------------------------------
end.
franck clement

Posts: 9
Registered: 6/18/12
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 16, 2016 12:52 AM   in response to: Dmitry Kirkinsky in response to: Dmitry Kirkinsky
Thanks Dmitry

And what about Android ?

Thanks
Markus Humm

Posts: 5,113
Registered: 11/9/03
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 16, 2016 8:20 AM   in response to: franck clement in response to: franck clement
Am 16.12.2016 um 09:52 schrieb franck clement:
Thanks Dmitry

And what about Android ?

Thanks

Hello,

there is some way to install additional fonts on Android. I don't know
this out of my head, but there definitively is such a way and that I
guess would be your starting point as per default afaik not so many
fonts are delivered out of the box on Android.

Greetings

Markus
franck clement

Posts: 9
Registered: 6/18/12
Re: TFontDialog does not exist in firemonkey ?
Click to report abuse...   Click to reply to this thread Reply
  Posted: Dec 19, 2016 2:11 AM   in response to: franck clement in response to: franck clement
Annother solution is to call the function choosefont in the unit WinAPI.commDlg

Function MyChooseFont(owner:TWindowHandle;var AFont:Tfont):boolean;
var
 cc : TChooseFont;
begin
  FillChar(cc, sizeof(cc), #0);
  cc.lStructSize := sizeof(cc);
  cc.hwndOwner :=  FmxHandleToHWND(owner);
  ChooseFont(cc);
End;
 
 
example of calling function: if MyChooseFont(self.Handle,Afont) then ;
 


To be finish because the font parameter must be assigned to cc.lpLogFont structure in both ways

here is the structure of tagLOGFONTW (=data structure pointed by lpLogFont)
  tagLOGFONTW = record
    lfHeight: Longint;
    lfWidth: Longint;
    lfEscapement: Longint;
    lfOrientation: Longint;
    lfWeight: Longint;
    lfItalic: Byte;
    lfUnderline: Byte;
    lfStrikeOut: Byte;
    lfCharSet: Byte;
    lfOutPrecision: Byte;
    lfClipPrecision: Byte;
    lfQuality: Byte;
    lfPitchAndFamily: Byte;
    lfFaceName: array[0..LF_FACESIZE - 1] of WideChar;
  end;
Legend
Helpful Answer (5 pts)
Correct Answer (10 pts)

Server Response from: ETNAJIVE02