Bonjour,
Je souhaite obtenir une image (à mettre dans un picture) d'un RichTRextBox y compris si ce contrôle n'est pas entièrement affiché à l'écran. Le problème est que la méthode DrawToBitmap n'existe pas avec un RichTextBox et qu'en utilisant l'API BitBlt, cela ne fonctionne que si le RichTextBox est entièrement affiché sur l'écran.
J'ai trouvé une solution qui répond au besoin, qui fonctionne en VB6 (j'ai testé en réinstallant VB6 sous W7) maisn'est même pas compilable en VB.NET (Visual Studio 2013 Community). A toutes fins utiles, je vous donne le source trouvé sur la toile. Si quelqu'un de suffisamment pointu pouvait en faire une "traduction" en VB.NET, ce serait le bonheur.
Le source suppose que l'on a les contrôles suivants sur le formulaire : RichTextBox1, Picture1 (PictureBox) et un bouton Command1.
Merci d'avance

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
60
61
62
63
64
   Option Explicit
 
    Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
    End Type
 
    Private Type CharRange
        cpMin As Long ' First character of range (0 for start of doc)
        cpMax As Long ' Last character of range (-1 for end of doc)
    End Type
 
    Private Type FormatRange
        hdc As Long ' Actual DC to draw on
        hdcTarget As Long ' Target DC for determining text formatting
        rc As RECT ' Region of the DC to draw to (in twips)
        rcPage As RECT ' Region of the entire DC (page size) (in twips)
        chrg As CharRange ' Range of text to draw (see above declaration)
    End Type
 
    Private Const WM_USER As Long = &H400
    Private Const EM_FORMATRANGE As Long = WM_USER + 57
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wp As Long, lp As Any) As Long
 
    Private Sub RTF_TO_PIC(RTF As RichTextBox, Pic As PictureBox)
        Dim fr As FormatRange, NextCharPosition As Long, R As Long
        Dim rcDrawTo As RECT
        Dim rcPage As RECT
 
        Pic.AutoRedraw = False
        Pic.Cls
        Pic.BackColor = vbWhite
 
        ' Set printable area rect
        rcPage.Left = 0
        rcPage.Top = 0
        rcPage.Right = Pic.ScaleWidth
        rcPage.Bottom = Pic.ScaleHeight
 
        ' Set rect in which to print (relative to printable area)
        rcDrawTo.Left = 0
        rcDrawTo.Top = 0
        rcDrawTo.Right = Pic.ScaleWidth
        rcDrawTo.Bottom = Pic.ScaleHeight
 
        fr.hdc = Pic.hdc ' Use the same DC for measuring and rendering
        fr.hdcTarget = Pic.hdc ' Point at printer hDC
        fr.rc = rcDrawTo ' Indicate the area on page to draw to
        fr.rcPage = rcPage ' Indicate entire size of page
        fr.chrg.cpMin = 0 ' Indicate start of text through
        fr.chrg.cpMax = -1 ' end of the text
 
        NextCharPosition = SendMessage(RTF.hwnd, EM_FORMATRANGE, True, fr)
 
        R = SendMessage(RTF.hwnd, EM_FORMATRANGE, False, ByVal CLng(0))
 
        Pic.AutoRedraw = True
    End Sub
 
    Private Sub Command1_Click()
        RTF_TO_PIC RichTextBox1, Picture1
    End Sub