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

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

Ce site au démarrage

begin process at 2012 02 16 00:28:24

Accueil Codes Tutoriels Forum Livres Emploi Services Connexion

Trouver un code source :

dans

[ Dernières recherches ]

Accueil >

RTF --> CODE HTML

Information sur la source

Note :

10,00 / 10

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

Auteur : Caïn

Ecrire un message privé

Site perso

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

COMMUNICATION MODBUS MASTER par sergelapointe

DÉPLACEMENT AVEC FLÈCHES DANS UN PAVÉ DE TEXTBOX 9X9 DYNAMIQ... par EhJoe

CONTROLSTARS EN RÉPONSE À JAKNIGHT007 par bigboss9

CALENDRIER ANNUEL NORME ISO par Prog1001

CONTROLE STARS par jaknight007

Toutes les sources de la catégorie Control

Sources en rapport avec celle ci

CONVERTIR DU TEXTE RTF EN CODE HTML ET VICE-VERSA par vicosta

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 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 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 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 Rtf Richtextbox vers html [ par amita ] salut les amis surment que j'ai trové plein de source concernant cette question mais ce que j'arrive pas a trouver c'est comment convertir une image i

Nos sponsors

Derniers Blogs

GESTION D'EXCEPTION AVEC LES TASKS par richardc

DéMARRONS AVEC LES TASKS par richardc

SLIDE & DéMO TECHDAYS 2012 - FAST & FURIOUS XAML APPS par Vko

XNA IS DEAD! par richardc

TECHDAYS PARIS 2012 : WINDOWS SERVER "8" QUOI DE 9 ! par ROMELARD Fabrice

Forum

RE : PROBLèME VéRIFICATION MD5 DEPUIS UN ENCLENCHEMENT DE BOUTON. par NHenry

RE : OUVRIR PLUSIEURS FICHIERS EXCEL EN MêME AVEC VB par ossama261988

ACCES ODBC par yannickcottin

RE : PROBLEME PROCEDURE FERMETURE FORM par thomasaurelien

RE : PROBLEME PROCEDURE FERMETURE FORM par ShayW

Côté IT

Offres d'emploi

Formations Video

Appels d'offres

Finalisation site d-encheres au centime
Budget : 2 800€
Recherche expert webmarketing
Budget : 3 000€
Republication - fichier d-export de site OS commerce ver plateforme logistique-CDC disponible
Budget : 1 200€

Logiciels

DocTranslate (V3.1.0.0)
DOCTRANSLATE (V3.1.0.0)

DocTranslate est un traducteur de document Microsoft Word, PowerPoint et Excel. Il permet d'autom...

Cliquez pour télécharger DocTranslate
Tribler (2012)
TRIBLER (2012)

Tribler est un client pair à pair (P2P/Peer-to-Peer) open source avec la capacité de regarder des...

Cliquez pour télécharger Tribler
OneSwarm (2012)
ONESWARM (2012)

Le peer-to-peer qui protège votre vie privée, c'est OneSwarm. Ce logiciel de peer-to-peer crypté...

Cliquez pour télécharger OneSwarm
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)
PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO (V8.4)

PONAMEDIA TV DEVIENS HELLLOOO FLASH LA TV SUR VOTRE ORDINATEUR. Toute une plateforme Multi...

Cliquez pour télécharger PONAMEDIA PREMIUM - HELLLOOO FLASH DEMO
Academy System (17.2.1.0)
ACADEMY SYSTEM (17.2.1.0)

Logiciel de gestion des établissements. - élèves/étudiants (inscription, dossier, absence...) -...

Cliquez pour télécharger Academy System