Vb to mirc

Commenter

Contenu du snippet

Mettez le dans un module

Source / Exemple : 


Public Function Colorise2(LeCode As String) As String
On Error Resume Next
Dim a As Integer
Dim InGuimette As Boolean
Dim LaCouleur As ColorConstants
Dim NoColorise As Boolean
Dim InParenthèse As Boolean
Dim InComment As Boolean
Dim LeTexteRTF As String
NoColorise = False
InComment = False
a = 0
InGuimette = False
InParenthèse = False
Do
a = a + 1
'========================
'Détecte les keywords
If Mid(LeCode, a, 2) = "If" Or Mid(LeCode, a, 2) = "As" Or Mid(LeCode, a, 2) = "Do" Or Mid(LeCode, a, 2) = "In" Or Mid(LeCode, a, 2) = "Is" Or Mid(LeCode, a, 2) = "On" Or Mid(LeCode, a, 2) = "Or" Or Mid(LeCode, a, 2) = "To" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 2)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 1
ElseIf Mid(LeCode, a, 3) = "End" Or Mid(LeCode, a, 3) = "Sub" Or Mid(LeCode, a, 3) = "Dim" Or Mid(LeCode, a, 3) = "Xor" Or Mid(LeCode, a, 3) = "Dim" Or Mid(LeCode, a, 3) = "Tab" Or Mid(LeCode, a, 3) = "Set" Or Mid(LeCode, a, 3) = "Get" Or Mid(LeCode, a, 3) = "Let" Or Mid(LeCode, a, 3) = "New" Or Mid(LeCode, a, 3) = "Imp" Or Mid(LeCode, a, 3) = "For" Or Mid(LeCode, a, 3) = "Eqv" Or Mid(LeCode, a, 3) = "And" Or Mid(LeCode, a, 3) = "Lib" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 3)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 2
ElseIf Mid(LeCode, a, 4) = "Then" Or Mid(LeCode, a, 4) = "Else" Or Mid(LeCode, a, 4) = "Base" Or Mid(LeCode, a, 4) = "Byte" Or Mid(LeCode, a, 4) = "Call" Or Mid(LeCode, a, 4) = "Case" Or Mid(LeCode, a, 4) = "CCcur" Or Mid(LeCode, a, 4) = "CDbl" Or Mid(LeCode, a, 4) = "CDec" Or Mid(LeCode, a, 4) = "CInt" Or Mid(LeCode, a, 4) = "CLng" Or Mid(LeCode, a, 4) = "CStr" Or Mid(LeCode, a, 4) = "CVar" Or Mid(LeCode, a, 4) = "Enum" Or Mid(LeCode, a, 4) = "Line" Or Mid(LeCode, a, 4) = "Lock" Or Mid(LeCode, a, 4) = "Loop" Or Mid(LeCode, a, 4) = "LSet" Or Mid(LeCode, a, 4) = "Name" Or Mid(LeCode, a, 4) = "Next" Or Mid(LeCode, a, 4) = "Open" Or Mid(LeCode, a, 4) = "RSet" Or Mid(LeCode, a, 4) = "Seek" Or Mid(LeCode, a, 4) = "Stop" Or Mid(LeCode, a, 4) = "True" Or Mid(LeCode, a, 4) = "Type" Or Mid(LeCode, a, 4) = "Wend" Or Mid(LeCode, a, 4) = "With" Or Mid(LeCode, a, 4) = "Long" Or Mid(LeCode, a, 4) = "Goto" Or Mid(LeCode, a, 4) = "Read" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 4)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 3
ElseIf Mid(LeCode, a, 5) = "Const" Or Mid(LeCode, a, 5) = "Alias" Or Mid(LeCode, a, 5) = "ByVal" Or Mid(LeCode, a, 5) = "CBool" Or Mid(LeCode, a, 5) = "CByte" Or Mid(LeCode, a, 5) = "CDate" Or Mid(LeCode, a, 5) = "Close" Or Mid(LeCode, a, 5) = "CVErr" Or Mid(LeCode, a, 5) = "Erase" Or Mid(LeCode, a, 5) = "Error" Or Mid(LeCode, a, 5) = "False" Or Mid(LeCode, a, 5) = "GoSub" Or Mid(LeCode, a, 5) = "Input" Or Mid(LeCode, a, 5) = "Print" Or Mid(LeCode, a, 5) = "Write" Or Mid(LeCode, a, 5) = "InStr" Or Mid(LeCode, a, 5) = "ByRef" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 5)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 4
ElseIf Mid(LeCode, a, 6) = "ElseIf" Or Mid(LeCode, a, 6) = "Binary" Or Mid(LeCode, a, 6) = "DefCur" Or Mid(LeCode, a, 6) = "DefDbl" Or Mid(LeCode, a, 6) = "DefDec" Or Mid(LeCode, a, 6) = "DefInt" Or Mid(LeCode, a, 6) = "DefLng" Or Mid(LeCode, a, 6) = "DefObj" Or Mid(LeCode, a, 6) = "DefSng" Or Mid(LeCode, a, 6) = "DefStr" Or Mid(LeCode, a, 6) = "DefVar" Or Mid(LeCode, a, 6) = "Double" Or Mid(LeCode, a, 6) = "Object" Or Mid(LeCode, a, 6) = "Option" Or Mid(LeCode, a, 6) = "Output" Or Mid(LeCode, a, 6) = "Public" Or Mid(LeCode, a, 6) = "Random" Or Mid(LeCode, a, 6) = "Resume" Or Mid(LeCode, a, 6) = "Return" Or Mid(LeCode, a, 6) = "Select" Or Mid(LeCode, a, 6) = "Single" Or Mid(LeCode, a, 6) = "Static" Or Mid(LeCode, a, 6) = "String" Or Mid(LeCode, a, 6) = "UBound" Or Mid(LeCode, a, 6) = "Unlock" Or Mid(LeCode, a, 6) = "ElseIf" Or Mid(LeCode, a, 6) = "Decimal" Or Mid(LeCode, a, 6) = "LBound" Or Mid(LeCode, a, 6) = "Global" Or Mid(LeCode, a, 6) = "Output" Or Mid(LeCode, a, 6) = "Resume" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 6)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 5
ElseIf Mid(LeCode, a, 7) = "Boolean" Or Mid(LeCode, a, 7) = "Compare" Or Mid(LeCode, a, 7) = "Declare" Or Mid(LeCode, a, 7) = "DefBool" Or Mid(LeCode, a, 7) = "DefByte" Or Mid(LeCode, a, 7) = "DefDate" Or Mid(LeCode, a, 7) = "Integer" Or Mid(LeCode, a, 7) = "Private" Or Mid(LeCode, a, 7) = "Nothing" Or Mid(LeCode, a, 7) = "Variant" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 7)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 6
ElseIf Mid(LeCode, a, 8) = "Currency" Or Mid(LeCode, a, 8) = "Function" Or Mid(LeCode, a, 8) = "Explicit" Then
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "12"
If InComment = True And InGuimette = True Then LeTexteRTF = LeTexteRTF & "3,9"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 8)
If InComment = False And InGuimette = False Then LeTexteRTF = LeTexteRTF & "1"
a = a + 7
Else
Select Case Mid(LeCode, a, 1)
'Début du coloriage des guimette
Case """"
If InComment = False Then
If InGuimette = False Then
LeTexteRTF = LeTexteRTF & "4"
InGuimette = True
Else
NoColorise = True
LaCouleur = vbBlack
InGuimette = False
LeTexteRTF = LeTexteRTF & ""
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 1)
End If
End If
'Fin du coloriager des guilmette
'Début du coloriage des Parathèse
Case "("
If InComment = False Then LeTexteRTF = LeTexteRTF & "12"
Case ")"
If InComment = False Then
LaCouleur = vbBlack
NoColorise = True
LeTexteRTF = LeTexteRTF & "12"
LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 1)
LeTexteRTF = LeTexteRTF & "1"
End If
'Fin du coloriager des Parathèse
'Début du coloriage des Commentaire
Case "'"
LeTexteRTF = LeTexteRTF & "3,9"
InComment = True
Case Chr(10)
LeTexteRTF = LeTexteRTF & vbCrLf
LeTexteRTF = LeTexteRTF & "1"
InComment = False
'Fin du coloriager des Commentaire
End Select
If NoColorise = False Then LeTexteRTF = LeTexteRTF & Mid(LeCode, a, 1)
End If
'========================
NoColorise = False
If a >= Len(LeCode) Then Colorise2 = LeTexteRTF: Exit Do
DoEvents
Loop
End Function

Conclusion :


text1.Text = Colorise2("If salut")
Améliorer le

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_max12)