Police en ressource

Soyez le premier à donner votre avis sur cette source.

Snippet vu 6 214 fois - Téléchargée 7 fois

Contenu du snippet

Imports System
Imports System.Drawing
''' <summary>
''' merci à PsychoCoder car le code est de lui
''' http://www.dreamincode.net/forums/index.php?showuser=40184
''' http://www.dreamincode.net/code/snippet1602.htm
''' 
''' </summary>
''' <remarks></remarks>
Public Class Form1
    Private Shared PFC As Drawing.Text.PrivateFontCollection
    Private Shared NewFont_FF As Drawing.FontFamily
    ''' <summary>
    ''' Function to return a new font based on the font file passed to it
    ''' </summary>
    ''' <param name="name">Path to the new font file</param>
    ''' <param name="style">The FontStyle of the new font</param>
    ''' <param name="size">T size of the new font</param>
    ''' <returns>A new font</returns>
    ''' <remarks></remarks>
    Private Function CreateFont(ByVal name As String, ByVal style As Drawing.FontStyle, ByVal size As Single, ByVal unit As Drawing.GraphicsUnit) As Drawing.Font
        'Create a new font collection
        PFC = New Drawing.Text.PrivateFontCollection
        'Add the font file to the new font
        '"name" is the qualified path to your font file
        PFC.AddFontFile(name)
        'Retrieve your new font
        NewFont_FF = PFC.Families(0)
        Return New Drawing.Font(NewFont_FF, size, style, unit)


    End Function
    ''' <summary>
    ''' faut pas oublier de mettre un fichier font en ressource
    ''' ici c'est My.Resources._80db ( 80db.ttf )
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        'Example Usage
        Dim apath As String = Application.StartupPath
        IO.File.WriteAllBytes(apath & "\NewFont.ttf", My.Resources._80db)
        Dim fontfile As String = (apath & "\NewFont.ttf")
        Label1.Font = CreateFont(fontfile, FontStyle.Regular, 12, GraphicsUnit.Point)
        Label1.Text = "yes it work"
    End Sub
End Class


Compatibilité : VB 2005, VB 2008

A voir également

Ajouter un commentaire

Commentaires

CoDubai
Messages postés
81
Date d'inscription
vendredi 19 septembre 2014
Statut
Membre
Dernière intervention
15 octobre 2014
-
J'essaye de le mettre dans mon lexique.
Merci gillardg

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.