Choisir une police ?

Version imprimable

26/11/2009, 17h28
martinus45

Choisir une police ?

Bonjour,

Est-ce que quelqu'un connaitrait un équivalent de ce composant, qui permet de choisir une police dans une ComboBox remplie par toutes les polices disponibles.

Merci.

Code:

ComboBox1.Items.Assign(Screen.Fonts);

ensuite avec la propriété Style de la combobox (csOwnerDrawFixed ou csOwnerDrawVariable) on peu déssiner la police dans la combobox grace à l'evenement OnDrawItem.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
procedure TForm1.ComboBox1DrawItem(Control: TWinControl; Index: Integer; ARect: TRect; State: TOwnerDrawState);
var CBX : TComboBox;
    FNM : string;
begin
  CBX := (control as TComboBox);
  FNM := CBX.Items[index];
 
  CBX.Canvas.FillRect(ARect);
  CBX.Canvas.Font.Name := FNM;
  CBX.Canvas.TextRect( ARect,
                       ARect.Left + 2,
                       ARect.Top + 2,
                       FNM);
end;
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  ComboBox1.Style := csOwnerDrawVariable;
  ComboBox1.ItemHeight := 21;
  ComboBox1.Items.Assign(Screen.Fonts);
end;

26/11/2009, 20h37
martinus45

Merci docteur !
Je vais bien vite faire un composant qui fasse cela tout seul...
27/11/2009, 04h34
Dr.Who

bon code alors ;)

n'oublie pas d'intercepter les messages WM_FONTCHANGE dans ton composant pour qu'il se "rafraichisse" automatiquement quand des polices sont ajouté ou supprimé du système.
27/11/2009, 12h40
martinus45

C'est possible sous Linux, ça ?
27/11/2009, 13h35
chris37

Dans l'ensemble, tous les messages fonctionnent aussi sous nux :P
28/11/2009, 04h09
Dr.Who

mmm en fait, dans Delphi, Screen.Fonts appel la méthode privée GetFont qui remplie à la volée la liste...
06/01/2010, 17h27
martinus45
Bonjour,

J'ai juste un problème, qui est que l'assignation d'une police (valide, prise dans la liste) à un Canvas ne semble pas avoir d'effet sous Lazarus-0.9.28-2 / Linux.

Par exemple, pour reprendre la suggestion de Dr Who (mais aussi sur un essai plus simple) :
Code:

1 2 3 Canvas.Font.Name := FNM; Canvas.Invalidate; //provoquant re-paint
Ca marche bien en assignant la même police à un TEdit, et aussi sous Delphi 2007. Je ne peux pas essayer avec Lazarus/Windows pour l'instant car le PC où il est installé est en carafe.

Ca marche, chez vous ? Vous avez une idée ?

Merci.