Bonjour,
Trouvé récemment ce petit bout de code Delphi mais on dirait que j'ai un souci d'énumération, regardez, en haut à gauche mon mémo, et dessous le snippet :
Bon, je n'ai pas essayé avec Arial Narrow Bold (je ne l'ai pas), mais les résultats sont identiques avec Arial, Arial Bold, Arial Rounded MT Bold et GNUtypewriter.
Alors bien sûr il m'a fallu adapter, en espérant que je ne casse pas quelque chose :
La proc de callback :
et son appel :
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 function EnumCharSets( var LogFont: TEnumLogFontEx; var Metric: TNewTextMetricEx; FontType: Longint; //Strings: TStrings): Integer; stdcall; -- original mais ne compile pas Data: LParam):LongInt; stdcall; var L: TStringList; S: String; I: Integer; ID: Integer; begin L := TStringList(ptrint(Data)); ID := LogFont.elfLogFont.lfCharSet; S := Format('Unknown charset %d', [ID]); for I := 0 to NumCharSets - 1 do if CharSets[I].ID = ID then begin S := CharSets[I].Name; Break; end; L.Add(S); // Strings.Add(S); -- original result := 1; end;
Le problème, c'est qu'il est impossible de jouer en mode pas-à-pas avec une proc de callback, à chaque entrée le i du compteur de boucle est à 0...
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 procedure TForm1.GetAvailableCharSets(const FaceName: string; CharSets: TStrings); var DC: THandle; LogFont: TLogFont; ////EDIT : sert à rien ! L: TStringList; // nouveau, inspiré d'un post sur FreePascal * begin //// L := TStringList.Create; // nouveau // DC := GetDC(GetDesktopWindow); -- proc inconnue sous Linux DC := GetDC(0); if DC <> 0 then try FillChar(LogFont, SizeOf(LogFont), 0); Move(FaceName[1], LogFont.lfFaceName, Length(FaceName)); LogFont.lfCharSet := DEFAULT_CHARSET; EnumFontFamiliesEx(DC, @LogFont, @EnumProc, ptrint(lParam(CharSets)), 0); // changé sinon ne compile pas (ajout "ptrint") ////sert à rien ! CharSets.AddStrings(L); // ajout pour renvoyer les données au mémo finally // ReleaseDC(GetDesktopWindow, DC) ReleaseDC(0, DC) end end;
Merci pour le coup de main,
---
* : http://forum.lazarus.freepascal.org/...?topic=20193.0
Partager