Discussion :

[KlausGunther]

Je suis sous W11 avec Delphi 6 Personal Edition.

J'essaie dans mon programme de créer plusieurs polices et d'affecter ces polices à différents contrôles VCL.

Je fais quelque chose comme ceci:

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
var
  Form2: TForm2;
  CellFont: TFont;
  MemoFont: TFont;
implementation
 
{$R *.dfm}
 
procedure TForm2.FormCreate(Sender: TObject);
begin
  CellFont := TFont.Create;
  MemoFont := TFont.Create;
end;
 
procedure TForm2.oFontSelectClick(Sender: TObject);
begin
  FontDialog1.Font.Assign(CellFont);
  if not FontDialog1.Execute then exit;
  CellFont := FontDialog1.Font;
end;
 
procedure TForm2.oSelectFontMemoClick(Sender: TObject);
begin
  FontDialog1.Font.Assign(MemoFont);
  if not FontDialog1.Execute then exit;
  MemoFont := FontDialog1.Font;
end;

Dans mon esprit, cela crée 2 polices indépendantes, chacune paramétrée à un appel à FontDialog1.
Je passe alors CellFont ou MemoFont en paramètre à une procédure.
Là, je veux l'affecter à ma police d'un objet VCL, comme ceci:

Code :

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

memo.Font.Assign(aFont);

Or, à l'exécution, je reçois ceci:


Avant, à la place de Assign, j'affectais les propriétés Name, Size, Color et Style suivantes, comme ceci:

Code :

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

1
2
dest.Font.name = org.font.name
...

Ca marche pour le permier, mais dès que je veux affecter une autre police à un autre objet, TOUS les objets que j'ai utilisés prennent les attributs de la dernière police modifiée. C'est très frustrant.

J'ai dû manquer un truc élémentaire... je pensais que Assign faisait le travail, selon https://docwiki.embarcadero.com/Libr...s.TFont.Assign:

Copies the properties of another TFont object.

Call Assign to set the properties of the font to match the characteristics of the Source object. If Source is another TFont object, Assign matches the font characteristics of the source. Assign does not copy the PixelsPerInch property, so this method can be used to copy a screen font to a printer font, or vice versa.

If the Source parameter is not another TFont object, Assign calls the inherited method so that the font can be copied from any object that can assign font properties in its AssignTo method.

Mais en exécution, le fait de passer ces Font en paramètre et de les utiliser dans une procédure, ça ne marche pas...

[KlausGunther]

J'ai trouvé ! J'ai adapté les deux modules de AndNotor trouvés ici: https://www.developpez.net/forums/d6...ont-to-string/

Ensuite, je passe mes fonts en paramètre sous forme de strings, et le tour est joué.

Un grand MERCI pour AndNotor dont j'ai copié le code et l'étendant à la propriéte Color.

Voici un TKStringGrid avec une cellule contenant un texte en bleu avec ses propres attributs, et 6 cellules fusionnées dans laquelle j'ai injecté un TMemo et qui contient un texte multi-lignes avec d'autres attributs:


Et en cliquant sur ce mémo, puis sur "Info", on a le détail des paramètres du grid et de la cellule.

[Mist2024]

Bonjour,
Vous ne pensez pas qu'il fallait mettre assign pour récupérer le font renvoyé par fontdialog au lieu d’affecter directement les viables CellFont et MemoFont ce qui écrase les objets font existants.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm2.oFontSelectClick(Sender: TObject);
begin
  FontDialog2.Font.Assign(CellFont);
  if not FontDialog1.Execute then exit;
  CellFont.Assign(FontDialog1.Font);
end;
 
procedure TForm2.oSelectFontMemoClick(Sender: TObject);
begin
  FontDialog1.Font.Assign(MemoFont);
  if not FontDialog1.Execute then exit;
  MemoFont.Assign(FontDialog1.Font);
end;

Mais vu le message d'exception "impossible d'affecter TFont à TFont" suggère que les deux fonts ne sont pas compilés par le mème programme, si c'est le cas essayer font.handle

[KlausGunther]

Bonjour,
Vous ne pensez pas qu'il fallait mettre assign pour récupérer le font renvoyé par fontdialog au lieu d’affecter directement les viables CellFont et MemoFont ce qui écrase les objets font existants.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
procedure TForm2.oFontSelectClick(Sender: TObject);
begin
  FontDialog2.Font.Assign(CellFont);
  if not FontDialog1.Execute then exit;
  CellFont.Assign(FontDialog1.Font);
end;
 
procedure TForm2.oSelectFontMemoClick(Sender: TObject);
begin
  FontDialog1.Font.Assign(MemoFont);
  if not FontDialog1.Execute then exit;
  MemoFont.Assign(FontDialog1.Font);
end;

Mais vu le message d'exception "impossible d'affecter TFont à TFont" suggère que les deux fonts ne sont pas compilés par le mème programme, si c'est le cas essayer font.handle

Merci pour ta suggestion, Mist2024.
La configuration est la suivante:
- un programme principal généré par Delphi 6 PE
- une DLL générée par Delphi 6 PE (sur la même machine, version Delphi PE identique)
- le programme principal établit la font via FontDialog1 et la passe en paramètre à une fonction de la DLL
- la fonction de la DLL affecte la font reçue en paramètre à un contrôle VCL créé par la DLL programmatiquement et injecté dans la Form1 du programme principal

Pour moi, les deux module suivants, dérivés d'un post de AndNotor, on résolu le problème:

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
function GetFontData(aFont: TFont): string;
begin
  // data elements separated by semicolons: (Name;Style;Size;Color)
  Result := Format('%s;%d;%d;%d', [aFont.Name, byte(aFont.Style), aFont.Size, aFont.Color]);
end;
 
procedure SetFontData(aFont: TFont; aData: string);
  // slice the string into elements
  function GetNext :variant;
  var
    i :integer;
  begin
    i := Pos(';', aData);
    if i = 0 then i := MaxInt;
    Result := Copy(aData, 1, i-1);
    Delete(aData, 1, i);
  end;
  //
begin
  aFont.Name  := GetNext;
  aFont.Style := TFontStyles(byte(GetNext));
  aFont.Size  := GetNext;
  aFont.Color := TColor(GetNext);
end;

Au lieu de la Font Mafont, je passe le string GetFontData(MaFont) en paramètre à la DLL.
Et dans la DLL, le charge la Font de la manière suivante:

Code :

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

1
2
3
4
5
6
7
8
 
function xxx(...; MyFontDataString: string): integer; stdcall; export;
begin
  ...
  SetSontData(MyMemo.Font,MyFontDataString)
  ...
end;
exports xxx;

Cela fonctionne.

[Mist2024]

Puisque les deux codes sont compilés dans deux fichiers différentes donc les objets fonts source est destination pointent vers vmt différents ce qui explique l'échec de l’opérateur Is TFont pour tester leur comptabilité.

Cela fonctionne.

Ce sont des paramètres standards du font qui sont convertis en string puis rétablis donc aucun échange directe entre les deux instances fonts

[KlausGunther]

Puisque les deux codes sont compilés dans deux fichiers différentes donc les objets fonts source est destination pointent vers vmt différents ce qui explique l'échec de l’opérateur Is TFont pour tester leur comptabilité.


Ce sont des paramètres standards du font qui sont convertis en string puis rétablis donc aucun échange directe entre les deux instances fonts

Oui, je veux bien l'entendre. En fait, c'est comme les objets et les contrôles: si je crée un objet dans le programme principal, je peux le transférer en paramètre à une fonction de ma DLL, mais là, je ne peux pas l'utiliser en tant qu'objet. Tout ce que je peux faire, c'est de transmettre le handle (s'il y en a un). Et il en est de même dans le sens inverse: un objet créé dans la DLL peut être transféré dans le programme principal, mais ne peut pas y être utilisé en tant qu'objet.

Je comprends qu'une police créé à partir de TFont est un objet qui répond aux mêmes règles. Ma tentative avec Assign était donc voué à l'échec.
Tu dis que ma solution avec GetFontData/SetFontData ne transfère en réalité que les propriétés - je comprends cela et vois le mécanisme. Cela élimine mon problème et je prendrai bonne note de toutes ces explications.

Merci !