1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
Option Explicit
Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias _
"CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String _
, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal X As Long _
, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long _
, ByVal hwndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long _
, lpParam As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Const WC_RICHEDIT1 = "RichEdit"
Private Const WC_RICHEDIT2 = "RichEdit20A"
Private Const WS_CHILD = &H40000000
Private Const ES_MULTILINE = &H4&
Private Const WM_SETTEXT = &HC
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Sub Form_Load()
Dim pRTF As String
pRTF = "{\rtf1\ansi\ansicpg1252\deff0\deflang1036{\fonttbl{\f0\fnil\fcharset0 MS Shell Dlg;}} {\*\generator Msftedit 5.41.21.2510;}\viewkind4\uc1\pard\f0\fs17 face A: 1 inter SA avec pr\'e9cablage \'e0 1300mm du sol + cordon d'alim 3g1.5 5m etEnsto noir + d\'e9coupe pourluminaire \'e0 Ht1900mm\par face B: 3PC Norm RAL7035 sur cordon Ensto male lg5m HO7 3g2.5 \par } "
Debug.Print RTFtoTEXT(pRTF)
End Sub
Function RTFtoTEXT(pRTF As String) As String
Dim lLen As Long
Dim ltext As String
Dim lClass As String
Dim lHwnd As Long
On Error GoTo Gestion_Erreurs
' Chargement librairie
' cf http://msdn2.microsoft.com/en-us/library/bb787873(VS.85).aspx
If LoadLibrary("Riched20.dll") > 32 Then
lClass = WC_RICHEDIT2
ElseIf LoadLibrary("Riched32.dll") > 32 Then
lClass = WC_RICHEDIT1
End If
' Crée une fenêtre avec editeur de texte
lHwnd = CreateWindowEx(0, lClass, vbNullString, _
WS_CHILD Or ES_MULTILINE, 0, 0, 0, 0, Me.hwnd, 0&, 0&, ByVal 0&)
' Injecte le texte dans le contrôle
SendMessage lHwnd, WM_SETTEXT, Len(pRTF), ByVal pRTF
' Relit le texte sans balises RTF
lLen = SendMessage(lHwnd, WM_GETTEXTLENGTH, 0, ByVal 0)
ltext = Space(lLen + 1)
ltext = Left(ltext, SendMessage(lHwnd, WM_GETTEXT, lLen + 1, ByVal ltext))
RTFtoTEXT = ltext
Gestion_Erreurs:
' Supprime le contrôle
DestroyWindow lHwnd
End Function |
