Visual Basic, VB6, VB.NET, VB 2005, VB CodeS-SourceS

CodeS-SourceS est hébergé par Frontier.fr

Cliquez ici pour mettre ce site au démarrage de votre navigateur

AccueilCodesTutorielsForumsEmploiLivresGuide achatConnexion

begin process at 2009 07 05 22:33:37

SILVERLIGHT 3 : COMMUNICATION ET MULTICAST par KooKiz

[PERSO] DéCOUVERTES ESTIVALES : LINUX (PART I) par FREMYCOMPANY

[REFACTORING] RESHARPER POUR VISUAL STUDIO 2010 (PREVIEW) par tja

[REFACTORING] ANALYSER VOS EXCEPTIONS AVEC RESHARPER EXCEPTIONAL par tja

SHAREPOINT 2007 : PATTERNS & PRACTICES SHAREPOINT GUIDANCE par phil

RE : PROBLEME DANS BASE DE DONNéES par Tursiop60

RE : PROBLEME DANS BASE DE DONNéES par PCPT

RE : FUSIONNER 2 PROJETS ? COMMENT FAIRE ? par steeventide

RE : PROBLEME DANS BASE DE DONNéES par Tursiop60

+ de logiciels à télécharger

1 464 911 membres
377 nouveaux aujourd'hui
15 045 membres club

Trouver une ressource

Trouvez une ressource parmi 40 095 codes, 1 303 022 messages d'aide etc...

Recherche: dans [ Dernières recherches ]

Filtre:Tous les codes.NET uniquementExclure .NET

Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

RTF --> CODE HTML

Information sur la source

Catégorie :Control Classé sous : rtf, html, conversion, convertisseur, convert Niveau : Débutant Date de création : 09/10/2001 Vu : 5 039

Auteur : Caïn

Site perso

Ecrire un message privé

Note :

10,00 / 10

Commentaire sur cette source (4)

Ajouter un commentaire et/ou une note

Description

Source

'##########################################################################################
'# 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 & ""
End If
If vvRTBCtl.SelBold = False And IsBold = True Then
IsBold = False
vlStr = vlStr & ""
End If
'Mettre en souligner
If vvRTBCtl.SelUnderline = True And IsUnderline = False Then
IsUnderline = True
vlStr = vlStr & ""
End If
If vvRTBCtl.SelUnderline = False And IsUnderline = True Then
IsUnderline = False
vlStr = vlStr & ""
End If
'Mettre en italic
If vvRTBCtl.SelItalic = True And IsItalic = False Then
IsItalic = True
vlStr = vlStr & ""
End If
If vvRTBCtl.SelItalic = False And IsItalic = True Then
IsItalic = False
vlStr = vlStr & ""
End If
If Asc(Mid(vvRTBCtl.Text, a + 1, 1)) = vbKeyReturn Then
vlStr = vlStr & " "
Else
vlStr = vlStr & Mid(vvRTBCtl.Text, a + 1, 1)
End If
If a = Len(vvRTBCtl.Text) - 1 Then
vlStr = vlStr & ""
vlStr = vlStr & ""
vlStr = vlStr & ""
End If
Next
convertRTFtoHTML = vlStr
End Function

'##########################################################################################
'# 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.

Sources de la même categorie

LABEL ET IMAGE DANS TEXTBOX par gillardg

GRADIENTDIALOG - SÉLECTION DE DÉGRADÉS LINÉAIRES par Mayzz

EXLISTVIEW- LISTVIEW PERSONNALISÉ par Mayzz

VB6-INNO-WIZARD par cdbi

BOUTON SOUS PLUSIEURS FORME par noah56

Toutes les sources de la catégorie Control

Sources en rapport avec celle ci

HEXA/ASCII AVEC POSSIBILITÉ DE FICHIER par XRaph

CONVERTISSEUR RTF TO HTML par tontonkika

TRADUCTEUR VB6.VBP EN VB5.VBP par joro

RTF ---> HTML par max12

CONVERSION DE CODES RTF VERS HTML par blq

Commentaires et avis

Commentaire de leptidev le 25/03/2002 13:00:10

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 ?!?!?!

Commentaire de yasr le 18/08/2003 17:19:05

Les liens ne fonctionnent pas!

Commentaire de tontonkika le 10/01/2005 13:46:44

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 & "<div align=""" & strAlign & """>"
 '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 & "</div><div align=""" & strAlign & """>"
 End If

 If b_netscape4 Then
 'traitement de la taille du texte
 strHTML = strHTML & "<font family=""" & Box.SelFontName & _
 """ size=""" & Math.Round(Box.SelFontSize * 0.29, 0) & """ color=""" _
 & colorTmp & """>"
 Else
 s_diez = "#"

 strHTML = strHTML & "<span style=""font-family: " _
 & Box.SelFontName & _
 "; font-size: " & Box.SelFontSize & _
 "pt; color: " & s_diez & _
 colorTmp & """>"
 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 & "</div>"
 '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

Commentaire de l0st3d le 09/11/2005 09:58:45

Merci pour la source, c'est vraiment très utile

10/10

Ajouter un commentaire

Discussions en rapport avec ce code source dans le forum

SVP Help me >Conversion rtf html [ par pekinio ] hello a tlmvoila, en fait, je voudrais enregistrer le contenu d'une rtf box , avec caracteres en couleurs, eventuellement des photos et tout, en html. Bilan => Conversion Rtf to HTML ! Propriétés Emplacement [ par scottmat ] HTML [ par Spag ] Aaargh mais comment diable puis-je convertir un fichier excel au format HTML depuis VB et ASP ??Merci à celui qui a la réponse! :) Conversion Word -> HTML [ par Thermosam ] Il me faudrait les sources d'un programme qui à partir d'un fichier Word génère un fichier correspondant en HTML (avec tous les TAGS). Conversion RTF/TXT -> HTML [ par OneHacker ] Je programme avec VS Express 2005 .NET. Je voulais savoir s'il était possible de convertir du texte simple HTML ou du RTF en HTML.J'ai essayé ça mais Conversion HTML vers PS [ par Didierdu92 ] Bonjour,J'aurais besoin d'une fonction qui sache convertir du HTML en postscript et si possible en VB6.Je vous remercie par avance des infos que vous conversion de pdf en html [ par kevinou55 ] bonjour a tous,voila j'essaie de faire un programme qui recupere un texte tapé dans Word, le convertit en Pdf avec PDFCreator puis le retranscrit en h Rtf to Html via Word automation [ par pattex62 ] Rtf to Html via Word automation Bonjour à tous !!! Je souhaiterais convertir le contenu d'un Richtexbox (format RTF) en format HTML !!! </p conversion html en pdf [ par dahouetagnes ] Bonjour,Est il possible de convertir un fichier .html en un fichier pdf en visual basic 6 ?Et si oui de quelle façon ?Merçi.dahouet Imprimer un fichier (html. rtf..) en VB? [ par jeromax ] Tout est dit dans le sujetMerci