You know how in microsoft word you can insert a picture into your document, is that possible in a rich text box? If so, how would you go about it, thanks for help.
Printable View
You know how in microsoft word you can insert a picture into your document, is that possible in a rich text box? If so, how would you go about it, thanks for help.
He is a little app that pastes a picture into a RichtextBox. I am sure it can be adapted. I didn't make the app.
Thanks that just what i wanted:D
VB Code:
Option Explicit Private Type Size cx As Long cy As Long End Type Private Type POINTAPI x As Long y As Long End Type Private Type BITMAP bmType As Long bmWidth As Long bmHeight As Long bmWidthBytes As Long bmPlanes As Integer bmBitsPixel As Integer bmBits As Long End Type 'Private Type METAHEADER ' mtType As Integer ' mtHeaderSize As Integer ' mtVersion As Integer ' mtSize As Long ' mtNoObjects As Integer ' mtMaxRecord As Long ' mtNoParameters As Integer 'End Type ' Used to create the metafile Private Declare Function CreateMetaFile Lib "gdi32" Alias "CreateMetaFileA" (ByVal lpString As String) As Long Private Declare Function CloseMetaFile Lib "gdi32" (ByVal hDCMF As Long) As Long Private Declare Function DeleteMetaFile Lib "gdi32" (ByVal hMF As Long) As Long ' 6 APIs used to render/embed the bitmap in the metafile Private Declare Function SetMapMode Lib "gdi32" (ByVal hdc As Long, ByVal nMapMode As Long) As Long Private Declare Function SetWindowExtEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpSize As Size) As Long Private Declare Function SetWindowOrgEx Lib "gdi32" (ByVal hdc As Long, ByVal nX As Long, ByVal nY As Long, lpPoint As POINTAPI) As Long Private Declare Function SaveDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare Function RestoreDC Lib "gdi32" (ByVal hdc As Long, ByVal nSavedDC As Long) As Long ' These APIs are used to BitBlt the bitmap image into the metafile Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long ' Used for creating the temporary WMF file Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Const MM_ANISOTROPIC = 8 ' Map mode anisotropic Public Function StdPicAsRTF(aStdPic As StdPicture) As String Dim hMetaDC As Long Dim hMeta As Long Dim hPicDC As Long Dim hOldBmp As Long Dim aBMP As BITMAP Dim aSize As Size Dim aPt As POINTAPI Dim fileName As String ' Dim aMetaHdr As METAHEADER Dim screenDC As Long Dim headerStr As String Dim retStr As String Dim byteStr As String Dim bytes() As Byte Dim filenum As Integer Dim numBytes As Long Dim i As Long ' Create a metafile to a temporary file in the registered windows TEMP folder fileName = getTempName("WMF") hMetaDC = CreateMetaFile(fileName) ' Set the map mode to MM_ANISOTROPIC SetMapMode hMetaDC, MM_ANISOTROPIC ' Set the metafile origin as 0, 0 SetWindowOrgEx hMetaDC, 0, 0, aPt ' Get the bitmap's dimensions GetObject aStdPic.Handle, Len(aBMP), aBMP ' Set the metafile width and height SetWindowExtEx hMetaDC, aBMP.bmWidth, aBMP.bmHeight, aSize ' save the new dimensions SaveDC hMetaDC ' OK. Now transfer the freakin image to the metafile screenDC = GetDC(0) hPicDC = CreateCompatibleDC(screenDC) ReleaseDC 0, screenDC hOldBmp = SelectObject(hPicDC, aStdPic.Handle) BitBlt hMetaDC, 0, 0, aBMP.bmWidth, aBMP.bmHeight, hPicDC, 0, 0, vbSrcCopy SelectObject hPicDC, hOldBmp DeleteDC hPicDC DeleteObject hOldBmp ' "redraw" the metafile DC RestoreDC hMetaDC, True ' close it and get the metafile handle hMeta = CloseMetaFile(hMetaDC) ' GetObject hMeta, Len(aMetaHdr), aMetaHdr ' delete it from memory DeleteMetaFile hMeta ' Do the RTF header for the object. This little bit is sometimes required on ' earlier versions of the rich text box and in certain operating systems ' (WinNT springs to mind) headerStr = "{\rtf1\ansi" ' Picture specific tag stuff headerStr = headerStr & _ "{\pict\picscalex100\picscaley100" & _ "\picw" & aStdPic.Width & "\pich" & aStdPic.Height & _ "\picwgoal" & aBMP.bmWidth * Screen.TwipsPerPixelX & _ "\pichgoal" & aBMP.bmHeight * Screen.TwipsPerPixelY & _ "\wmetafile8" ' Get the size of the metafile numBytes = FileLen(fileName) ' Create our byte buffer for reading ReDim bytes(1 To numBytes) ' get a free file number filenum = FreeFile() ' open the file for input Open fileName For Binary Access Read As #filenum ' read the bytes Get #filenum, , bytes ' close the file Close #filenum ' Generate our hex encoded byte string byteStr = String(numBytes * 2, "0") For i = LBound(bytes) To UBound(bytes) If bytes(i) > &HF Then Mid$(byteStr, 1 + (i - 1) * 2, 2) = Hex$(bytes(i)) Else Mid$(byteStr, 2 + (i - 1) * 2, 1) = Hex$(bytes(i)) End If Next i ' stick it all together retStr = headerStr & " " & byteStr & "}" ' Add in the closing RTF bit retStr = retStr & "}" StdPicAsRTF = retStr On Local Error Resume Next ' Kill the temporary file If Dir(fileName) <> "" Then Kill fileName End Function Private Function getTempName(Optional anExt As String = "tmp") As String ' *********************************************************************** ' Author: The Hand ' Date: June, 2002 ' Company: EliteVB ' ' Function: getTempName ' Arguments: anExt - an extension to be used for the temp file. If none ' is provided, the function automatically uses "tmp" ' as the extension. It is up to the procedure that ' uses this temporary name to clean up the file (kill ' it) after it is created. ' ' Description: ' Creates a temporary filename in the registered system temp directory ' *********************************************************************** Dim tempPath As String Dim fileName As String Dim i As Long Const validChars As String = "123567890qwertyuiopasdfghjklzxcvbnm" ' Create a buffer tempPath = String$(255, " ") ' get the system path GetTempPath 255, tempPath ' trim off the fat tempPath = Left$(tempPath, InStr(tempPath, Chr$(0)) - 1) ' Create a buffer fileName = Space(12) ' Put the non-random stuff into the string Mid$(fileName, 1, 1) = "T" Mid$(fileName, Len(fileName) - Len(anExt), 1) = "." ' Add in the specified extension, if provided ("tmp" is default) Mid$(fileName, Len(fileName) - Len(anExt) + 1, Len(anExt)) = anExt ' fill the buffer with random stuff Randomize For i = 2 To Len(fileName) - 4 Mid$(fileName, i, 1) = Mid$(validChars, CLng(Rnd() * (Len(validChars)) + 1), 1) Next i tempPath = tempPath & fileName ' return the path name getTempName = tempPath End Function Private Sub Command1_Click () Pic.Picture = LoadPicture("c:\pic.bmp") Dim aStr As String aStr = StdPicAsRTF(Pic.Picture) RichTextBox.SelRTF = aStr End Sub
I think this will help you!
Another helpful piece of code, thanks:bigyello:
;) Thanks!
Expert in RichText Box control!