1. Accueil
  2. Tous les snippets
  3. Snippets Visual Basic / VB.NET
  4. Rtf --> code html

Rtf --> code html

Soyez le premier à donner votre avis sur cette source.

Snippet vu 7 881 fois - Téléchargée 50 fois

Commenter

Contenu du snippet


Source / Exemple : 


'##########################################################################################
'# Fonction retournant le code HTML du texte du contrôle rich text box passé en paramètre #
'##########################################################################################
'   Paramètre(s) : vvRTBCtl         -> contrôle RichTextBox contenant le texte à convertir
'   Résultat(s)  : convertRTFtoHTML -> Code HTML correspondant
Public Function convertRTFtoHTML(vvRTBCtl As Control) As String
    Dim a
    Dim IsBold As Boolean
    Dim IsUnderline As Boolean
    Dim IsItalic As Boolean
    Dim vlStr As String
    
    On Error Resume Next
    
    IsItalic = False
    IsUnderline = False
    IsBold = False
    
    vlStr = ""
    
    For a = 0 To Len(vvRTBCtl.Text) + 2
        vvRTBCtl.SelStart = a + 1
        If vvRTBCtl.SelStart = Len(vvRTBCtl.Text) + 1 Then
            IsBold = False
            IsUnderline = False
            IsItalic = False
        End If

        'Mettre en Gras
        If vvRTBCtl.SelBold = True And IsBold = False Then
            IsBold = True
            vlStr = vlStr & "<B>"
        End If
        If vvRTBCtl.SelBold = False And IsBold = True Then
            IsBold = False
            vlStr = vlStr & "</B>"
        End If

        'Mettre en souligner
        If vvRTBCtl.SelUnderline = True And IsUnderline = False Then
            IsUnderline = True
            vlStr = vlStr & "<U>"
        End If
        If vvRTBCtl.SelUnderline = False And IsUnderline = True Then
            IsUnderline = False
            vlStr = vlStr & "</U>"
        End If

        'Mettre en italic
        If vvRTBCtl.SelItalic = True And IsItalic = False Then
            IsItalic = True
            vlStr = vlStr & "<I>"
        End If
        If vvRTBCtl.SelItalic = False And IsItalic = True Then
            IsItalic = False
            vlStr = vlStr & "</I>"
        End If

        If Asc(Mid(vvRTBCtl.Text, a + 1, 1)) = vbKeyReturn Then
            vlStr = vlStr & "<br>"
        Else
            vlStr = vlStr & Mid(vvRTBCtl.Text, a + 1, 1)
        End If

        If a = Len(vvRTBCtl.Text) - 1 Then
            vlStr = vlStr & "</I>"
            vlStr = vlStr & "</U>"
            vlStr = vlStr & "</B>"
        End If
    Next
    convertRTFtoHTML = vlStr
End Function

Conclusion :


On peut facilement gérer les couleurs, l'alignement et la police de la même manière.

A voir également

Ajouter un commentaire Commentaires
l0st3d Messages postés 205 Date d'inscription jeudi 19 décembre 2002 Statut Membre Dernière intervention 13 novembre 2009
9 nov. 2005 à 09:58
Merci pour la source, c'est vraiment très utile

10/10
tontonkika Messages postés 4 Date d'inscription mardi 25 mai 2004 Statut Membre Dernière intervention 25 juillet 2005
10 janv. 2005 à 13:46
si cela peut aider, une fonction intégrant l'alignement...

Public Function ConvertToHTML(Box As Control, Optional FlgAlert As Boolean True, Optional b_netscape4 As Boolean False) As String 'System.Windows.Forms.RichTextBox
' Converti une chaine RTF en HTML
Dim strHTML As String
Dim strColour As String
Dim colorTmp As String
Dim blnBold As Boolean
Dim blnItalic As Boolean
Dim blnUnderline As Boolean
Dim strFont As String
Dim shtSize As Single 'Short
Dim strAlign As String
Dim numAligne As Integer
Dim lngOriginalStart As Long
Dim lngOriginalLength As Long
Dim intCount As Integer
Dim s_diez As String

On Error GoTo ConvertToHTMLError

' On sort si la Box est vide
If Len(Box.Text) = 0 Then
Exit Function
End If

' Stockage et recuperation du premier caractere
lngOriginalStart = 0
lngOriginalLength = Len(Box.Text)
Box.SelStart = 0
Box.SelLength = 1

strHTML = ""

' Initialisation des parametres
strColour = Right$("000000" & Hex(Box.SelColor), 6)
strColour = Right$(strColour, 2) & Mid$(strColour, 3, 2) & Left$(strColour, 2)

' MsgBox Hex(strColour)
blnBold = Box.SelBold
blnItalic = Box.SelItalic
blnUnderline = Box.SelUnderline

strFont = Box.SelFontName
shtSize = Box.SelFontSize
numAligne = Box.SelAlignment
Select Case Box.SelAlignment
Case 0 ' Left
strAlign = "Left"
Case 1 ' right
strAlign = "Right"
Case 2 ' center
strAlign = "Center"
End Select


' ALIGN
'If strAlign <> "" Then
strHTML = strHTML & "
"
'End If

' STYLE
If b_netscape4 Then
strHTML = strHTML & ""
Else
s_diez = "#"

strHTML = strHTML & ""
End If

' Gestion du gras
If blnBold Then
strHTML = strHTML & ""
End If
' Gestion de l'italique
If blnItalic Then
strHTML = strHTML & ""
End If
' Gestion du souligné
If blnUnderline Then
strHTML = strHTML & ""
End If

' premier caractere
strHTML = strHTML & Box.SelText

' Pour tous les caracteres
For intCount = 2 To Len(Box.Text)
' caractere courant
Box.SelStart = (intCount - 1)
Box.SelLength = 1

'MsgBox Box.SelText
If Len(Box.SelText) > 0 And FlgAlert Then
If Asc(Box.SelText) = 32 And FlgAlert Then
If InStr(Box.SelRTF, "\pict") > 0 Then
If FlgAlert Then
MsgBox "Attention, les images dans les textes, ne seront pas converties", vbCritical, "Attention"
FlgAlert = False
End If
End If
End If
End If

' Gestion du saut de ligne
If Box.SelText Chr$(10) Or Len(Box.SelText) 0 Then
strHTML = strHTML & "
"
End If

' Changement de gras
If Box.SelBold <> blnBold Then
If Box.SelBold = False Then
strHTML = strHTML & ""
End If
End If
' Changement d'italique
If Box.SelItalic <> blnItalic Then
If Box.SelItalic = False Then
strHTML = strHTML & ""
End If
End If
' Changement de souligné
If Box.SelUnderline <> blnUnderline Then
If Box.SelUnderline = False Then
strHTML = strHTML & ""
End If
End If

' Eventuel changement destyle
colorTmp = Right$("000000" & Hex(Box.SelColor), 6)
colorTmp = Right$(colorTmp, 2) & Mid$(colorTmp, 3, 2) & Left$(colorTmp, 2)
If colorTmp <> strColour _
Or Box.SelFontName <> strFont _
Or Box.SelFontSize <> shtSize _
Or Box.SelAlignment <> numAligne Then

If b_netscape4 Then
strHTML = strHTML & ""
Else
strHTML = strHTML & ""
End If

' ALIGN
If Box.SelAlignment <> numAligne Then
Select Case Box.SelAlignment
Case 0 ' Left
strAlign = "Left"
Case 1 ' right
strAlign = "Right"
Case 2 ' center
strAlign = "Center"
End Select
strHTML = strHTML & "

"
End If

If b_netscape4 Then
'traitement de la taille du texte
strHTML = strHTML & ""
Else
s_diez = "#"

strHTML = strHTML & ""
End If

End If

' Changement de gras
If Box.SelBold <> blnBold Then
If Box.SelBold Then
strHTML = strHTML & ""
End If
End If
' Changement d'italique
If Box.SelItalic <> blnItalic Then
If Box.SelItalic Then
strHTML = strHTML & ""
End If
End If
' Changement de souligné
If Box.SelUnderline <> blnUnderline Then
If Box.SelUnderline Then
strHTML = strHTML & ""
End If
End If

' Ajout du caractere
If Len(Box.SelText) > 0 Then
strHTML = strHTML & Mid$(Box.Text, intCount, 1)
End If

' MAJ
strColour = Right$("000000" & Hex(Box.SelColor), 6)
strColour = Right$(strColour, 2) & Mid$(strColour, 3, 2) & Left$(strColour, 2)
blnBold = Box.SelBold
blnItalic = Box.SelItalic
blnUnderline = Box.SelUnderline

strFont = Box.SelFontName
shtSize = Box.SelFontSize
numAligne = Box.SelAlignment
Select Case Box.SelAlignment
Case 0 ' Left
strAlign = "Left"
Case 1 ' right
strAlign = "Right"
Case 2 ' center
strAlign = "Center"
End Select
Next intCount

' Fermeture des tags bold/italic...
If blnBold Then strHTML = strHTML & ""
If blnItalic Then strHTML = strHTML & ""
If blnUnderline Then strHTML = strHTML & ""

' On ferme le tag SPAN
If b_netscape4 Then
strHTML = strHTML & ""
Else
strHTML = strHTML & ""
End If

' ALIGN
'If strAlign <> "" Then
strHTML = strHTML & "
"
'End If

' Restauration de l'original richtextbox
'Box.Select lngOriginalStart, lngOriginalLength

ConvertToHTML = strHTML

Exit Function
ConvertToHTMLError:

MsgBox Err.Description & vbCrLf & Err.Number, vbCritical, LoadResString(185 + Langage)
Resume Next

End Function
cs_yasr Messages postés 2 Date d'inscription mercredi 13 août 2003 Statut Membre Dernière intervention 18 août 2003
18 août 2003 à 17:19
Les liens ne fonctionnent pas!
leptidev Messages postés 206 Date d'inscription mercredi 30 janvier 2002 Statut Membre Dernière intervention 4 décembre 2007
25 mars 2002 à 13:00
Je comprends pas à quoi sert :

If a = Len(vvRTBCtl.Text) - 1 Then
vlStr = vlStr & ""
vlStr = vlStr & ""
vlStr = vlStr & ""
End If

Tu fermes tes ballises pour rien non ?!?!?!
max12
13 oct. 2001 à 22:19
Sa lair inspirer de mon code
Afficher les 7 commentaires
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.