Dessiner sur un control (RichTextBox)

Version imprimable

1 pièce(s) jointe(s)

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:

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 :

Pièce jointe 651013

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

Pouvez-vous m'aider ?

En vous remerciant par avance.

18/02/2024, 09h49
excalybur

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+

1 pièce(s) jointe(s)

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:

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

Pièce jointe 651033

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+

Bonus :

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

Code:

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

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:

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

Vos commentaires sont les bienvenues.

A+

19/02/2024, 13h43
m4k-Hurrican

Bonjour,

Est-ce que la solution ne serait pas un truc de ce genre là : https://www.experts-exchange.com/que...x-control.html

Cet article très intéressant permet de cacher le curseur. Il faut le réactualiser en c# vu l'âge (2006). Je vais l'étudier entièrement par curiosité pour une autre application auquel je pense. Merci pour l'info.

Entre temps j'ai perfectionné le micro programme et cela donne l'effet escompté, je vous invite à l'essayer.

Du coup pour le tempo j'ai mis 130ms et le clignotement des glyphes de caractères lorsque la souris les survole est acceptable sans gêner le temps de capture.

L'écriture de texte au clavier et ainsi que celle des glyphes (capturé avec la souris) sur RichTextBox2 devient intuitive et les corrections et déplacements (touches flèches) du curseur sont pris en charge, etc! Ne pas oublier de cliquer la première fois avec la souris sur RichTextBox2 à l'endroit ou vous voulez commencer à écrire/corriger/amender.

Il suffit de modifier les 3 subs suivants ainsi:

Code:

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
 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 mouse move sur le caractère 
     Thread.Sleep(130)
 
 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)
     Dim CaretInitPosition = RichTextBoxSol.SelectionStart
     RichTextBox2.Focus()
 
     'replace le curseur là où il était après que le focus l'ai réinitialisé à zéro
     RichTextBox2.SelectionStart = CaretInitPosition
 
     'Ajoute le caractère saisie au RichTextBox2
     Dim Maxlenght = RichTextBox2.TextLength
     Dim start = LSet(RichTextBox2.Text, CaretInitPosition)
     Dim finish As String = RichTextBox2.Text.Substring(CaretInitPosition, Maxlenght - CaretInitPosition)
 
     'final text
     RichTextBox2.Text = start + SelectCharacter + finish
 
     'place le curseur à la suite du drop
     RichTextBox2.SelectionStart = CaretInitPosition + 1
 End Sub

A+