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
| Option Explicit
Dim FormatPolice As String
Dim BackLigneColor As String
Private Sub Form_Load()
Command1.Move 90, 90, 1455, 345
Command2.Move 1650, 90, 1455, 345
RichTextBox1.Move 90, 540, 8205, 3465
Me.Width = 8430: Me.Height = 4455
FormatPolice = "{\rtf1\ansi\ansicpg1252\deff0\deflang" & _
"1036{\fonttbl{\f0\froman\fprq2\fcharset0 Times New Roman;}{" & _
"\f1\fnil\fcharset0 MS Sans Serif;}}"
BackLigneColor = "{\colortbl ;" & _
"\red0\green255\blue255;" & _
"\red255\green255\blue0;" & _
"\red255\green0\blue255;" & _
"\red0\green255\blue0;}" & _
"\viewkind4\uc1\pard\f0\fs24"
RichTextBox1.TextRTF = ""
Surligne "3", "Coucou", True
Surligne "1", "Bon ou "
Surligne "0", "pas bon, SI, mais backcolor blanc puisque egal à RichTextBox1.BackColor", True
Surligne "2", "A chacun de voir", True
Surligne "4", "j'espère que cela poura rendre service"
End Sub
Public Sub Surligne(NumCoulSurligne As String, Text As String, Optional RetLign As Boolean)
RichTextBox1.SelRTF = FormatPolice & BackLigneColor & _
"\highlight" & NumCoulSurligne & Text & "}"
If RetLign = True Then RichTextBox1.SelText = vbCrLf
End Sub
Private Sub Command1_Click()
SurligneCible "4", "SI"
End Sub
Public Sub SurligneCible(NumCoulSurligne As String, Text As String)
'recherche le mot ou la phrase a surligner
If RichTextBox1.Find(Text) = -1 Then Exit Sub
'mot ou phrase trouvé, donc selectionné, surlignage a la couleur NumCoulSurligne
RichTextBox1.SelRTF = FormatPolice & BackLigneColor & _
"\highlight" & NumCoulSurligne & RichTextBox1.SelText & "}"
End Sub
Private Sub Command2_Click()
'dans un premier temps, positionner le curseur sur la ligne a surligner
SurligneLaLigne "3", RichTextBox1.GetLineFromChar(RichTextBox1.SelStart)
End Sub
Public Sub SurligneLaLigne(NumCoulSurligne As String, NumLigne As Integer)
Dim NumCaractDeb As Integer, NumCaractFin As Integer
Dim T As Integer
'recherche du premier et dernier caractere de la ligne
RichTextBox1.SelStart = 0: RichTextBox1.SelLength = 64000
NumCaractDeb = -1: NumCaractFin = RichTextBox1.SelLength
For T = 0 To NumCaractFin
If RichTextBox1.GetLineFromChar(T) = NumLigne Then
If NumCaractDeb = -1 Then NumCaractDeb = T
End If
If NumCaractDeb <> -1 And RichTextBox1.GetLineFromChar(T) > NumLigne Then
NumCaractFin = T
Exit For
End If
Next T
Dim LaPhrase As String
RichTextBox1.SelStart = NumCaractDeb: RichTextBox1.SelLength = NumCaractFin - NumCaractDeb
LaPhrase = RichTextBox1.SelText
SurligneCible NumCoulSurligne, LaPhrase
RichTextBox1.SelText = vbCrLf
End Sub |
Partager