Save the text of a richTextBox as image

[Gianni]

Hi to all

How to save the text of a richTextBox as image,
when the whole client area of the RichTextBox is not visible on the screen?

Thanks for suggestions

[wolf_kof]

you have to do first is Colola the field of database as a blob and then save the data in binary form.
lo que tienes que hacer primero es cololar el campo de la base de datos como blob y despues guardar los datos en forma binaria.


I use this to save the images.
yo utilizo esto para guardar las imagenes.

Modulo

Código: (vb) [Seleccionar]

Public Function ImportImagen(item As ADODB.Field, pic As Image)
Dim Stream As ADODB.Stream
Set Stream = New ADODB.Stream
Stream.Type = adTypeBinary
Stream.Open
Stream.Write item.Value
Stream.SaveToFile App.Path & "\temp", adSaveCreateOverWrite
    pic.Picture = LoadPicture(App.Path & "\temp")
Kill App.Path & "\temp"
End Function

Public Function ExportImagen(urlimg As String, item As ADODB.Field)
On Error GoTo errimg
Dim Stream As ADODB.Stream
Set Stream = New ADODB.Stream
Stream.Type = adTypeBinary
Stream.Open
Stream.LoadFromFile urlimg
item.Value = Stream.Read
Exit Function
errimg:
    MsgBox "La imagen es demasiado grande"
End Function


codigo

Código: (vb) [Seleccionar]

'Exportar con un rs de un ado y un campo foto blob
ExportImagen foto.FileName, rs.Fields("foto")

'importar con un rs de un ado y un campo foto bob
ImportImagen rs.Fields("foto"), Picture1

in your case is a richtexbox text that does not matter.
en tu caso es texto a un richtexbox que da lo mismo.

I am the creator of the code to if that question .....
soy el creador del codigo a si que pregunta.....

[LeandroA]

wolf_kof creo que lo que el se refiere es como guardar en forma de imagen (.bmp)  una captura del control completo

Add Picture1 and RichTextBox1 (visible = false)

Código: [Seleccionar]

Option Explicit
Private Declare Function GetClientRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
Private Const WM_PAINT As Long = &HF&

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type



Private Sub Command1_Click()
    Dim Rec As RECT
    GetClientRect RichTextBox1.hwnd, Rec
   
    With Picture1
        .AutoRedraw = True
        .BorderStyle = 0
        .Width = (Rec.Right - Rec.Left) * Screen.TwipsPerPixelX
        .Height = (Rec.Bottom - Rec.Top) * Screen.TwipsPerPixelY
        SendMessage RichTextBox1.hwnd, WM_PAINT, .hDC, ByVal 0&
        SavePicture .Image, "c:\captura.bmp"
    End With
End Sub


[Gianni]

Hello and thanks for reply.

Hi have tried with Leandro suggestion, but I get an image of the same size as the Richtextbox.
Sorry, maybe I did not explained well.
 
I need to get all text in Richtextbox, also the non visible text.

I'm using a microsoft suggestion for get the size of Richtextbox http://support.microsoft.com/kb/257849/en-us
and this Function for display Text on DC:

Código: [Seleccionar]

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

'cDIBSection is a class for DIB creation
Public Function DisplayRTBtoDIB(RTB As RichTextBox, PB As cDIBSection) As Boolean

On Error GoTo ErrorHandler
     
    Dim typFr As FormatRange
    Dim rectDraw As rect      'Region of the DC to draw to (in twips)
    Dim rectPage As rect      'Region of the entire DC (page size) (in twips)
    Dim lngTxtLen As Long
    Dim lngPos As Long
    Dim lngRet As Long
    Dim DibW As Long
    Dim DibH As Long
   
    If PB.hdc = 0 Then DisplayRTBtoDIB = False: Exit Function
   
    DibW = PB.Width * Screen.TwipsPerPixelX
    DibH = PB.Height * Screen.TwipsPerPixelY
   
   'Region of the entire DC (page size) (in twips)
   rectPage.Left = 0
   rectPage.Top = 0
   rectPage.Right = DibW
   rectPage.Bottom = DibH
   
   ' Set rect in which to print (relative to printable area)
   rectDraw.Left = 10 * Screen.TwipsPerPixelX
   rectDraw.Top = 0
   rectDraw.Right = (Form1.picOut.ScaleWidth - 10) * Screen.TwipsPerPixelX
   rectDraw.Bottom = DibH

   ' Set up
   typFr.hdc = PB.hdc 'for rendering
   typFr.hdcTarget = PB.hdc 'for formatting
   typFr.rc = rectDraw ' Indicate the area on page to draw to
   typFr.rcPage = rectPage 'Indicate entire size of page
   typFr.chrg.cpMin = 0
   typFr.chrg.cpMax = -1
   
   ' Get length of text in the RichTextBox Control
   lngTxtLen = Len(RTB.Text)
   
        'Display the Page By sending EM_FORMATRANGE message
        lngPos = SendMessage(RTB.hwnd, EM_FORMATRANGE, True, typFr)
   
   'frees memory
   lngRet = SendMessage(RTB.hwnd, EM_FORMATRANGE, False, Null)
   
   DisplayRTBtoDIB = True
   
   Exit Function
   
ErrorHandler:

   Err.Raise Err.Number, , Err.Description
   
End Function
This code working well If I use short text file, but Sometimes with large text No.
 
This happens when there is a difference between
 

Código: [Seleccionar]

lngTxtLen = Len(RTB.Text) and 

Código: [Seleccionar]

lngPos = SendMessage(RTB.hwnd, EM_FORMATRANGE, True, typFr)

Part of the last text is not displayed.
I thought the size of Dib created and I tried to add Pixel, but this don't solve the problem.

I'm stuck

Have you others suggestions?
Where am I wrong?

Thanks again