Listeur de polices...

Description

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

Codes Sources

A voir également

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.