Convertir du texte en points de croix

Question

Bonjour,

Je travaille sur une application de broderie qui permet de transformer du texte en points de croix, je m'explique :

J'ai un champ texte txtTexte dans lequel je saisis la chaine de caractères qui va être tranformée. Je la transfère ensuite dans une objet picturebox Picture1 au moyen de l'api textout. Enfin je balaye un a un les pixels (avec getpixel) de mon Picture1 et je teste pour chacun s'il est noir ou blanc. S'il est noir je met une croix dans mon champ Text1 destination, sinon un blanc.
Au final, j'obtient un TextBox Text1 contenant des blancs ou des croix

Exemple :

pour la lettre o, le résultat sera :

 xxx
x   x
x   x
x   x
 xxx

Voici mon code :

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 GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long

Private Sub cmdOk_Click()
    Me.Picture1.Font.Name = Me.txtTexte.Font.Name
    Me.Picture1.Font.Size = Me.txtTexte.Font.Size
    Me.Picture1.FontBold = Me.txtTexte.FontBold
    Me.Picture1.FontItalic = Me.txtTexte.FontItalic
    
    TextOut Me.Picture1.hdc, 0, 0, Me.txtTexte, Len(Me.txtTexte)
    For i = 0 To Me.Picture1.Height / 15
        For j = 0 To Me.Picture1.Width / 15
            couleur = GetPixel(Me.Picture1.hdc, j, i)
            If couleur > 0 Then
                Me.Text1 = Me.Text1 & " "
            Else
                Me.Text1 = Me.Text1 & "x"
            End If
        Next j
        Me.Text1 = Me.Text1 & vbCrLf
    Next i
End Sub

Seul problème : ça me balaye mon Picture1 de manière bizarre

Si quelqu'un a une idée la dessus ou connait un code similaire au mien ...

Merci d'avance

Nicolas

cs_nicolasheurtevin · Answer

Pour le résulat du o, comprenez qu'il y a des espaces, mais malheureusement ils ont été zappés à l'enregistrement du message

mettons que les blancs soit des "_"

le o donnera :

_xxx_
x___x
x___x
x___x
_xxx_

Nicolas

Renfield · Answer

Utilises une police a Chasse Fixe Comme une Courier, par exemple....

j'ai amélioré ton algo en utilisant TextWidth & TextHeight, plutôt que de tester chaque pixel....


Private Sub cmdOk_Click()
    TextOut Me.Picture1.hdc, 0, 0, Me.txtTexte, Len(Me.txtTexte)
    For i = 0 To Picture1.TextHeight(txtTexte)
        For j = 0 To Picture1.TextWidth(txtTexte)
            If GetPixel(Me.Picture1.hdc, j, i) > 0 Then
                Me.Text1 = Me.Text1 & " "
            Else
                Me.Text1 = Me.Text1 & "x"
            End If
        Next j
        Me.Text1 = Me.Text1 & vbCrLf
        DoEvents
    Next i
End Sub


By Renfield

[mailto:thomas_reynald@msn.com thomas_reynald@msn.com]

Aucune touche n'a ete blessee lors de la saisie de ce texte.......... ;)

Renfield · Answer

Une optimisation du code dirait même :


Private Sub cmdOk_Click()
    Dim Buffer As String
    TextOut Me.Picture1.hdc, 0, 0, Me.txtTexte, Len(Me.txtTexte)
    
    For i = 0 To Picture1.TextHeight(txtTexte)
        For j = 0 To Picture1.TextWidth(txtTexte)
            Buffer = Buffer & IIf(GetPixel(Me.Picture1.hdc, j, i) > 0, " ", "x")
        Next j
        Buffer = Buffer & vbCrLf
    Next i
    Text1.Text = Buffer
End Sub


En effet, l'utilisation d'une variable intermediaire, accelere la chose : en utilisant Text1.Text, le contenu du controle est mis a jour sans arret, et comme on le fait pour chaque pixel....... c'est prohibitif !

On aurait pu faire ca en recuperant un tableau des bits de l'image.... (GetDIBBits, je crois...)  ainsi, tu as quelque chose de plus maniable....

Bonne continuation..

By Renfield

[mailto:thomas_reynald@msn.com thomas_reynald@msn.com]

Aucune touche n'a ete blessee lors de la saisie de ce texte.......... ;)

cs_nicolasheurtevin · Answer

Dis donc, nickel ton truc avec le buffer, j'y avais pas pensé !!!
Résultat : le traitement est 20 fois plus rapide, montre en main !!!

Merci encore !!!

Nicolas

Renfield · Answer

Tant mieux ;-)

Ca fonctionne comme tu veux maintenant que tu as mis une police a chasse fixe ?

By Renfield

[mailto:thomas_reynald@msn.com thomas_reynald@msn.com]

Aucune touche n'a ete blessee lors de la saisie de ce texte.......... ;)

Convertir du texte en points de croix

5 réponses

Discussions similaires