Soyez le premier à donner votre avis sur cette source.
Vue 5 091 fois - Téléchargée 494 fois
' juste le code principale : ' pour le programme entier voyez le ZIP ' pour les versions à jour elles seront d'abord sur mon site. http://moiceman.multimania.com ' l'idée viens de VBDiamond ' j'ai entièrement changé la source On Error GoTo errorhandler Dim i As Long Dim strTmpWord As String Dim strCaractere As String strTmpWord = "" For i = 1 To Len(strBufferIn) DoEvents strCaractere = Mid(strBufferIn, i, 1) Select Case strCaractere Case "A" To "Z", "a" To "z", "_", "0" To "9" strTmpWord = strTmpWord & strCaractere Case Chr(34) ' les strings (") ' strBufferOut = strBufferOut & M_Color_Comments strBufferOut = strBufferOut & strCaractere i = i + 1 Do While Mid(strBufferIn, i, 1) <> Chr(34) strCaractere = Mid(strBufferIn, i, 1) ' caractere reserve au HTML If strCaractere = "&" Then strCaractere = "&" If strCaractere = "<" Then strCaractere = "<" If strCaractere = ">" Then strCaractere = ">" strBufferOut = strBufferOut & strCaractere i = i + 1 Loop strBufferOut = strBufferOut & """" ' strBufferOut = strBufferOut & M_Color_End & vbCrLf Case Chr(39) ' les commentaires (') strBufferOut = strBufferOut & M_Color_Comments strBufferOut = strBufferOut & strCaractere i = i + 1 ' boucle de caractere vert ;-) ' tant qu'il n'y à pas de retour à la ligne et de "_" Do While Mid(strBufferIn, i, 2) <> vbCrLf Or Mid(strBufferIn, i - 1, 1) = "_" strCaractere = Mid(strBufferIn, i, 1) ' caractere reserve au HTML If strCaractere = "&" Then strCaractere = "&" If strCaractere = "<" Then strCaractere = "<" If strCaractere = ">" Then strCaractere = ">" strBufferOut = strBufferOut & strCaractere i = i + 1 Loop ' passe le vbLf i = i + 1 strBufferOut = strBufferOut & M_Color_End & vbCrLf Case Else ' les autres caractères If Not (Len(strTmpWord) = 0) Then ' est-ce un mots ? If InStr(1, gsBlueKeyWords, "*" & strTmpWord & "*", vbTextCompare) <> 0 Then ' est-ce un mots : gsBlueKeyWords strBufferOut = strBufferOut & M_Color_KeyWords ' on peu reprendre le mots de la liste pour le respect de la "case" strBufferOut = strBufferOut & strTmpWord strBufferOut = strBufferOut & M_Color_End ElseIf UCase(strTmpWord) = "REM" Then ' est-ce un commentaire strBufferOut = strBufferOut & M_Color_Comments strBufferOut = strBufferOut & strTmpWord ' boucle de caractere vert ;-) Do While Mid(strBufferIn, i, 2) <> vbCrLf strCaractere = Mid(strBufferIn, i, 1) ' caractere reserve au HTML If strCaractere = "&" Then strCaractere = "&" If strCaractere = "<" Then strCaractere = "<" If strCaractere = ">" Then strCaractere = ">" strBufferOut = strBufferOut & strCaractere i = i + 1 Loop ' passe le vbLf i = i + 1 strBufferOut = strBufferOut & M_Color_End & vbCrLf Else strBufferOut = strBufferOut & strTmpWord End If End If ' rajoute le caractere actuelle strBufferOut = strBufferOut & strCaractere strTmpWord = "" End Select Next ColorizeWords = True Exit Function errorhandler: Dim bytresponse As VbMsgBoxResult bytresponse = MsgBox("Error Converting file : " & Err.Description, vbAbortRetryIgnore Or vbCritical, "Error : " & Err.Number) If bytresponse = vbRetry Then Resume ElseIf bytresponse = vbIgnore Then Resume Next Else ColorizeWords = False Exit Function End If
30 juil. 2001 à 10:43
Case Chr(34) ' les strings (")
strBufferOut = strBufferOut & M_Color_Comments ' cette ligne
strBufferOut = strBufferOut & strCaractere
i = i + 1
Do While Mid(strBufferIn, i, 1) <> Chr(34)
strCaractere = Mid(strBufferIn, i, 1)
' caractere reserve au HTML
If strCaractere "&" Then strCaractere "&"
If strCaractere "<" Then strCaractere "<"
If strCaractere ">" Then strCaractere ">"
strBufferOut = strBufferOut & strCaractere
i = i + 1
Loop
strBufferOut = strBufferOut & """"
strBufferOut = strBufferOut & M_Color_End & vbCrLf ' cette ligne
27 juil. 2001 à 21:55
5 juil. 2001 à 11:47
4 juil. 2001 à 12:10
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.