Transforme un fichier, un répertoire ou un projet en HTML colorisé
Enfin une version open source ...
J'en ai cherché un qui allait bien et qui était gratuit j'ai jamais trouvé alors j'ai repris des exemples et j'en ai crée un le voici il est toujours en développement.
Source / Exemple :
' 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
Conclusion :
bonne amusement ;-)
22/03/2004
j'ai converti ce code en JavaScript et il est maintenant disponible sur mon site
il y a quelque correction de bug qui ne sont reportée dans la version VB actuellement
http://membres.lycos.fr/moiceman/script/vbtohtm.htm
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.