Colorisation avec les RTB [Help me]
vbtom
-
8 juil. 2001 à 23:24
gregdevils Messages postés 6 Date d'inscription lundi 20 janvier 2003 Statut Membre Dernière intervention 20 février 2004 - 2 avril 2003 à 13:15
gregdevils Messages postés 6 Date d'inscription lundi 20 janvier 2003 Statut Membre Dernière intervention 20 février 2004 - 2 avril 2003 à 13:15
2 réponses
C'est quoi tu veux savoir au juste, comment remettre ton texte en noir après l'avoir mis en bleu ou bien tu veux savoir comment mettre tout ton texte en bleu...???
Pour mettre une chaine en bleu et remmettre en noir après:
Private Sub cmdColor_Click()
RichTextBox1.SelStart = 0 ' Commence au premier caractère(0)
RichTextBox1.SelLength = 5 ' Sélectionne 5 caractères(les 5 premiers)
RichTextBox1.SelColor = vbBlue ' Met les caractères sélectionner en bleu
RichTextBox1.SelStart = 5 ' Redéfinie la position de départ(ce déplace au cinquième caractères)
RichTextBox1.SelColor = vbBlack ' Remet en noir
' Donc les prochain caractères que tu va tapper vont être en noir!
End Sub
Pour mettre tout ton texte en Bleu:
RichTextBox1.ForeColor = vbBlue
RichTextBox1.Refresh
C'est tout!
[mailto:NitRic28@Hotmail.com NitRic]
Pour mettre une chaine en bleu et remmettre en noir après:
Private Sub cmdColor_Click()
RichTextBox1.SelStart = 0 ' Commence au premier caractère(0)
RichTextBox1.SelLength = 5 ' Sélectionne 5 caractères(les 5 premiers)
RichTextBox1.SelColor = vbBlue ' Met les caractères sélectionner en bleu
RichTextBox1.SelStart = 5 ' Redéfinie la position de départ(ce déplace au cinquième caractères)
RichTextBox1.SelColor = vbBlack ' Remet en noir
' Donc les prochain caractères que tu va tapper vont être en noir!
End Sub
Pour mettre tout ton texte en Bleu:
RichTextBox1.ForeColor = vbBlue
RichTextBox1.Refresh
C'est tout!
[mailto:NitRic28@Hotmail.com NitRic]
gregdevils
Messages postés
6
Date d'inscription
lundi 20 janvier 2003
Statut
Membre
Dernière intervention
20 février 2004
2 avril 2003 à 13:15
2 avril 2003 à 13:15
ce code n'est pas de moi mais ça doit pouvoir de dépanner
-> à mettre dans un module
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Option Explicit
Public KeyWords
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Public Sub Colorize(RTFBox As RichTextBox, CommentColor, StringColor, KeysColor, KeyCode)
Dim lTextSelPos As Long
Dim lTextSelLen As Long
Dim thisLine As Integer
Dim cStart As Integer
Dim cEnd As Integer
Dim i As Long
Dim sBuffer As String
Dim lBufferLen As Long
Dim lSelPos As Long
Dim lSelLen As Long
Dim sTempBuffer As String
Dim sSearchChar As String
Dim lSearchCharLen As Long
Dim StartText As Integer
Dim RepText As String
On Error GoTo ErrHandler
lTextSelPos = RTFBox.SelStart
lTextSelLen = RTFBox.SelLength
With RTFBox
cStart% = .SelStart ' Posizione corrente del cursore
cEnd% = .SelStart ' Posizione precedente del cursore
thisLine = .GetLineFromChar(.SelStart)
If KeyCode = 13 Then
thisLine = thisLine - 1
cStart% = cStart% - 1
End If
Do Until .GetLineFromChar(cStart%) <> thisLine
cStart% = cStart% - 1
If cStart% < 0 Then
cStart% = 0
Exit Do
End If
Loop
Do Until .GetLineFromChar(cEnd%) <> thisLine
cEnd% = cEnd% + 1
If cEnd% > Len(.Text) Then
cEnd = Len(.Text)
Exit Do
End If
Loop
.SelStart = cStart%
.SelLength = cEnd% - cStart%
.SelColor = StringColor
.SelLength = 0
End With
With RTFBox
sBuffer = .Text & " "
lBufferLen = Len(sBuffer)
sTempBuffer = "" If cStart 0 Then cStart 1
For i = cStart% To cEnd%
Select Case Asc(Mid(sBuffer, i, 1))
Case 47, 39
If Mid(sBuffer, i, 2) = "//" Then
sSearchChar = vbCrLf
lSearchCharLen = 0
ElseIf Mid(sBuffer, i, 1) = "'" Then
sSearchChar = vbCrLf
lSearchCharLen = 0
Else
GoTo ExitComment
End If
sTempBuffer = ""
.SelStart = i - 1
lSelLen = InStr(i, sBuffer, sSearchChar) _
+ lSearchCharLen
If lSelLen <> lSearchCharLen Then
lSelLen = lSelLen - i
Else
lSelLen = lBufferLen - i
End If
.SelLength = lSelLen
.SelColor = CommentColor
i = .SelStart + .SelLength
ExitComment:
Case 34
If Mid(sBuffer, i, 1) = Chr$(34) Then
sSearchChar = Chr$(34)
lSearchCharLen = 0
Else
GoTo ExitQuote
End If
sTempBuffer = ""
.SelStart = i - 1
lSelLen = InStr(i + 1, sBuffer, sSearchChar) + lSearchCharLen
If lSelLen <> lSearchCharLen Then
lSelLen = lSelLen - i
ElseIf lSelLen < 1 Then
GoTo ErrHandler
Else
lSelLen = lBufferLen - i
End If
.SelLength = lSelLen
.SelColor = StringColor
i = .SelStart + .SelLength
ExitQuote:
Case 33, 35 To 38, 46, 60, 62, _
49 To 57, 97 To 122, 65 To 90 If sTempBuffer "" Then lSelPos i
sTempBuffer = sTempBuffer & Mid(sBuffer, i, 1)
Case Else
If Trim(sTempBuffer) <> "" Then
.SelStart = lSelPos - 1
.SelLength = Len(sTempBuffer)
StartText% = InStr(1, KeyWords, _
"|" & sTempBuffer & "|", 1)
If StartText% <> 0 Then
.SelColor = KeysColor
RepText$ = _
Mid$(KeyWords, StartText% + 1, _
Len(sTempBuffer))
.SelText = RepText$
End If
End If
sTempBuffer = ""
End Select
Next
End With
ErrHandler:
RTFBox.SelStart = lTextSelPos
RTFBox.SelLength = lTextSelLen
End Sub
Public Sub doGetScriptKeywords()
Dim DataFile As String
Dim sWords As String
Dim LineData As String
Dim ff As Integer
DataFile$ = CurDir & "\keywords.txt"
sWords$ = "|"
ff = FreeFile
Open DataFile$ For Input As ff
Do Until EOF(ff)
Line Input #ff, LineData$
sWords$ = sWords$ & LineData$ & "|"
Loop
Close ff
KeyWords = sWords$
sWords$ = ""
LineData$ = ""
End Sub
-> a mettre dans une feuille
Private Sub Form_Load()
' Carica le KeyWords dal file di testo
doGetScriptKeywords
End Sub
Private Sub RTF1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim CommentColor As Long
Dim StringColor As Long
Dim KeysColor As Long
' Sospende il REFRESH
LockWindowUpdate Me.hwnd
' Avvia la routine di colorazione in base al tasto premuto
' in questo caso usa "ENTER" e "SPAZIO"
Select Case KeyCode
Case 13, 32
'Setta i colori delle KEYWORDS
'(questi sono i colori dell'IDE di VB)
CommentColor = RGB(0, 128, 0) 'DARK GREEN
StringColor = RGB(0, 0, 0) 'BLACK
KeysColor = RGB(0, 0, 128) 'DARK BLUE
' Colora il testo
' questa routine usa la riga corrente
Colorize RTF1, CommentColor, StringColor, KeysColor, KeyCode
' Setta il Colore corrente
RTF1.SelColor = StringColor
End Select
LockWindowUpdate 0&
End Sub
-> à mettre dans un fichier qui s'appelle KEYWORDS.TXT
If
Then
Else
Sub
End
Goto
Do
Loop
Print
Save
Dim
Public
Private
Function
Get
Set
Let
Dans ta feuille dans met un controle RICHTEXTBOX
quand tu entreras ton texte celui ci se formettera à la couleur de VB
-> à mettre dans un module
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Option Explicit
Public KeyWords
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long
Public Sub Colorize(RTFBox As RichTextBox, CommentColor, StringColor, KeysColor, KeyCode)
Dim lTextSelPos As Long
Dim lTextSelLen As Long
Dim thisLine As Integer
Dim cStart As Integer
Dim cEnd As Integer
Dim i As Long
Dim sBuffer As String
Dim lBufferLen As Long
Dim lSelPos As Long
Dim lSelLen As Long
Dim sTempBuffer As String
Dim sSearchChar As String
Dim lSearchCharLen As Long
Dim StartText As Integer
Dim RepText As String
On Error GoTo ErrHandler
lTextSelPos = RTFBox.SelStart
lTextSelLen = RTFBox.SelLength
With RTFBox
cStart% = .SelStart ' Posizione corrente del cursore
cEnd% = .SelStart ' Posizione precedente del cursore
thisLine = .GetLineFromChar(.SelStart)
If KeyCode = 13 Then
thisLine = thisLine - 1
cStart% = cStart% - 1
End If
Do Until .GetLineFromChar(cStart%) <> thisLine
cStart% = cStart% - 1
If cStart% < 0 Then
cStart% = 0
Exit Do
End If
Loop
Do Until .GetLineFromChar(cEnd%) <> thisLine
cEnd% = cEnd% + 1
If cEnd% > Len(.Text) Then
cEnd = Len(.Text)
Exit Do
End If
Loop
.SelStart = cStart%
.SelLength = cEnd% - cStart%
.SelColor = StringColor
.SelLength = 0
End With
With RTFBox
sBuffer = .Text & " "
lBufferLen = Len(sBuffer)
sTempBuffer = "" If cStart 0 Then cStart 1
For i = cStart% To cEnd%
Select Case Asc(Mid(sBuffer, i, 1))
Case 47, 39
If Mid(sBuffer, i, 2) = "//" Then
sSearchChar = vbCrLf
lSearchCharLen = 0
ElseIf Mid(sBuffer, i, 1) = "'" Then
sSearchChar = vbCrLf
lSearchCharLen = 0
Else
GoTo ExitComment
End If
sTempBuffer = ""
.SelStart = i - 1
lSelLen = InStr(i, sBuffer, sSearchChar) _
+ lSearchCharLen
If lSelLen <> lSearchCharLen Then
lSelLen = lSelLen - i
Else
lSelLen = lBufferLen - i
End If
.SelLength = lSelLen
.SelColor = CommentColor
i = .SelStart + .SelLength
ExitComment:
Case 34
If Mid(sBuffer, i, 1) = Chr$(34) Then
sSearchChar = Chr$(34)
lSearchCharLen = 0
Else
GoTo ExitQuote
End If
sTempBuffer = ""
.SelStart = i - 1
lSelLen = InStr(i + 1, sBuffer, sSearchChar) + lSearchCharLen
If lSelLen <> lSearchCharLen Then
lSelLen = lSelLen - i
ElseIf lSelLen < 1 Then
GoTo ErrHandler
Else
lSelLen = lBufferLen - i
End If
.SelLength = lSelLen
.SelColor = StringColor
i = .SelStart + .SelLength
ExitQuote:
Case 33, 35 To 38, 46, 60, 62, _
49 To 57, 97 To 122, 65 To 90 If sTempBuffer "" Then lSelPos i
sTempBuffer = sTempBuffer & Mid(sBuffer, i, 1)
Case Else
If Trim(sTempBuffer) <> "" Then
.SelStart = lSelPos - 1
.SelLength = Len(sTempBuffer)
StartText% = InStr(1, KeyWords, _
"|" & sTempBuffer & "|", 1)
If StartText% <> 0 Then
.SelColor = KeysColor
RepText$ = _
Mid$(KeyWords, StartText% + 1, _
Len(sTempBuffer))
.SelText = RepText$
End If
End If
sTempBuffer = ""
End Select
Next
End With
ErrHandler:
RTFBox.SelStart = lTextSelPos
RTFBox.SelLength = lTextSelLen
End Sub
Public Sub doGetScriptKeywords()
Dim DataFile As String
Dim sWords As String
Dim LineData As String
Dim ff As Integer
DataFile$ = CurDir & "\keywords.txt"
sWords$ = "|"
ff = FreeFile
Open DataFile$ For Input As ff
Do Until EOF(ff)
Line Input #ff, LineData$
sWords$ = sWords$ & LineData$ & "|"
Loop
Close ff
KeyWords = sWords$
sWords$ = ""
LineData$ = ""
End Sub
-> a mettre dans une feuille
Private Sub Form_Load()
' Carica le KeyWords dal file di testo
doGetScriptKeywords
End Sub
Private Sub RTF1_KeyUp(KeyCode As Integer, Shift As Integer)
Dim CommentColor As Long
Dim StringColor As Long
Dim KeysColor As Long
' Sospende il REFRESH
LockWindowUpdate Me.hwnd
' Avvia la routine di colorazione in base al tasto premuto
' in questo caso usa "ENTER" e "SPAZIO"
Select Case KeyCode
Case 13, 32
'Setta i colori delle KEYWORDS
'(questi sono i colori dell'IDE di VB)
CommentColor = RGB(0, 128, 0) 'DARK GREEN
StringColor = RGB(0, 0, 0) 'BLACK
KeysColor = RGB(0, 0, 128) 'DARK BLUE
' Colora il testo
' questa routine usa la riga corrente
Colorize RTF1, CommentColor, StringColor, KeysColor, KeyCode
' Setta il Colore corrente
RTF1.SelColor = StringColor
End Select
LockWindowUpdate 0&
End Sub
-> à mettre dans un fichier qui s'appelle KEYWORDS.TXT
If
Then
Else
Sub
End
Goto
Do
Loop
Save
Dim
Public
Private
Function
Get
Set
Let
Dans ta feuille dans met un controle RICHTEXTBOX
quand tu entreras ton texte celui ci se formettera à la couleur de VB
