TFontDialog a disparu en FMX ?

**franckcl** · 13/12/2016, 09h12

Bonjour,

Question bête...comment fait-on pour afficher la boite de dialogue de polices windows lorsqu'on développe une application sous FMX ?
Le composant TFontDialog n'est plus disponible.

merci
Franck

Invité · 13/12/2016, 22h36

Je pense qu'il faut le faire à la main à l'aide de WinApi (et MacApi si c'est du cross plateform).

Tu as un exemple bien expliqué ici pour récupérer les polices : https://delphiscience.wordpress.com/...ensions-class/

**franckcl** · 14/12/2016, 09h51

Merci pour ta réponse.

Le problème c'est qu'il ne suffit pas d'afficher la liste des noms des polices car pour chaque police il faut aussi pouvoir choisir le type de fonte qui est différent d'une police à l'autre...

Franck

**franckcl** · 15/12/2016, 16h09

Voici en pièce jointe un exemple de TFontDialog pour windows et firemonkey
FontDialog.zip

Pour info, voici le code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
 
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;
 
  LabelSample.StyledSettings := LabelSample.StyledSettings -[TStyledSetting.ssFamily,TStyledSetting.ssSize];
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.

TFontDialog a disparu en FMX ?

Composants FMX Delphi

Vue hybride

Discussions similaires

Partager

Partager