Visual Basic Foro
Programación => Visual Basic 6 => Mensaje iniciado por: Gianni en Enero 21, 2011, 12:02:15 pm
-
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
-
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
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
'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.....
-
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)
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
-
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 (http://support.microsoft.com/kb/257849/en-us)
and this Function for display Text on DC:
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
lngTxtLen = Len(RTB.Text) and 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