Bitmap et brushes

Soyez le premier à donner votre avis sur cette source.

Vue 10 392 fois - Téléchargée 366 fois

Description

Et ben voila. Je suis en train de migrer en .Net et j'ai découvert un truc sensationnel (je sais, il m'en faut peu :D). On peut texturer des formes géométriques avec un bitmap (ça, ça doit exister en VB6), mais on peut texturer du TEXTE avec un bitmap. Je trouve ça génial. Alors j'ai repris mon cours, j'ai amélioré un peu l'exo et je l'ai commenté à fond les ballons pour que vous puissiez vous amuser aussi. J'espère que cela vous plaira, même si c'est un peu gadget :D:D

Source / Exemple :


'   on importe les classes de dessins sur texte
Imports System.Drawing.Text

Public Class Form1
    Inherits System.Windows.Forms.Form

#Region " Code généré par le Concepteur Windows Form "
#End Region
    '   on doit dénifir un objet de type graphic pour pouvoir dessiner et écrire sur la form
    Dim G As Graphics
    '   on déclare un bitmap qui recevra le bitmap de texturage
    Dim bitmap As bitmap
    '   on déclare une brosse de type TextureBrush
    Dim brush As TextureBrush

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        ' on définit un tableau qui prendra les noms des fonts et un objet de type fontfamily pour lister les polices de la bécane
        Dim FontList As New Collections.ArrayList(10)
        Dim Fonts As FontFamily
        '   pour chaque police de l'objet de type "FontFamily", on ajoute le nom dans le tableau de police
        For Each Fonts In FontFamily.Families
            FontList.Add(Fonts.Name)
        Next

        ' on crée l'objet Graphic déclaré plus haut pour pouvoir l'utiliser
        G = Me.CreateGraphics
        ' on relie la source du combobox cbFont à la liste de police récupérée
        cbFont.DataSource = FontList
    End Sub

    Private Sub f_dessine_text()
        '   Le .net comprends maintenant une gestion des erreurs et des exceptions de même type que les "vrais" langages orientés objets
        '   il existe donc maintenant une procédure Try .... catch qui essaye de faire tourner une routine contenue dans le bloc "try" (essaie)
        '   et si une exception se produit, le prog se débranche de la procédure pour aller au bloc "Catch" (attrape)
        '   dans ce bloc, on définit les instructions à suivre selon la nature de l'évenement associé à Catch
        Try
            '   on efface la form à l'aide de l'objet de type "Graphics", par la méthode .Clear(color).
            '   comme couleur, on prends simplement la couleur de fond de la form me.backcolor
            G.Clear(Me.BackColor)
            '   on appelle la méthode de dessin pour les textes DrawString (littéralement Dessine un texte pour les non anglophiles)
            '   cette méthode prends comme argument (dans l'ordre) : 
            '       1°) le texte à afficher (ici "TEST")
            '       2°) la police à utiliser. Ici, no crée une nouvelle police (new Font()) avec comme argument : le nom de la police
            '           (contenue dans le combobx, soit cbFont.text), la taille (120) et un type FontStyle. vous remarquerez qu'il existe
            '           13 types de méthode Font() avec des signatures différentes
            '       3°) la brosse à utiliser (ici notre brosse TextureBrush)
            '       4°) le coin supérieur gauche depuis lequel on va dessiner
            G.DrawString("TEST", New Font(cbFont.Text, 200, FontStyle.Bold), brush, New PointF(40, 20))
            '   on chope les exceptions (notamment si aucune brush n'est définie, cela génére une erreur, et on ne fais rien :D
        Catch ex As Exception
        End Try

    End Sub

    Private Sub btLoadBitmap_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btLoadBitmap.Click
        '   il faut créer un délégué GetThumbNailImageAbort pour pouvoir utiliser les thumbnails (voir MSDN pour plus d'info)
        Dim delegue As Image.GetThumbnailImageAbort
        On Error GoTo suite
        '   Classique, comme dans VB6, sauf que l'objet CommonDialog est décliné en plusieurs entités OpenFileDialog, ColorDialog, etc.
        OpenFileDialog.Filter = "*.bmp (bitmap) | *.bmp"
        OpenFileDialog.InitialDirectory = "c:\"
        OpenFileDialog.Title = "Choisissez le bitmap de texturage"
        OpenFileDialog.ShowDialog()

        '   La partie intéressante :D. On charge le bitmap avec la méthode FromFile
        bitmap = bitmap.FromFile(OpenFileDialog.FileName)
        '   on écrit simplement dans le Label lblBitmap le chemin du bitmap chargé
        lblBitmap.Text = OpenFileDialog.FileName
        '   et on définit le bitmap de texture de la brosse Brush
        brush = New TextureBrush(bitmap)
        '   on charge la preview de l'image dans la picturebox
        PictureBox1.Image = bitmap.GetThumbnailImage(70, 70, delegue, IntPtr.Zero)
        f_dessine_text()
suite:
    End Sub

    Private Sub btQuit_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btQuit.Click
        End
    End Sub

    Private Sub cbFont_SelectedIndexChanged(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles cbFont.SelectedIndexChanged
        '   on appelle la sub de dessin tout simplement
        f_dessine_text()
    End Sub
End Class

Conclusion :


Voila, ça vous a plu???? ; ))

Codes Sources

A voir également

Ajouter un commentaire

Commentaires

cs_radada
Messages postés
488
Date d'inscription
lundi 15 septembre 2003
Statut
Membre
Dernière intervention
21 avril 2009
-
Merci Renfield, t un killer comme d'hab ; ))
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
57 -
j'ai posté un pseudo portage de ta source :

http://www.vbfrance.com/code.aspx?ID=17777


j'espere que ca te conviendra....
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
57 -
'#A Placer dans un module.... (facultatif !)

Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long

Private Type SIZE
cw As Long
ch As Long
End Type

Private Const PATINVERT = &H5A0049

Public Function DCTextWidth(hdc As Long, Str As String) As Long
Dim SIZE As SIZE
GetTextExtentPoint32 hdc, Str, Len(Str), SIZE
DCTextWidth = SIZE.cw
End Function

Public Function DCTextHeight(hdc As Long, Str As String) As Long
Dim SIZE As SIZE
GetTextExtentPoint32 hdc, Str, Len(Str), SIZE
DCTextHeight = SIZE.ch
End Function

Public Function DrawBrushedText(ByVal hdc As Long, ByVal X As Single, ByVal Y As Single, ByVal Str As String, ByVal hBrush As Long) As Boolean
Dim oldBrush As Long
oldBrush = SelectObject(hdc, hBrush)

Dim Width As Long: Width = DCTextWidth(hdc, Str)
Dim Height As Long: Height = DCTextHeight(hdc, Str)

PatBlt hdc, X, Y, Width, Height, PATINVERT
TextOut hdc, X, Y, Str, Len(Str)
DrawBrushedText = PatBlt(hdc, X, Y, Width, Height, PATINVERT)

SelectObject hdc, oldBrush
End Function


'# A Placer dans une Form possedant une pictureBox "Picture1", avec une image !!!
Private Sub Form_Load()
Dim hBrush As Long
hBrush = CreatePatternBrush(Picture1.Image)

Me.FontName = "Arial"
Me.FontSize = 72
Me.AutoRedraw = True
Me.Width = 8500
Me.Height = 3000

DrawBrushedText Me.hdc, 30, 30, "By Renfield", hBrush
DeleteObject hBrush
End Sub
Renfield
Messages postés
17280
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
21 juillet 2019
57 -
C'est une solution aussi..... je ne comptait pas faire comme ca.....
cs_EBArtSoft
Messages postés
4531
Date d'inscription
dimanche 29 septembre 2002
Statut
Modérateur
Dernière intervention
22 avril 2019
5 -
FORMIDABLE... lol

niarf ;-P

Je pense tres cher Renfield que ça
donne qlq chose comme ce qui suit :

Private Sub Command1_Click()
Dim x&, y&, i&, j&, t$
Cls
t = "EBArtSoft@"
x = Picture1.Width
y = Picture1.Height
BeginPath Me.hdc
TextOut Me.hdc, 0, 0, t, Len(t)
EndPath Me.hdc
SelectClipPath Me.hdc, RGN_COPY
For i = 0 To Me.TextWidth(t) Step x
For j = 0 To Me.TextHeight(t) Step y
BitBlt Me.hdc, i * x, j * y, x, y, Picture1.hdc, 0, 0, vbSrcCopy
Next
Next
End Sub

Merci VB6 ... (de rien répond t-il !)

@+

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.