C'est un petit programme qui liste alphabétiquement dans une listbox (lstPrinc) toutes les polices installées sur le système, puis montre un exemple de chaque police dans un Richtextbox (rtfPrinc). Ce programme permet aussi d'imprimer le richtextbox. Lorsqu'on clique sur la listbox, la police et l'exemple sont seléctionnés dans le richtextbox...
Il y aussi un bouton (cmdPrint) pour imprimer le richtextbox et un autre (cmdQuit) pour quitter...
Dans le zip, les sources incluent une autre Form pendant le chargement avec une Progressbar parce que le chargement est plutôt long...
Source / Exemple :
Private Sub cmdPrint_Click()
'Imprime le contenu du Richtextbox
rtfPrinc.SelStart = 0
rtfPrinc.SelLength = Len(rtfPrinc.Text)
rtfPrinc.SelPrint Printer.hDC 'Envoie le texte du Richtextbox à l'imprimante
Printer.EndDoc 'Ferme la session d'impression
End Sub
Private Sub cmdQuit_Click()
'Ben ça quitte...
End
End Sub
Private Sub Form_Load()
'Définition des variables
Dim I As Integer
Dim reponse As Integer
Dim dejalu As Integer
Dim chaine As String
'Centre la feuille
frmPrinc.Left = (Screen.Width - frmPrinc.Width) / 2
frmPrinc.Top = (Screen.Height - frmPrinc.Height) / 2
'Affiche la liste des polices dans le listebox
For I = 0 To Screen.FontCount - 1
lstPrinc.AddItem (Screen.Fonts(I))
Next I
'Affiche le nom de chaque police et une chaine de caractère
For I = 0 To lstPrinc.ListCount - 1
chaine = lstPrinc.List(I) & vbCrLf & "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqestuvwxyz 0123456879" & vbCrLf & vbCrLf
rtfPrinc.Text = rtfPrinc.Text + chaine
Next I
'Change la police de chaque groupe "Nom de police + chaine"
'Dejalu représente le nombre de caractères déjà lus et permet de placer le selStart
dejalu = 0
For I = 0 To lstPrinc.ListCount - 1
chaine = lstPrinc.List(I) & vbCrLf & "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqestuvwxyz 0123456879" & vbCrLf & vbCrLf
rtfPrinc.SelStart = dejalu 'Place le curseur pour la selection du texte
rtfPrinc.SelLength = Len(chaine) 'Selectionne le groupe "Nom de police + chaine"
rtfPrinc.SelFontName = lstPrinc.List(I) 'Change la police
dejalu = dejalu + Len(chaine) 'Avance le dejalu pour pouvoir reprendre ensuite
Next I
rtfPrinc.SelStart = 0 'Replace le curseur au début
End Sub
Private Sub lstPrinc_Click()
'lorsque on clique sur le listbox, le groupe "Nom de police + chaine" est selectionné dans le richtextbox
'Pour se faire, j'utilise la même méthode que lors du changement de police dans Form_load
dejalu = 0
For I = 0 To lstPrinc.ListIndex - 1
chaine = lstPrinc.List(I) & vbCrLf & "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqestuvwxyz 0123456879" & vbCrLf & vbCrLf
depart = dejalu 'Place le curseur pour la selection du texte
longueur = Len(chaine) 'Selectionne le groupe "Nom de police + chaine"
dejalu = dejalu + Len(chaine) 'Avance le dejalu pour pouvoir reprendre ensuite
Next I
chaine = lstPrinc.List(I) & vbCrLf & "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqestuvwxyz 0123456879" & vbCrLf & vbCrLf
rtfPrinc.SelStart = dejalu 'Place le curseur pour la selection du texte
rtfPrinc.SelLength = Len(chaine) 'Selectionne le groupe "Nom de police + chaine"
End Sub
Conclusion :
Attention la listbox doit avoir la propriété sorted = true et le richtextbox hideselection = true
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.