Ben ...
Plus facile (je m'en veux de ne pas y avoir immédiatement pensé) que prévu, ce petit rajout protectionniste (pas toucher aux prés carrés, hein). ===>>
Voilà donc l'horloge ===>>
Option Explicit
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private mode As Byte
Private chaine As String, ou As Integer
Private ancx As Long, sens As Integer, pa As POINTAPI
Private Sub Form_Load()
chaine = "34567"
RichTextBox1.Text = "aaaaa34567fffccc"
mode = 0
End Sub
Private Sub RichTextBox1_Change()
Static pre As String
If RichTextBox1.Text Like "*" & chaine & "*" Then pre RichTextBox1.Text Else RichTextBox1.Text pre
End Sub
'LA SOURIS
Private Sub RichTextBox1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
ancx = x
End Sub
Private Sub RichTextBox1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button 1 Then ancx x
End Sub
Private Sub RichTextBox1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 1 Then
Dim pos As Integer
mode = 1
pos = InStr(RichTextBox1.Text, chaine)
If x < ancx Then sens -1 Else sens 1
If RichTextBox1.SelLength <= 1 And RichTextBox1.SelStart >= pos - 1 And RichTextBox1.SelStart <= pos + Len(chaine) - 1 Then
If sens = 1 Then
RichTextBox1.SelStart = pos - 1
DoEvents
GetCursorPos pa
RichTextBox1.SelLength = Len(chaine)
SetCursorPos calculelongueur(Left(RichTextBox1.Text, pos + Len(chaine) + 1)) + _
ScaleX(RichTextBox1.Left, Me.ScaleMode, vbPixels) + ScaleX(Me.Left, vbTwips, vbPixels), pa.y
Exit Sub
End If
If sens = -1 And RichTextBox1.SelLength < 1 Then
RichTextBox1.SelStart = pos + Len(chaine) - 1
SendKeys "{RIGHT}"
SetCursorPos calculelongueur(Left(RichTextBox1.Text, pos)) + _
ScaleX(RichTextBox1.Left, Me.ScaleMode, vbPixels) + ScaleX(Me.Left, vbTwips, vbPixels), pa.y
Exit Sub
End If
End If
mode = 1
If x < ancx Then sens -1 Else sens 1
avancons RichTextBox1, chaine, 1
End If
End Sub
'LE CLAVIER
Private Sub RichTextBox1_KeyDown(KeyCode As Integer, Shift As Integer)
If Shift And Not KeyCode = 16 Then
If KeyCode 37 And RichTextBox1.SelLength 0 Then sens = -1
If KeyCode 39 And RichTextBox1.SelLength 0 Then sens = 1
If RichTextBox1.SelLength 0 And sens -1 Then ou = RichTextBox1.SelStart
End If
End Sub
Private Sub RichTextBox1_KeyUp(KeyCode As Integer, Shift As Integer)
If Shift <> 1 Then Exit Sub
If mode = 0 Then
Dim pos As Integer, i As Integer
pos = InStr(RichTextBox1.Text, chaine)
If RichTextBox1.SelStart >= pos - 1 And RichTextBox1.SelStart < pos + Len(chaine) - 2 Then
If sens = 1 And RichTextBox1.SelStart >= pos - 0 Then
RichTextBox1.SelStart = pos - 1
SendKeys "{RIGHT}"
Else
If sens = -1 And RichTextBox1.SelLength < 2 Then
RichTextBox1.SelStart = pos + Len(chaine) - 1
SendKeys "{LEFT}"
Exit Sub
End If
End If
End If
End If
mode = 0
avancons RichTextBox1, chaine, 1
End Sub
Private Sub avancons(RTB As RichTextBox, chaine As String, maj As Integer)
Dim toto As String, fofo As Integer, i As Integer
Static pos As Integer
pos = InStr(RTB.Text, chaine)
Select Case sens
Case 1
If mode = 0 Then
If RTB.SelStart + RTB.SelLength = pos Then simule_cle "RIGHT", Len(chaine) - 1
End If
If mode = 1 Then
If RTB.SelStart + RTB.SelLength = pos Then
GetCursorPos pa
fofo = calculelongueur(Left(RTB.Text, pos + Len(chaine))) + ScaleX(RTB.Left, Me.ScaleMode, vbPixels) + _
ScaleX(Me.Left, vbTwips, vbPixels)
SetCursorPos fofo, pa.y
End If
End If
Case -1
If mode = 0 Then
If RTB.SelStart <> ou Then
If RTB.SelStart = pos + Len(chaine) - 2 Then simule_cle "LEFT", Len(chaine) - 1
Else
If RTB.SelStart - RTB.SelLength = pos + Len(chaine) - 2 Then
mode = 99
simule_cle "LEFT", Len(chaine) - 1
mode = 0
End If
End If
End If
If mode = 1 Then
On Error Resume Next
toto = Mid(RTB.Text, RTB.SelStart - Len(chaine) + 2, Len(chaine))
On Error GoTo 0
If toto = chaine Then
GetCursorPos pa
fofo = calculelongueur(Left(RTB.Text, pos - 1)) + ScaleX(Me.Left, vbTwips, vbPixels) + _
ScaleX(RTB.Left, Me.ScaleMode, vbPixels)
SetCursorPos fofo, pa.y
End If
End If
End Select
End Sub
Private Function calculelongueur(ByVal ch As String) As Long
If ch = "" Then Exit Function
With Me.Font
.Name = RichTextBox1.Font.Name
.Size = RichTextBox1.Font.Size
.Bold = RichTextBox1.Font.Bold
End With
calculelongueur = TextWidth(ch)
calculelongueur = ScaleX(calculelongueur, Me.ScaleMode, vbPixels)
End Function
Private Sub simule_cle(cle As String, combien As Integer)
Dim i As Integer
For i = 1 To combien
SendKeys "{" & cle & "}"
Next
End Sub
J'espère ne rien avoir oublié (quaucun cas particulier ne m'ait échappé).
En sélection , tant au clavier qu'à la souris :
- de gauche à droite : si on arrive au "pré", l'englobe et on peut continuer vers la droite
(si démarrage dans le "pré", englobe celui-ci et on peut continuer vers la droite
- de droite à gauche : si on atteint la fin du pré, l'englobe et on peut continuer vers la gauche
(si démarrage dans le "pré", englobe celui-ci depuis son début et on peut continuer vers la gauche)
en modification : on peut modifier à sa guise tout ce qui se trouve avant ou après le "pré". On ne peut modifier le pré lui-même
A toi.
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient