怎样使 RichTextBox 中的图片不能拉伸？

Question

可能需要API吧？
听说有RichTextBox SDK的，可是找不到

Answer 1

http://community.csdn.net/Expert/topic/4186/4186324.xml?temp=.8929865

Answer 2

你是怎么实现在RichTextBox 插入图片的?是想插入图片时让图片不能拉伸,还是图片已经插入好了,动态决定其能否拉伸

Answer 3

可以参考:
http://www.codeguru.com/Cpp/controls/richedit/article.php/c5383

Answer 4

Private Sub rtbText_Change()
    Static strText As String
    Static strRTF As String
    If rtbText.Text = strText And rtbText.TextRTF <> strRTF Then
        rtbText.TextRTF = strRTF
    End If
    strText = rtbText.Text
    strRTF = rtbText.TextRTF
End Sub

Answer 5

楼上的方法不妥，原因是随着richtextbox内容的增多
strRTF = rtbText.TextRTF
会要求越来越多的内存，严重时会使程序崩溃

Answer 6

to Modest(塞北雪貂) :
您这办法的确是不太好用

Answer 7

To faysky2() :
这个帖子我看过，可惜没把问题解决

Answer 8

to rainstormmaster(暴风雨 v2.0) :
图片已经插入了的，我是用Ctrl+V 插入的，插入后不想让用户动态拉伸,怎解?

Answer 9

//图片已经插入了的，我是用Ctrl+V 插入的，插入后不想让用户动态拉伸,怎解?先获得图片对应的rect,然后在子类中拦截相应的鼠标消息,然后根据rect判断鼠标指针的位置是否在图象的边框上,如果是,就吃掉这条消息大致就是这个意思,你试试看吧

Answer 10

另外,你看看这个:
http://blog.csdn.net/rainstormmaster/archive/2006/02/09/595210.aspx
这篇文章中提到的接口你的程序中会用到,另外,获得图片对应的rect的程序就包含在文章中刷新部分的代码中其实,你还不如直接用文章的方法插入图片:
只要指定REOBJECT的
 .dwFlags = REO_BELOWBASELINE 
自然就不能拉伸图片,必要的话,还可以屏蔽掉剪贴板具体怎么做,看你项目的要求了

Answer 11

'to rainstormmaster(暴风雨 v2.0)
'我也一直在关注这个问题
'照你的函数写了一个过程
'可是,还有点小问题
'望赐教
'虽说VB学了很久了,可一直没碰过OLE和COM
'呵呵,偶还是对API比较有兴趣.Dim mIRichEditOle As IRichEditOle
Dim mIOleClientSite As IOleClientSite
Dim mReObject As REOBJECT
Const WM_USER = &H400
Const EM_GETOLEINTERFACE = WM_USER + 60
Const EM_POSFROMCHAR = (WM_USER + 38)With RichText1
        '向richtextbox发送EM_GETOLEINTERFACE消息获得IRichEditOle接口，实例化mIRichEditOle
        SendMessage .hWnd, EM_GETOLEINTERFACE, 0, mIRichEditOle
        If ObjPtr(mIRichEditOle) = 0 Then
                MsgBox "Error to get IRichEditOle"
                Exit Sub
        End If
        '调用GetClientSite函数，实例化mIOleClientSite
        Set mIOleClientSite = mIRichEditOle.GetClientSite
        If ObjPtr(mIOleClientSite) = 0 Then
                MsgBox "Error to get ClientSite"
                Exit Sub
        End If
        
        Dim i As Long
        For i = 0 To mIRichEditOle.GetObjectCount - 1
            mReObject.cbStruct = LenB(mReObject)
            mIRichEditOle.GetObject i, mReObject, REO_GETOBJ_ALL_INTERFACES
            With mReObject
                        '去掉Resizeable样式
                        .dwFlags = .dwFlags And Not REO_RESIZABLE
            End With
            '************
            '这里应该怎么写回OLE对象呢?
            '好像没有找到SetObject方法
        Next
End WithSet mIRichEditOle = Nothing
Set mIOleClientSite = Nothing

Answer 12

// '这里应该怎么写回OLE对象呢?
  '好像没有找到SetObject方法是的,并没有SetObject方法,想利用这种思路实现的话,可以考虑获得REOBJECT后先删除图片,改变dwflags后再InsertObject,这个应该是个可行的方法

Answer 13

Dim mIRichEditOle As IRichEditOle
这句，我一直行不通
那IRichEditOle不知道被哪个TLB给封装了？

Answer 14

这里：
http://www.mvps.org/emorcillo/download/vb6/tl_ole.zip
下载后，解压，然后添加对tlb文件的引用

Answer 15

但我系统目录里已经有一个olelib2.tlb，而且文件大小和下载下来的那个文件一样的,
且在VB里已经引用了的，我再引用那个下载下来的没反应啊
是不是要把系统目录里的那个替换掉？

Answer 16

但还是这个问题
Dim mIRichEditOle As IRichEditOle找不到 IRichEditOle

Answer 17

按下F2看看你的系统中的那个olelib2.tlb是不是定义了IRichEditOle接口另外,我用的olelib.tlb文件在vb中显示为Edanmo's OLE interfaces & functions v1.81

Answer 18

呵呵，原来是这个Edanmo's OLE interfaces & functions v1.81，多谢

Answer 19

唉，Ctrl+V插入图片然后不让它拉伸的问题，还是解决不了高手帮帮忙吧？

Answer 20

rainstormmaster(暴风雨 v2.0)都没辄我看这个问题也就这样了.

Answer 21

//rainstormmaster(暴风雨 v2.0)
都没辄我看这个问题也就这样了.呵呵,只是针对图片的话,问题倒是不难解决,我在想如何适用于所有对象

Answer 22

rainstormmaster(暴风雨 v2.0) 
有高招？
分享一下，大家都亟待解决这个问题。

Answer 23

to rainstormmaster(暴风雨 v2.0) 
把你前几天的代码改成：
With mReObject
     '去掉Resizeable样式
     .dwFlags = .dwFlags And Not REO_RESIZABLE
End With这样不行吗？我测试过的，适用于所有对象。

Answer 24

//这样不行吗？我测试过的，适用于所有对象不是不行,是IRichEditOle没有提供setobject方法,所以要先删除对象修改dwFlags再插入对象,但是在这个过程中,出现了问题,至于是什么问题,你可以写代码测试一下,总的来说,vb很生气,后果很严重

Answer 25

Option Explicit
'rainstormmaster写于2006年2月19日凌晨
'转载请保留上述信息
Private Const WM_USER = &H400
Private Const EM_GETOLEINTERFACE = WM_USER + 60
Private Const EM_POSFROMCHAR = (WM_USER + 38)
Private Const EM_EXGETSEL = (WM_USER + 52)
Private Const EM_EXSETSEL = (WM_USER + 55)
Private Type CharRange
    cpMin As Long
    cpMax As Long
End Type
Private Declare Function PutFocus Lib "user32" Alias "SetFocus" (ByVal hwnd As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Sub ZeroMemory Lib "kernel32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)'改变richtextbox中索引(从0开始)为index的oleobject的dwFlags，如果index小于等于-1，则应用于全部对象
Private Sub changeReobjectsFlag(ByVal mHwnd As Long, ByVal newFlag As REO_FLAGS, Optional index As Long = -1)
    Dim mIRichEditOle As IRichEditOle
    Dim mReObject As REOBJECT
    Dim mILockBytes As ILockBytes
    Dim OldCharRange As CharRange
    Dim NewCharRange As CharRange
    Dim objCount As Long
    Dim mIStorage As IStorage
    Dim mIOleClientSite As IOleClientSite
    Dim mIOleObject As IOleObject
    Dim mUUID As UUID
    SendMessage mHwnd, EM_GETOLEINTERFACE, 0, mIRichEditOle
    If ObjPtr(mIRichEditOle) = 0 Then
        MsgBox "Error to get IRichEditOle"
        Exit Sub
    End If
    
    '获得richtextbox中oleobject的数量
    objCount = mIRichEditOle.GetObjectCount
    If objCount = 0 Then
        MsgBox "richtextbox中没有包含oleobject"
        Set mIRichEditOle = Nothing
        Exit Sub
    End If
    If index <= -1 Then '全部改变
        '记录下richtextbox当前选定的内容
        SendMessage mHwnd, EM_EXGETSEL, 0, OldCharRange
        Dim i As Long
        For i = 0 To objCount - 1
'            '获得oleobject对象的信息
            mReObject.cbStruct = LenB(mReObject)
            mIRichEditOle.GetObject i, mReObject, REO_GETOBJ_ALL_INTERFACES
            Set mIOleObject = mReObject.poleobj
            With NewCharRange
                .cpMin = mReObject.cp
                .cpMax = mReObject.cp
            End With
            '删除当前的oleobject
            '只所以不用selstart之类的属性控制，是因为ReObject.cp是基于字节的
            PutFocus mHwnd
            SendMessage mHwnd, EM_EXSETSEL, 0, NewCharRange
            SendKeys "{DEL}", True
            
            '改变dwflags后重新插入oleobject
            Set mILockBytes = CreateILockBytesOnHGlobal(0&, True)
            If ObjPtr(mILockBytes) = 0 Then
                MsgBox "Error to create Global Heap"
                Exit Sub
            End If
            '创建storage，实例化mIStorage
            Set mIStorage = StgCreateDocfileOnILockBytes(mILockBytes, STGM_SHARE_EXCLUSIVE _
                            Or STGM_CREATE Or STGM_READWRITE, 0)
            If ObjPtr(mIStorage) = 0 Then
                MsgBox "Error to create storage"
                Exit Sub
            End If
            
            '调用GetClientSite函数，实例化mIOleClientSite
            Set mIOleClientSite = mIRichEditOle.GetClientSite
            If ObjPtr(mIOleClientSite) = 0 Then
                MsgBox "Error to get ClientSite"
                Exit Sub
            End If
            OleSetContainedObject mIOleObject, True
            mIOleObject.GetUserClassID mUUID
            With mReObject
                .cbStruct = LenB(mReObject)
                .clsid = mUUID
                .cp = REO_CP_SELECTION
                .dwFlags = newFlag
               Set .poleobj = mIOleObject
               Set .polesite = mIOleClientSite
               Set .pStg = mIStorage
            End With
            '恢复richtextbox原来选定的内容
            mIRichEditOle.InsertObject mReObject
        Next
        SendMessage mHwnd, EM_EXSETSEL, 0, OldCharRange
    Else
        If index > objCount - 1 Then
            MsgBox "无效的索引，请检查index属性值"
            Set mIRichEditOle = Nothing
            Exit Sub
        Else
            '记录下richtextbox当前选定的内容
            SendMessage mHwnd, EM_EXGETSEL, 0, OldCharRange
            '获得oleobject对象的信息
            mReObject.cbStruct = LenB(mReObject)
            mIRichEditOle.GetObject index, mReObject, REO_GETOBJ_ALL_INTERFACES
            Set mIOleObject = mReObject.poleobj
            '获得当前对象在richtextbox中的位置
            With NewCharRange
                .cpMin = mReObject.cp
                .cpMax = mReObject.cp
            End With
            '删除当前的oleobject
            '只所以不用selstart之类的属性控制，是因为ReObject.cp是基于字节的
            PutFocus mHwnd
            SendMessage mHwnd, EM_EXSETSEL, 0, NewCharRange
            SendKeys "{DEL}", True
            '改变dwflags后重新插入oleobject
            Set mILockBytes = CreateILockBytesOnHGlobal(0&, True)
            If ObjPtr(mILockBytes) = 0 Then
                MsgBox "Error to create Global Heap"
                Exit Sub
            End If
            '创建storage，实例化mIStorage
            Set mIStorage = StgCreateDocfileOnILockBytes(mILockBytes, STGM_SHARE_EXCLUSIVE _
                            Or STGM_CREATE Or STGM_READWRITE, 0)
            If ObjPtr(mIStorage) = 0 Then
                MsgBox "Error to create storage"
                Exit Sub
            End If
            
            '调用GetClientSite函数，实例化mIOleClientSite
            Set mIOleClientSite = mIRichEditOle.GetClientSite
            If ObjPtr(mIOleClientSite) = 0 Then
                MsgBox "Error to get ClientSite"
                Exit Sub
            End If
            OleSetContainedObject mIOleObject, True
            mIOleObject.GetUserClassID mUUID
            With mReObject
                .cbStruct = LenB(mReObject)
                .clsid = mUUID
                .cp = REO_CP_SELECTION
                .dwFlags = newFlag
               Set .poleobj = mIOleObject
               Set .polesite = mIOleClientSite
               Set .pStg = mIStorage
            End With
            mIRichEditOle.InsertObject mReObject
            '恢复richtextbox原来选定的内容
            SendMessage mHwnd, EM_EXSETSEL, 0, OldCharRange
         End If
     End If
    '释放资源
    Set mIRichEditOle = Nothing
    Set mILockBytes = Nothing
    Set mIStorage = Nothing
    Set mIOleClientSite = Nothing
    Set mIOleObject = Nothing
End Sub
Private Sub Command1_Click()
    changeReobjectsFlag Me.RichTextBox1.hwnd, REO_BELOWBASELINE, 0
End SubPrivate Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    RichTextBox1.TextRTF = ""
End Sub

Answer 26

http://rainstormmaster.cnblogs.com/archive/2006/02/19/333330.html