Convertir le contenu d'un richtextbox en html
Soyez le premier à donner votre avis sur cette source.
Vue 12 167 fois - Téléchargée 978 fois
Description
Le code contient une fonction qui transforme le contenu d'un RichTextBox en code HTML.
(encore!!) >> peut-être, mais j'ai pas vu d'autre code qui prenait en compte :
Gras,Italique, Souligner, aligner à gauche/centre/droite/justifier, puce, retrait avant/arrière, espaces insécables(multiples), retour à la ligne, couleur de police, nom de police, taille de police, paragraphe.
ex:RTBtest as RichtextBox, text1 as TextBox, justify as boolean
>> justify permet de dire si les paragraphes aligner à gauche sont justifier ou pas
Appel de la function : text1.text = RTBtoHTM (RTBtest,True)
C'est mon premier code, soyez indulgent, il peut surement être beaucoup améliorer...
Attention : la fonction créer uniquement le code pour le texte en s'appuyant sur les paramètres de police par défaut du RichTextBox contenant le texte à modifier
la fonction ne créer pas une page html complète
Je pense que vous devriez y jeter un ptit coup d'oeil.
(encore!!) >> peut-être, mais j'ai pas vu d'autre code qui prenait en compte :
Gras,Italique, Souligner, aligner à gauche/centre/droite/justifier, puce, retrait avant/arrière, espaces insécables(multiples), retour à la ligne, couleur de police, nom de police, taille de police, paragraphe.
ex:RTBtest as RichtextBox, text1 as TextBox, justify as boolean
>> justify permet de dire si les paragraphes aligner à gauche sont justifier ou pas
Appel de la function : text1.text = RTBtoHTM (RTBtest,True)
C'est mon premier code, soyez indulgent, il peut surement être beaucoup améliorer...
Source / Exemple :
'RTBtoHTM > Convertit le contenu d'une RichTextBox en HTML
'ex:RTBtest as RichtextBox, text1 as TextBox, justify as boolean
' >> justify permet de dire si les paragraphes aligner à gauche sont justifier ou pas
'Appel de la function : text1.text = RTBtoHTM (RTBtest,True)
'
'la function prend en charge les paramètres suivant :
'Gras,Italique, Souligner, aligner à gauche/centre/droite/justifier,
'puce, retrait avant/arrière, espaces insécables(multiples), retour à la ligne,
'couleur de police, nom de police, taille de police, paragraphe.
'
'Attention : la fonction créer uniquement le code pour le texte en s'appuyant
' sur les paramètres de police par défaut du RichTextBox contenant le texte à modifier
'
'ligne à ajouter avant RTBtoHTM (ex.): <body style="font-family: Arial; font-size: 10 pt">
'ligne à ajouter après RTBtoHTM : </body>
'
Public Function RTBtoHTM(RtbConvertHtm As RichTextBox, Alignement As Boolean) As String
Dim memDeb As Long 'mémoire de la position de départ de la selection
Dim memLong As Long 'mémoire de la taille de la selection
Dim ch As String 'caractère selectionner à convertir en HTML
Dim chProvis As String 'chaine à insérer à la fin d'un paragraphe
Dim Txtparagraphe As String 'chaine à insérer en début de paragraphe
Dim Fname As String 'chaine contenant le nom de police par défaut
Dim Fcolor As Long 'valeur contenant la couleur de texte par défaut
Dim Fsize As Single 'valeur contenant la taille de texte par défaut
Dim Ffont As String 'texte contenant le paramètre modifier de la police
Dim memFont As String 'mémoire des parametre de police
Dim retour As Boolean 'méoire pour controler les lignes sans caractère
Dim espace As Boolean 'mémoire pour controler les espaces insécables
Dim Gras As Boolean 'mémoire pour controler le changement de mise en forme
Dim Italiq As Boolean 'mémoire pour controler le changement de mise en forme
Dim Soulign As Boolean 'mémoire pour controler le changement de mise en forme
Dim Puce As Boolean 'mémoire pour controler le changement de mise en forme
Dim memRetrait As Integer 'mémoire pour controler la taille des retraits
'mise en mémoire de la sélection
memDeb = RtbConvertHtm.SelStart
memLong = RtbConvertHtm.SelLength
'initialisation des paramètres
RtbConvertHtm.SelStart = 0
RtbConvertHtm.SelLength = 1
retour = True
espace = False
Gras = False
Italiq = False
Soulign = False
Police = False
Fname = RtbConvertHtm.Font.Name
Fsize = RtbConvertHtm.Font.Size
Fcolor = 0
memFont = ""
Retrait = False
memRetrait = 0
Puce = False
'début du test des caractères du RichtextBox
GoSub BoucleParagraphe
RTBtoHTM = Txtparagraphe
For i = 0 To Len(RtbConvertHtm.Text)
RtbConvertHtm.SelStart = i
RtbConvertHtm.SelLength = 1
'si renvoi à la ligne
If RtbConvertHtm.SelText = "" Then
'si le paragraphe ne contient pas de caractère
If retour Then
'teste si on est à la fin du texte
If i = Len(RtbConvertHtm.Text) And RtbConvertHtm.SelLength = 0 Then GoTo FinText
RTBtoHTM = RTBtoHTM & "<BR>" & vbCrLf
Else
'a la fin du paragraphe, on ferme les balises htm
chProvis = ""
If Gras Then chProvis = "</B>" & chProvis
If Italiq Then chProvis = "</I>" & chProvis
If Soulign Then chProvis = "</U>" & chProvis
If memFont <> "" Then chProvis = chProvis & "</FONT>": memFont = ""
If RtbConvertHtm.SelBullet Then chProvis = chProvis & "</li>"
'puis on ferme le paragraphe
RTBtoHTM = RTBtoHTM & chProvis & "</p>" & vbCrLf
End If
'test l'alignement du texte qui suit le paragraphe actif
If i < Len(RtbConvertHtm.Text) Then
RtbConvertHtm.SelStart = i + 2
RtbConvertHtm.SelLength = 1
GoSub BoucleParagraphe
RTBtoHTM = RTBtoHTM & Txtparagraphe
End If
retour = True
i = i + 1
Else
If retour Then retour = False
'teste les caractères non compatible html
ch = TestHtm(RtbConvertHtm.SelText)
If ch = " " Then
If espace Then ch = " "
espace = True
Else
espace = False
End If
'teste quand le texte devient gras ou devient normal
If RtbConvertHtm.SelBold And Not Gras Then ch = "<B>" & ch: Gras = True
If Not RtbConvertHtm.SelBold And Gras Then ch = "</B>" & ch: Gras = False
'teste quand le texte devient gras ou devient normal
If RtbConvertHtm.SelItalic And Not Italiq Then ch = "<I>" & ch: Italiq = True
If Not RtbConvertHtm.SelItalic And Italiq Then ch = "</I>" & ch: Italiq = False
'teste quand le texte devient gras ou devient normal
If RtbConvertHtm.SelUnderline And Not Soulign Then ch = "<U>" & ch: Soulign = True
If Not RtbConvertHtm.SelUnderline And Soulign Then ch = "</U>" & ch: Soulign = False
'défini le paramètre de <FONT ...> qui change
Ffont = ""
If RtbConvertHtm.SelFontName <> Fname Then Ffont = " face=" & Chr$(34) & RtbConvertHtm.SelFontName & Chr$(34)
If RtbConvertHtm.SelFontSize <> Fsize Then Ffont = Ffont & " size=" & Chr$(34) & FontSizeHtm(RtbConvertHtm.SelFontSize) & Chr$(34)
If RtbConvertHtm.SelColor <> Fcolor Then Ffont = Ffont & " color=" & Chr$(34) & ColorHtm(RtbConvertHtm.SelColor) & Chr$(34)
If Ffont <> memFont Then
If memFont = "" Then
ch = "<FONT " & Ffont & " > " & ch
Else
If Ffont = "" Then
ch = "</FONT>" & ch
Else
ch = "</FONT><FONT " & Ffont & " >" & ch
End If
End If
End If
memFont = Ffont
RTBtoHTM = RTBtoHTM + ch
End If
Next i
FinText:
RtbConvertHtm.SelStart = memDeb
RtbConvertHtm.SelLength = memLong
Exit Function
BoucleParagraphe:
If RtbConvertHtm.SelLength = 0 Then
Txtparagraphe = ""
Else
If RtbConvertHtm.SelAlignment = 0 And Not Alignement Then Txtparagraphe = "<p style=" & Chr$(34) & "margin-top: 0; margin-bottom: 0" & Chr$(34) & ">" & vbCrLf
If RtbConvertHtm.SelAlignment = 0 And Alignement Then Txtparagraphe = "<p" & " align=" & Chr$(34) & "Justify" & Chr$(34) & " style=" & Chr$(34) & "margin-top: 0; margin-bottom: 0" & Chr$(34) & ">" & vbCrLf
If RtbConvertHtm.SelAlignment = 1 Then Txtparagraphe = "<p" & " align=" & Chr$(34) & "Right" & Chr$(34) & " style=" & Chr$(34) & "margin-top: 0; margin-bottom: 0" & Chr$(34) & ">" & vbCrLf
If RtbConvertHtm.SelAlignment = 2 Then Txtparagraphe = "<p" & " align=" & Chr$(34) & "Center" & Chr$(34) & " style=" & Chr$(34) & "margin-top: 0; margin-bottom: 0" & Chr$(34) & ">" & vbCrLf
End If
'défini les lignes à puces
If RtbConvertHtm.SelBullet Then Txtparagraphe = "<li>" & Txtparagraphe
If RtbConvertHtm.SelBullet And Not Puce Then Txtparagraphe = "<ul>" & vbCrLf & Txtparagraphe: Puce = True
If Not RtbConvertHtm.SelBullet And Puce Then Txtparagraphe = "</ul>" & vbCrLf & Txtparagraphe: Puce = False
'défini si il y a un retrait en plus ou en moins dans le paragraphe
If Round(RtbConvertHtm.SelIndent, 0) > memRetrait Then
For j = memRetrait To RtbConvertHtm.SelIndent Step 500
Txtparagraphe = "<blockquote>" & vbCrLf & Txtparagraphe
Next j
End If
If Round(RtbConvertHtm.SelIndent, 0) < memRetrait Then
For j = RtbConvertHtm.SelIndent To memRetrait Step 500
Txtparagraphe = "</blockquote>" & vbCrLf & Txtparagraphe
Next j
End If
memRetrait = RtbConvertHtm.SelIndent
Return
End Function
'TestHtm transforme les caractères spéciaux en code HTML
Public Function TestHtm(ch As String) As String
If ch = "<" Or ch = ">" Or ch = "&" Or ch = Chr$(34) Or Asc(ch) > 160 Then
TestHtm = "&#" & Trim$(Str$(Asc(ch))) & ";"
Else
TestHtm = ch
End If
End Function
'ColorHtm retourne une chaine correspondant à la couleur entrée en paramètre
' exemple pour rouge(RGB(255,0,0) >> "#FF0000"
Public Function ColorHtm(Couleur As Long) As String
Dim rouge As Integer
Dim vert As Integer
Dim bleu As Integer
rouge = Couleur - (256 * Int((Couleur - (Int(Couleur / 65536) * 65536)) / 256) + (65536 * Int(Couleur / 65536)))
vert = Int((Couleur - (Int(Couleur / 65536) * 65536)) / 256)
bleu = Int(Couleur / 65536)
ColorHtm = "#" & Right$("0" & Hex$(rouge), 2) & Right$("0" & Hex$(vert), 2) & Right$("0" & Hex$(bleu), 2)
End Function
'FontSizeHtm retourne le code des taille valide en HTML
Function FontSizeHtm(taille As Single) As String
If taille <= 9 Then FontSizeHtm = "1"
If taille > 9 And taille <= 11 Then FontSizeHtm = "2"
If taille > 11 And taille <= 13 Then FontSizeHtm = "3"
If taille > 13 And taille <= 16 Then FontSizeHtm = "4"
If taille > 16 And taille <= 21 Then FontSizeHtm = "5"
If taille > 21 And taille <= 30 Then FontSizeHtm = "6"
If taille > 30 Then FontSizeHtm = "7"
End Function
Conclusion :
Attention : la fonction créer uniquement le code pour le texte en s'appuyant sur les paramètres de police par défaut du RichTextBox contenant le texte à modifier
la fonction ne créer pas une page html complète
Je pense que vous devriez y jeter un ptit coup d'oeil.
Codes Sources
A voir également
- Vbet retrait
- Richtextbox html - Meilleures réponses
- Memlong - Meilleures réponses
- Visual Basic / VB.NET : Convertir le contenu d'une richtextbox en html (vb.net) - CodeS SourceS - Guide
- Convertir rtf/text richtextbox en Html, Binaire, Héxadécimale et Décimale VB.NET ✓ - Forum - VB.NET
- Visual Basic / VB.NET : Imprimer le contenu d'un richtextbox - CodeS SourceS - Guide
- PHP : Afficher / convertir un array php multidimention en tableaux html inbriqué - print_r - - Guide
- Convertir le contenu d'un label ✓ - Forum - Visual Basic 6
(tableau comparatif des paramètres du richtexbox entre VB6 et 2005)
http://msdn2.microsoft.com/en-us/library/ms234980(vs.80).aspx
Très bonne source, bravo.
Faudrait juste éviter les goto et les gosub. Crée des procédure ou des fonctions pour tes routines...
- Messages postés
-
24
- Date d'inscription
- jeudi 27 avril 2006
- Statut
- Membre
- Dernière intervention
- 23 juin 2007
1Résultat rien a dire même une personne qui n'a jamais programer en HTML peut le faire.
Bravo 10/10
Gaël, je ne sais pas si tu connais MZTools, c'est un Addin pour VB, très pratique pour plein de choses et notamment pour faciliter l'écriture systématique d'entêtes de fonctions et modules. C'est un logiciel gratuit disponible ici: http://www.mztools.com/
Pour le lien de "nofutur", ça à l'air cool, mais bigrement compliqué, et pis chez moi, il manque certains éléments pour pouvoir le tester...
@+
Moi j'avais trouvé il y a longtemps un module similaire que je n'ai jamais eu le temps de tester mais qui reste très complet. Peut être que sa structure te donnera des idées pour améliorer ta source :-)
http://www2.bitstream.net/~bradyh/downloads/rtf2htmlrm.html
Bonne prog ^_^
@plus!
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.