在Richtextbox中插入图片，却成了图标

Question

我用以下方法在RICHTEXTBOX中插入图片：方法一：
Picture1.Picture = LoadPicture(App.Path + "\1.bmp")
DoEvents
Clipboard.Clear
Clipboard.SetData Picture1.Picture
SendMessage RichTextBox1.hwnd, WM_PASTE, 0, 0   这个方法对于RichTextBox1中的内容是纯英文的情况，好使! 一旦中英混合，位置就较难确定了。方法二：Clipboard.SetData LoadPicture(App.Path + "\1.bmp")
RichTextBox1.SetFocus
SendKeys "^v", True   中英混排，位置较难确定。方法三：RichTextBox1.OLEObjects.Add , , App.Path + "\1.bmp"  这个方法，位置好确定。问题是：同样的程序，有的电脑上显示图片，有的则显示1.bmp对应的图标，且显示图标时还打开对应的图片阅读编辑的默认工具。请问如何做，让 方法三 能够正常显示图片？

Answer 1

本帖最后由 bcrun 于 2011-05-16 12:37:09 编辑

  

Answer 2

我想用RichTextBox1.OLEObjects.Add , , App.Path + "\1.bmp"
插入图片，就是不知道，为什么在我的一台电脑上没有问题，另一个就不行了。最好能给一个解决办法

Answer 3

这个是调用OLE对象，不会有那种效果的。

Answer 4

搜索了一下，MSDN里也没说清楚，只是说调用者或环境支持还是不支持造成的

Answer 5

环境支持还是不支持,这个能判断么？以前我的一台电脑装VISTA，是支持的，我的程序在上边通过了，这次重新装了，就不行了

Answer 6

昨天将VISTA的系统重新做了一下，RichTextBox1.OLEObjects.Add , , App.Path + "\1.bmp"
这个语句又正常了，先说明一下，没有安装PHOTOSHOP CS3，要是安装了这个就不能保证了。我的三台电脑，一个上边装的是PHOTOSHOP 6.0，没有问题，另2台是PHOTOSHOP CS3，就有问题，后来将PHOTOSHOP CS3卸载了，可问题也解决不了。我怀疑是PHOTOSHOP CS3出的问题谁有遇到过这个问题的，能解决么？

Answer 7

通过剪贴板，传给RichTextBox是一个点阵
加载对象OLEObjects，传给RichTextBox是一个文件对象，
内容肯定不一样，至少文件对象是有文件头的。
你可以保存RichTextBox为rtf查看图片位置的数据段
我都怀疑，OLEObjects，传给RichTextBox后，rtf会是一个链接，根本就没有实际数据。
我的系统不能实测，见谅～～

Answer 8

rtf用记事本打开看，不要用word、写字板查看。

Answer 9

RichTextBox 与word类似，数据是按rtf协议组织的。word所用的rtf是标准rtf协议的扩展。

Answer 10

如何保存数据的，没有深入的研究。如果RICHTEXTBOX与WORD一样是按照RTF协议组织的，但当我插入图片不能成功的时候，为何用WORD插入图片没有任何问题，如何做到像WORD一样不受“环境”影响插入图片？

Answer 11

WORD 在你插入图片时后台是做过手脚的～
这一点我不用证明如果你想真正解决这个问题，我给你一个思路
1，用剪切板把图片保存进去
2，保存为rtf文件
3，二进制打开文件比对图片所占的数据区 与 图片原始数据区别（主要注意文件头处理和编码）
4，找出规律，然后用代码实现。
OK

Answer 12

你可以问问 lihonggen0
http://topic.csdn.net/t/20030910/20/2246180.html

Answer 13

Option ExplicitPrivate Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" _
   (ByVal lpDriverName As String, ByVal lpDeviceName As String, _
   ByVal lpOutput As Long, ByVal lpInitData As Long) As Long' added by Merri 2010-08-10
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" ( _
    Arr() As Any _
) As LongPrivate 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 LongPrivate Declare Function CreateCompatibleDC Lib "gdi32" ( _
    ByVal hDC As Long _
) As LongPrivate Declare Function CreateMetaFile Lib "gdi32" Alias "CreateMetaFileA" ( _
    ByVal lpString As String _
) As LongPrivate Declare Function CloseMetaFile Lib "gdi32" ( _
    ByVal hDCMF As Long _
) As LongPrivate Declare Function DeleteMetaFile Lib "gdi32" ( _
    ByVal hmf As Long _
) As LongPrivate Declare Function DeleteDC Lib "gdi32" ( _
    ByVal hDC As Long _
) As LongPrivate Declare Function DeleteObject Lib "gdi32" ( _
    ByVal hObject As Long _
) As LongPrivate Declare Function GetObject Lib "gdi32" Alias "GetObjectA" ( _
    ByVal hObject As Long, _
    ByVal nCount As Long, _
    lpObject As Any _
) As LongPrivate Declare Function GetDC Lib "user32" ( _
    ByVal hWnd As Long _
) As Long' added by Merri 2010-08-10
Private Declare Function GetMetaFileBitsEx Lib "gdi32" ( _
    ByVal hmf As Long, _
    ByVal nSize As Long, _
    Buffer As Any _
) As Long' added by Merri 2010-08-10
Private Declare Sub PutMem4 Lib "msvbvm60" ( _
    ByVal Ptr As Long, _
    ByVal Value As Long _
)Private Declare Function ReleaseDC Lib "user32" ( _
    ByVal hWnd As Long, _
    ByVal hDC As Long _
) As LongPrivate Declare Function RestoreDC Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nSavedDC As Long _
) As LongPrivate Declare Function SetMapMode Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nMapMode As Long _
) As LongPrivate Declare Function SetWindowExtEx Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nX As Long, _
    ByVal nY As Long, _
    lpSize As Size _
) As LongPrivate Declare Function SetWindowOrgEx Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal nX As Long, _
    ByVal nY As Long, _
    lpPoint As POINTAPI _
) As LongPrivate Declare Function SaveDC Lib "gdi32" ( _
    ByVal hDC As Long _
) As LongPrivate Declare Function SelectObject Lib "gdi32" ( _
    ByVal hDC As Long, _
    ByVal hObject As Long _
) As Long' added by Merri 2010-08-10
Private Declare Function SysAllocStringByteLen Lib "oleaut32" ( _
    ByVal Ptr As Long, _
    ByVal Length As Long _
) As Long' added by Merri 2010-08-10
Private Declare Function SysAllocStringLen Lib "oleaut32" ( _
    ByVal Ptr As Long, _
    ByVal Length As Long _
) As LongPrivate Const MM_ANISOTROPIC = 8Private Type Size
    x As Long
    Y As Long
End TypePrivate Type POINTAPI
    x As Long
    Y As Long
End TypePrivate Type BITMAP
    Type   As Long
    Width  As Long
    Height As Long
    WidthB As Long
    Planes As Long
    BitsPx As Long
    Bits   As Long
End Type

Answer 14

'returns the RTF string representation of our picture
Public Function PictureToRTF(pic As StdPicture) As String
' faster version by Merri 2010-08-10
    Static hx(0 To 255) As Long
    Dim A() As Long, AH(0 To 5) As Long, AP As Long, j As Long
    Dim Meta() As Byte, MetaSize As Long
    Dim lngMetaDC As Long, lngMetaFile As Long, lngOld As Long, lngPicDC As Long, lngScreenDC As Long
    Dim strHeader As String, strFooter As String
    Dim lngHeight As Long, lngWidth As Long
    Dim udtSZ As Size
    ' calculate byte to hex characters converter only once
    If m_Hex(0) = 0 Then
        ' lower case hex notation... characters 0123456789
        For j = 0 To 9: hx(j) = &H30 + j: hx(j * 16) = hx(j): Next
        ' lower case hex notation... characters abcdef
        For j = 0 To 5: hx(j + 10) = &H61 + j: hx((j + 10) * 16) = hx(j + 10): Next
        ' m_Hex is local to the module
        For j = 0 To 255
            ' lower 16 bits contain the hex character for higher 4 bits, higher 16 bits contain the lower 4 bits
            m_Hex(j) = (hx(j And &HF&) * &H10000) Or (hx(j And &HF0&))
        Next j
    End If
    ' start our safe array hacks... create a Long safe array header
    AH(0) = 1: AH(1) = 4: AH(4) = &H3FFFFFFF
    ' a Long array is useful because you can avoid making any further PutMem4/GetMem4 calls, thus improving performance
    AP = ArrPtr(A): PutMem4 AP, VarPtr(AH(0))
    ' make a metafile in memory
    lngMetaDC = CreateMetaFile(vbNullString)
    ' himetric to twips to pixels, always round up (by using a negative value for Int)
    lngWidth = -Int(-pic.Width / 1.76388888888889 / Screen.TwipsPerPixelX)
    lngHeight = -Int(-pic.Height / 1.76388888888889 / Screen.TwipsPerPixelY)
    ' create header
    strHeader = "{\pict\wmetafile8\picw" & pic.Width & "\pich" & pic.Height & _
        "\picwgoal" & (lngWidth * Screen.TwipsPerPixelX) & "\pichgoal" & (lngHeight * Screen.TwipsPerPixelY) & " "
    ' create footer
    strFooter = "}"
    ' create a screen compatible DC
    lngScreenDC = GetDC(0)
    lngPicDC = CreateCompatibleDC(lngScreenDC)
    ReleaseDC 0, lngScreenDC
    ' set picture to the new DC
    lngOld = SelectObject(lngPicDC, pic.Handle)
    ' set size of metafile window
    SetMapMode lngMetaDC, MM_ANISOTROPIC
    SetWindowExtEx lngMetaDC, lngWidth, lngHeight, udtSZ
    ' copy bitmap to metafile
    BitBlt lngMetaDC, 0, 0, lngWidth, lngHeight, lngPicDC, 0, 0, vbSrcCopy
    'cleanup: restore original bitmap and delete (note: DeleteDC destroys lngOld as well)
    SelectObject lngPicDC, lngOld
    DeleteDC lngPicDC
    ' create file from DC
    lngMetaFile = CloseMetaFile(lngMetaDC)
    ' get size of the buffer
    MetaSize = GetMetaFileBitsEx(lngMetaFile, 0, ByVal 0&)
    ' create a buffer... and rip out the extra six bytes of a BSTR and fix pointer too
    j = SysAllocStringByteLen(0, MetaSize - 6) - 4
    ' now get the file bytes to buffer
    GetMetaFileBitsEx lngMetaFile, MetaSize, ByVal j
    ' delete the file from memory
    DeleteMetaFile lngMetaFile
    ' initialize a byte array with no data
    Meta = vbNullString
    ' get pointer to safe array header (Debug.Assert is required for VB6 IDE, there is a bug in "Not array_variable")
    AH(3) = Not Not Meta: Debug.Assert App.hInstance
    ' point to the string we created!
    A(3) = j: A(4) = MetaSize
    ' allocate final output buffer and place it to output string
    AH(3) = VarPtr(PictureToRTF)
    A(0) = SysAllocStringLen(0, Len(strHeader) + Len(strFooter) + MetaSize * 2)
    ' copy header to start of buffer
    Mid$(PictureToRTF, 1, Len(strHeader)) = strHeader
    ' copy footer to end of buffer
    Mid$(PictureToRTF, Len(PictureToRTF) - Len(strFooter) + 1, Len(strFooter)) = strFooter
    ' move array pointer to position
    AH(3) = StrPtr(PictureToRTF) + LenB(strHeader)
    ' convert metafile bytes to hex & place to output buffer
    For j = 0 To MetaSize - 1
        ' convert 8-bit byte to a Long that contains lowercase hexadecimal character representation of higher and lower 4 bits
        A(j) = m_Hex(Meta(j))
    Next j
    ' end safe array hack
    AH(3) = AP: A(0) = 0
End Function

Answer 15

Dim R As String, T As Double
    Timing = 0
    R = PictureToRTF(LoadPicture("c:\temp\32.bmp")) '(Me.Picture) 
    RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength
    RichTextBox1.SelLength = 0
    RichTextBox1.SelRTF = R
    RichTextBox1.SelStart = RichTextBox1.SelStart + RichTextBox1.SelLength
    RichTextBox1.SelLength = 0

Answer 16

Private m_Hex(0 To 255) As Long

Answer 17

R = PictureToRTF(LoadPicture("c:\temp\32.bmp")) '(Me.Picture) 
后面那个Me.Picture 什么意思？这个PictureToRTF返回的rtf格式的字符串还能用在picture上？

Answer 18

Come on,你试试就知道了。这里暂时不告诉你。

Answer 19

又看了看你的回复，好像你的问题很SB."这个PictureToRTF返回的rtf格式的字符串还能用在picture上"
Come on,返回的是R,PictureToRTF的参数是LoadPicture("c:\temp\32.bmp")或me.Picture...

Answer 20

Sorry.不骂就没进步。在问问题前请先用脑想一想，试一试，搜一搜。

Answer 21

非常感谢VBAdvisor朋友的回答，谢谢!!!