Discussion :

[Teo]

Bonjour

Je souhaite integrer une police dans mon appli.
Est ce possible ?
Comment m'y prendre ?

Il ne s'agit pas de l'installer dans windows, mais de l'inclure dans mon exe
comme une ressource.

Merci d'avance pour vos pistes

Win XP/Vista - Delpphi 7

[Dr.Who]

un truc du genre :

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
uses
  Windows,
  SysUtils,
  Classes,
  Controls,
  Graphics,
  Messages;
 
type
  TFontLoader = class
  private
    fHandles   : TList;
    fMemory    : TList;
    fCount     : integer;
  protected
    procedure ReleaseAll; virtual;
  public
    function LoadFontFromFile(const aFileName: string): boolean;
    function LoadFontFromFontRes(const aResName: string): boolean;
    function LoadFontFromDataRes(const aResName: string): boolean;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;
 
 
 
{ TFontLoader }
 
constructor TFontLoader.Create;
begin
  fHandles := TList.Create;
  fMemory  := TList.Create;
end;
 
destructor TFontLoader.Destroy;
begin
  ReleaseAll;
  fMemory.Free;
  fHandles.Free;
  inherited;
end;
 
function TFontLoader.LoadFontFromFile(const aFileName: string): boolean;
var S : Pointer;
    H : THandle;
    C : LongWord;
begin
  with TFileStream.Create(aFileName, fmOpenRead) do
  try
    S := AllocMem(Size);
    Read(S^, Size);
    C := 1;
    H := AddFontMemResourceEx(S, Size, nil, @C);
    result := H <> INVALID_HANDLE_VALUE;
    if result then
    begin
      fMemory.Add(S);
      fHandles.Add(pointer(H));
      SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
    end
    else
      FreeMem(S, Size);
  finally
    Free;
  end;
end;
 
function TFontLoader.LoadFontFromFontRes(const aResName: string): boolean;
var S : Pointer;
    H : THandle;
    C : LongWord;
begin
  with TResourceStream.Create(0, aResName, RT_FONT) do
  try
    S := AllocMem(Size);
    Read(S^, Size);
    C := 1;
    H := AddFontMemResourceEx(S, Size, nil, @C);
    result := H <> INVALID_HANDLE_VALUE;
    if result then
    begin
      fMemory.Add(S);
      fHandles.Add(pointer(H));
      SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
    end
    else
      FreeMem(S, Size);
  finally
    Free;
  end;
end;
 
function TFontLoader.LoadFontFromDataRes(const aResName: string): boolean;
var S : Pointer;
    H : THandle;
    C : LongWord;
begin
  with TResourceStream.Create(0, aResName, RT_RCDATA) do
  try
    S := AllocMem(Size);
    Read(S^, Size);
    C := 1;
    H := AddFontMemResourceEx(S, Size, nil, @C);
    result := H <> INVALID_HANDLE_VALUE;
    if result then
    begin
      fMemory.Add(S);
      fHandles.Add(pointer(H));
      SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
    end
    else
      FreeMem(S, Size);
  finally
    Free;
  end;
end;
 
procedure TFontLoader.ReleaseAll;
begin
  while fHandles.Count > 0 do
  begin
    RemoveFontMemResourceEx(THandle(fHandles.Items[fHandles.Count - 1]));
    fHandles.Delete(fHandles.Count-1);
  end;
 
  while fMemory.Count > 0 do
  begin
    FreeMem(fMemory.Items[fMemory.Count-1]);
    fMemory.Delete(fMemory.Count-1);
  end;
 
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;

et pour la ressource (fichier fonts.rc):

Code :

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

1
2
FNTARIAL RT_FONT "arial.ttf";
FNTELVET RT_FONT "elvetica.ttf";

et le code exemple :

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
 
{$R 'fonts.res' 'fonts.rc'}
var
  DynFonts: TFontLoader;
 
procedure TForm1.Form1Create(Sender: TObject);
begin
  DynFonts := TFontLoader.Create;
  assert(DynFonts.LoadFromFontRes('FNTARIAL'), 'Police arial non chargée.');
  assert(DynFonts.LoadFromFontRes('FNTELVET'), 'Police Elvetica non chargée');
end;
 
procedure TForm1.From1Destroy(Sender: TObject);
begin
  DynFonts.Free;
end;

[Teo]

C'est exactement ça !

grand merci.

Toutefois(sans cela, life is not live)
j'ai un probleme a l'execution avec

Code :

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

1
2
3
4
5
6
7
8
function TFontLoader.LoadFontFromFile(const aFileName: string): boolean;
var S : Pointer;
    H : THandle;
    C : LongWord;
begin
  with TFileStream.Create(aFileName, fmOpenRead) do <==> ICI
 try
    S := AllocMem(Size);

Lors du create, une exception affirme que la ressource "FNTARIAL" est non trouvée

C'est grave Dr ?

Avecc ResHack, je vois bien les 2 polices dans le fichier fonts.res (creer avec bcc32 au préalable

Quelqu'un à une piste pour resoudre ce probleme ?

[Dr.Who]

utilise LoadFontFromRes et non LoadFontFromFile.

LoadFontFromRes permet de charger une police via les ressources de l'appli.
LoadFontFromFile permet de charger un fichier type Font (.fon, .ttf) qui se trouve quelque part sur le disque.

exemple :

LoadFontFromRes('FNTARIAL') -> charge la ressource FNTARIAL a partir des ressources de l'application (fichier res)

LoadFontFromFile(ExtractFilePath(ParamStr(0))+'arial.ttf') -> charge la fonte arial.ttf qui se trouve dans le repertoire de l'application.



la ressource doit être de type FONT et non RCDATA.
verifie le nom donné à la ressource (fichier .rc) :

FNTARIAL FONT "arial.ttf"

attention, il faut verifier que la police ne soit pas déjà présente pour eviter les erreur, exemple :

Code :

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

1
2
3
4
if Screen.Font.IndexOf('arial') = -1 then
  FontLoader.LoadFontFromRes('FNTARIAL');
 
Font.Name = 'arial';

[Teo]

1°/ scuz - dans ma reponse precedente, j'ai mis n'importe quoi(copier/coller qd tu nous tiens !).
En fait dans mon code c'est bien

Code :

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

LoadFontFromFontRes(NomPolice)

que j'appelle et qui genere le plantage
Encore pardon pour le temps perdu engendré

2°/ a la suite de tes remaques j'ai
* utiliser des polices non existantes dans mon windows
* ajouter le code

Code :

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

if Screen.Font.IndexOf(nompolice) = -1 then ...

* utiliser

Code :

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

LoadFontFromFile(ExtractFilePath(ParamStr(0))+NomPolice+'.ttf')

et CA MARCHE

3°/ comme le LoadFontFromFontRes echouait toujours sous pretexte que "ressource NOMPOLICE non trouvée, j'ai creusé et j'ai trouvé !
Je suis sous D7 et Vista - je sais pas si ca change qlq chose.
... roulements de tambours.... (souvenirs souvenirs)
F1 sur TResourceStream.Create ==> ConstructorCreate(Instance:THandle;constResName:string;ResType: PChar);

Code :

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

TResourceStream.Create(0, aResName, RT_FONT)

RT_FONT n'est pas tres 'pcharisé', et f1 sur lui ne donne rien
alors j'ai essayé

Code :

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

TResourceStream.Create(0, aResName, pchar('RT_FONT'))

ET LA CA MARCHE !

Apres differentes recherches qui pointaient souvent vers les interventions d'un type ressemblant au Dr WHO je crois qu'on peux dire que pour integrer une police dont on a le fichier ttf, dans une applie via les ressources (res) on peut entre autres faire

1/pour attaquer directement le fichier ttf
-

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
procedure TForm1.FormCreate(Sender: TObject) ;
begin
  // On indique où se situe la police TTF à déclarer
  AddFontResource(Char('X:\MonReperoire\MonFichier.TTF')) ;<===> vista pchar necessaire
  // On informe le système qu'il doit mettre à jour ses polices
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
end;
 
procedure TForm1.FormDestroy(Sender: TObject; var Action: TCloseAction);
begin
  // On indique où se situe la police TTF à "oublier"
  RemoveFontResource('X:\MonReperoire\MonFichier.TTF');
  // On informe le système qu'il doit mettre à jour ses polices
  SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0) ;
end;

PS: en 2008 tu demandais sur un autre forum : est ce que ca marche sous vista : OUI moyennant la modif du Pchar.

2/ utilisation des ressources

* creer un fichier du genre fic_font.rc (en texte)

Code :

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

1
2
TOPSECRET RT_FONT "TOPSECRET.TTF";
OUTLAW RT_FONT "OUTLAW.TTF";

* sous dos(ligne de cmd) taper brcc32 fic_font.rc pour fabriquer le fichier fic_font.res

* dans l'appli
ajouter

Code :

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

{$R fic_fonts.res fic_font.rc}

utiliser

Code :

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

TResourceStream.Create(0, NomFont, pchar('RT_FONT'))

Nomfont sera par exemple 'OUTLAW'
La classe du Dr Who est fonctionnelle, et c'est elle que j'utilise.

Encore grand merci Dr.
Si j'ai mal a la tete je reviendrais !

Au plaisir

[Dr.Who]

bien vus pour les recherches et corrections.