Dessiner sur un control (RichTextBox)

**excalybur** · 17/02/2024, 23h46

Bonjour,

Le problème est dans le titre. Dans un RichTextBox lorsque l'on pointe un caractère pour le sélectionner deux cas se présentent :
a) Si le pointeur est sur la partie gauche du caractère, c'est ce caractère qui sera sélectionné
b) Si le pointeur est sur la partie droite du caractère, c'est le caractère voisin à sa droite qui est sélectionné !

Mon but remplacer le pointeur par un carrée rouge autour du caractère sélectionné par le clic de la souris

Exemple : Ouvrir une Form avec 2 Richtextboxet un bouton.

Enregistrer ce programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
Imports System.Threading
 
Public Class Form1
 
    'RichTextBox2.text est le texte destination en cours d'écriture
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
 
        RichTextBox1.Text = ""
 
        'lit 8 caractères hexadécimal du tableau unicode
        For n = &H2660 To &H2667 ' 54 To &H265F
            RichTextBox1.Text += ChrW(n)
        Next n
 
        'dessine trois lignes en biais
        Dim gdi As Graphics = RichTextBox1.CreateGraphics()
        gdi.DrawLine(Pens.Black, New Point(0, 0), New Point(432, 48))
        gdi.DrawLine(Pens.Black, New Point(0, 10), New Point(432, 58))
        gdi.DrawLine(Pens.Black, New Point(0, 20), New Point(432, 68))
 
        'dessine un rectangle rouge
        Dim RedPen As New Pen(Color.Red, 3)
        Dim rect As New Rectangle(0, 0, 100, 100)
        gdi.DrawRectangle(RedPen, rect)
        gdi.Dispose()
 
    End Sub
 
    Private Sub RichTextBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseDown
 
        'Recherche position de la souris
        Dim box = DirectCast(sender, RichTextBox)
 
        'sélectionne le caractère qui reçoit le click
        Dim SelectCharacter = box.GetCharFromPosition(e.Location)
 
'replace le curseur en fin de ligne
SendKeys.Send("{HOME}+{END}")
 
         RichTextBox2.Focus()
 
        'Ajoute le caractères au RichTextBox2
        RichTextBox2.Text += SelectCharacter
 
    End Sub
    Private Sub RichTextBox2_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles RichTextBox2.KeyDown
 
        'place le curseur à la fin de la ligne de texte
        RichTextBox2.SelectionStart = RichTextBox2.TextLength
 
    End Sub
 
'Private Sub RichTextBox1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseMove
'    'routine à créer en prévision de la visualisation avec un carrée rouge du caractère survolé
'    RichTextBox2.Focus()
'End Sub
 
 
End Class

On remarque immédiatement 2 problèmes distincts,mais lié :

1/ Le décalage d'un demi caractère vers la gauche de la sélection de la souris expliquée plus haut

2/ Les graphiques dessinés sur le Control sont partiellement effacés par la présence des caractères or qu'il ne devraient pas !

Copie écran du résultat :

Nom : Capture d’écran 2024-02-17 224524.jpg
Affichages : 323
Taille : 20,8 Ko

Nom : Capture d’écran 2024-02-17 224524.jpg
Affichages : 323
Taille : 20,8 Ko

Là je ne trouve pas la solution à ses deux problèmes.

Pouvez-vous m'aider ?

En vous remerciant par avance.

**excalybur** · 18/02/2024, 10h49

Le problème semble bien lié au Control RichTextBox.

Après avoir passé de longues heures dans la nuit y compris sur les sites US, je n'ai pas trouvé le moyen de modifier la position horizontale du pointeur d'un demi caractère vers la droite. Car le problème est bien un décalage d'un demi caractère. En VB6 il y avait beaucoup plus de possibilités. Mais on est en vb.net framework 4.81 ou 6.0
Il y a surement un moyen pour détourner la difficulté en créant un offset du pointeur mais comment ?

Sur le net il y a beaucoup d'articles avec de nombreuses confusion entre caret et mouse pointer. Il y a peut être la solution mais avec d'autres mots.

Si vous avez une idée ? Je sèche!

a+

**excalybur** · 18/02/2024, 22h15

Bonsoir,

J'ai trouvé la solution pour dessiner sur les caractères d'un RichTextBox. Aujourd'hui j'ai fait questions-réponses !

Tout n'est que hiérarchie et ordre pour que cela fonctionne.

Voici un exemple qui fonctionne avec un rectangle rouge sur le caractère sélectionné :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Imports System.Threading
 
Public Class Form1
 
    'RichTextBox2.text est le texte destination en cours d'écriture
 
    Public Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.ActiveControl = Nothing 'aucun control a le  focus
        RichTextBox1.Font = New Font("ARIAL", 26, FontStyle.Regular)
        RichTextBox1.Width = 279
        RichTextBox1.Height = 100
        RichTextBox2.Font = New Font("ARIAL", 16, FontStyle.Regular)
        Thread.Sleep(100)
    End Sub
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
 
        RichTextBox1.Text = ""
 
        'lit 8 caractères hexadécimal du tableau unicode
        For n = &H2660 To &H2667 
            RichTextBox1.Text += ChrW(n)
        Next n
    End Sub
 
    Private Sub RichTextBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseDown
 
        Dim gdi As Graphics = RichTextBox1.CreateGraphics()
 
        'efface tous les rectangles rouge
        For n = 0 To 7
            Dim WhitePen As New Pen(Color.White, 3)
            Dim rectVide As New Rectangle(1 + n * 24, 0, 24, 52)
            gdi.DrawRectangle(WhitePen, rectVide)
        Next n
 
        'Recherche position de la souris
        Dim box = DirectCast(sender, RichTextBox)
        Dim index = box.GetCharIndexFromPosition(e.Location)
 
        'sélectionne le caractère qui reçoit le click
        Dim SelectCharacter = box.GetCharFromPosition(e.Location)
        Dim SelectPosition = box.GetPositionFromCharIndex(index)
 
        'place le curseur en fin de ligne de texte
        RichTextBox1.SelectionStart = RichTextBox1.TextLength
        RichTextBox2.Focus()
 
        'Ajoute le caractères au RichTextBox2
        RichTextBox2.Text += SelectCharacter
 
        'affiche un rectangle rouge
        Dim RedPen As New Pen(Color.Red, 3)
        Dim rect As New Rectangle(1 + index * 24, 0, 24, 52)
        gdi.DrawRectangle(RedPen, rect)
    End Sub
    Private Sub RichTextBox2_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles RichTextBox2.KeyDown
 
        'place le curseur à la fin de la ligne de texte
        RichTextBox2.SelectionStart = RichTextBox2.TextLength
    End Sub
End Class

Nom : Capture d’écran 2024-02-18 211645.jpg
Affichages : 266
Taille : 9,8 Ko

Je modifie le titre de ma demande qui est résolue et je cré un autre sujet pour le deuxième problème du décalage (offset?) d'un demi caractère du pointeur en mode sélection.

a+

**excalybur** · 18/02/2024, 22h50

Bonus :

Pour avoir un carrée rouge qui suis le mouvement du curseur de la souris sur les caractères ajouter ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
 Private Sub RichTextBox1_MousemMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseMove
 
     Dim gdi As Graphics = RichTextBox1.CreateGraphics()
     Dim box = DirectCast(sender, RichTextBox)
     Dim index = box.GetCharIndexFromPosition(e.Location)
 
     'affiche un rectangle rouge
     Dim RedPen As New Pen(Color.Red, 3)
     Dim rect As New Rectangle(1 + Index * 24, 0, 24, 52)
     gdi.DrawRectangle(RedPen, rect)
 
     'tempo
     Thread.Sleep(70)
 
     'efface le rectangle rouge
     Dim White2Pen As New Pen(Color.White, 3)
     Dim rect2Vide As New Rectangle(1 + Index * 24, 0, 24, 52)
     gdi.DrawRectangle(White2Pen, rect2Vide)
 
 End Sub

**excalybur** · 19/02/2024, 11h19

Epilogue !

Le programme ci-dessous résous le problème du décalage du curseur de la souris par le dessin d'un rectangle rouge autour du caractère capturé! Donc même si décalé d'un demi caractère l'opérateur rattrape l'erreur visuellement en déplaçant la souris !

Le seul bémol le carré rouge clignote un peu si l'on déplace la souris sur le caractère. L'ajout d'une tempo de 20ms n'est pas suffisante. Si on passe à 200ms c'est la saisie du texte sur RichTextBox2 qui traine... Si quelqu'un a une meilleur solution je suis preneur. Merci d'avance.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
Imports System.Threading
 
Public Class Form1
 
    'RichTextBox2.text est le texte destination en cours d'écriture
 
    Public Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        Me.ActiveControl = Nothing 'aucun control a le  focus
        RichTextBox1.Font = New Font("ARIAL", 26, FontStyle.Regular)
        RichTextBox1.Width = 444
        RichTextBox1.Height = 56
        RichTextBox2.Font = New Font("ARIAL", 16, FontStyle.Regular)
        Thread.Sleep(100)
 
    End Sub
 
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
 
        RichTextBox1.Text = ""
 
        'lit 8 caractères hexadécimal du tableau unicode
        For n = &H2660 To &H266F 
            RichTextBox1.Text += ChrW(n)
        Next n
    End Sub
 
    Public Sub RichTextBox1_MousemMove(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseMove
 
        Dim gdi As Graphics = RichTextBox1.CreateGraphics()
        Dim box = DirectCast(sender, RichTextBox)
        Dim index = box.GetCharIndexFromPosition(e.Location)
 
        'efface tous les rectangles rouge
        For n = 0 To 7
            Dim WhitePen As New Pen(Color.White, 3)
            Dim rectVide As New Rectangle(1 + n * 24, 0, 24, 52)
            gdi.DrawRectangle(WhitePen, rectVide)
        Next n
 
        'affiche un rectangle rouge
        Dim RedPen As New Pen(Color.Red, 3)
        Dim rect As New Rectangle(1 + index * 24, 0, 24, 52)
        gdi.DrawRectangle(RedPen, rect)
 
        ''tempo pour limiter le scintillement lorsque mous move sur le caractère 
        Thread.Sleep(20)
 
    End Sub
 
    Public Sub RichTextBox1_MouseLeave(sender As Object, e As MouseEventArgs)
        Dim gdi As Graphics = RichTextBox1.CreateGraphics()
        Dim box = DirectCast(sender, RichTextBox)
        Dim index = box.GetCharIndexFromPosition(e.Location)
 
        'efface un rectangle rouge
        Dim RedPen As New Pen(Color.White, 3)
        Dim rect As New Rectangle(1 + index * 24, 0, 24, 52)
        gdi.DrawRectangle(RedPen, rect)
 
    End Sub
 
    Private Sub RichTextBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseDown
 
        Dim gdi As Graphics = RichTextBox1.CreateGraphics()
 
        'efface tous les rectangles rouge
        For n = 0 To 7
            Dim WhitePen As New Pen(Color.White, 3)
            Dim rectVide As New Rectangle(1 + n * 24, 0, 24, 52)
            gdi.DrawRectangle(WhitePen, rectVide)
        Next n
 
        'Recherche position de la souris
        Dim box = DirectCast(sender, RichTextBox)
        Dim index = box.GetCharIndexFromPosition(e.Location)
 
        'sélectionne le caractère qui reçoit le click
        Dim SelectCharacter = box.GetCharFromPosition(e.Location)
        Dim SelectPosition = box.GetPositionFromCharIndex(index)
 
        'place le curseur en fin de ligne de texte
        RichTextBox1.SelectionStart = RichTextBox1.TextLength
        RichTextBox2.Focus()
 
        'Ajoute le caractères au RichTextBox2
        RichTextBox2.Text += SelectCharacter
 
    End Sub
    Private Sub RichTextBox2_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles RichTextBox2.KeyDown
 
        'place le curseur à la fin de la ligne de texte
        RichTextBox2.SelectionStart = RichTextBox2.TextLength
    End Sub
End Class