Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Développement Développement Visual Basic Conversion de texte en pixels

Conversion de texte en pixels

1 réponse
Avatar
Nicolas
Bonjour,

Je travaille sur une application de broderie qui permet de=20
transformer du texte en points de croix, je m'explique :

J'ai un champ texte txtTexte dans lequel je saisis la=20
chaine de caract=E8res qui va =EAtre tranform=E9e. Je la=20
transf=E8re ensuite dans une objet picturebox Picture1 au=20
moyen de l'api textout. Enfin je balaye un a un les pixels=20
(avec getpixel) de mon Picture1 et je teste pour chacun=20
s'il est noir ou blanc. S'il est noir je met une croix=20
dans mon champ Text1 destination, sinon un blanc.
Au final, j'obtient un TextBox Text1 contenant des blancs=20
ou des croix

Exemple :

pour la lettre o, le r=E9sultat sera :

xxx
x x
x x
x x
xxx

Voici mon code :

Private Declare Function TextOut Lib "gdi32"=20
Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long,=20
ByVal y As Long, ByVal lpString As String, ByVal nCount As=20
Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc=20
As Long, ByVal x As Long, ByVal y As Long) As Long

Private Sub cmdOk_Click()
Me.Picture1.Font.Name =3D Me.txtTexte.Font.Name
Me.Picture1.Font.Size =3D Me.txtTexte.Font.Size
Me.Picture1.FontBold =3D Me.txtTexte.FontBold
Me.Picture1.FontItalic =3D Me.txtTexte.FontItalic
=20
TextOut Me.Picture1.hdc, 0, 0, Me.txtTexte, Len
(Me.txtTexte)
For i =3D 0 To Me.Picture1.Height / 15
For j =3D 0 To Me.Picture1.Width / 15
couleur =3D GetPixel(Me.Picture1.hdc, j, i)
If couleur > 0 Then
Me.Text1 =3D Me.Text1 & " "
Else
Me.Text1 =3D Me.Text1 & "x"
End If
Next j
Me.Text1 =3D Me.Text1 & vbCrLf
Next i
End Sub

Seul probl=E8me : =E7a me balaye mon Picture1 de mani=E8re=20
bizarre

Si quelqu'un a une id=E9e la dessus ou connait un code=20
similaire au mien ...

Merci d'avance

Nicolas
Signaler un problème avec ce contenu

1 réponse

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
Claude Azoulai
Voici du code qui fonctionne

Private Sub cmdOk_Click()
'Je n'ai pas besoin d'utiliser les API, la fonction
Point et la fonction Print sont suffisantes
'La propriété de Text1.MultiLine doit être vrai
'La fonte de Picture1 doit être une fonte non
proportionnelle, par exemple Courrier,
'pour avoir un bon alignement des "x"
Dim couleur As Long, Texte As String
Picture1.ScaleMode = 3 '(Pixels)
Picture1.Font.Name = txtTexte.Font.Name
Picture1.Font.Size = txtTexte.Font.Size
Picture1.FontBold = txtTexte.FontBold
Picture1.FontItalic = txtTexte.FontItalic

Texte = txtTexte
Picture1.Print Texte

For i = 0 To Picture1.TextHeight(Texte) - 1
For j = 0 To Picture1.TextWidth(Texte) - 1
couleur = Picture1.Point(j, i)
If couleur > 0 Then
Text1 = Text1 & " "
Else
Text1 = Text1 & "x"
End If
Next j
Text1 = Text1 & vbCrLf
Next i
End Sub


-----Message d'origine-----
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
.