| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 1076 人关注过本帖
标题:求助:谁能帮我调试一下程序
取消只看楼主 加入收藏
zfc123
Rank: 2
等 级:论坛游民
帖 子:136
专家分:39
注 册:2007-5-4
结帖率:84.62%
收藏
 问题点数:0 回复次数:1 
求助:谁能帮我调试一下程序
Option Explicit

Private Declare Sub ZeroMemory Lib "KERNEL32" Alias "RtlZeroMemory" (dest As Any, ByVal numBytes As Long)
Private Declare Function InvalidateRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT, ByVal bErase As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Long, ByRef lpRect As RECT) As Long
Public Declare Function UpdateWindow Lib "user32.dll" (ByVal hwnd As Long) As Long

Public 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 Const WM_USER = &H400
Private Const EM_GETOLEINTERFACE = (WM_USER + 60)
Private Const EM_POSFROMCHAR = (WM_USER + 38)

Public Enum reCharPos
    reSelection = -1
End Enum

Public Enum reObjectAspect
    reObjectAspectContent = DVASPECT_CONTENT'在这个地方会出现要求常数声明的提示
    reObjectAspectIcon = DVASPECT_ICON
End Enum

Public Function AddClass(hwnd As Long, ObjIUnknown As stdole.IUnknown, _
      Optional ByVal CharPos As Long = reSelection, _
      Optional ByVal InitialAspect As reObjectAspect = reObjectAspectContent) As IRichEditOle
     
    Dim OleObject As
    Dim Storage As olelib.IStorage
    Dim ClientSite As
    Dim tOUIIO As olelib.OLEUIINSERTOBJECT
    Dim REOBJ As olelib.REOBJECT
    Dim CLSID As olelib.UUID
    Dim hMFPict As Long
     
    Dim mILockBytes As ILockBytes
    '创建Global Heap,实例化mILockBytes
    Set mILockBytes = CreateILockBytesOnHGlobal(0&, True)
    '创建storage,实例化mIStorage
    Set Storage = StgCreateDocfileOnILockBytes(mILockBytes, STGM_SHARE_EXCLUSIVE _
                    Or STGM_CREATE Or STGM_READWRITE, 0)
     

    Dim RichEditOle As IRichEditOle
    SendMessage hwnd, EM_GETOLEINTERFACE, 0&, RichEditOle


    Set ClientSite = RichEditOle.GetClientSite
'    Set Storage = StgCreateDocfile(vbNullString, STGM_CREATE Or STGM_READWRITE Or STGM_DELETEONRELEASE Or STGM_SHARE_EXCLUSIVE)

    Set OleObject = ObjIUnknown
    OleObject.GetUserClassID CLSID

    On Error Resume Next

    If hMFPict = 0 Then hMFPict = OleGetIconOfClass(CLSID, vbNullString, 1)


    If Err.Number  <> 0 Then InitialAspect = reObjectAspectContent

    On Error GoTo 0

    OleSetContainedObject ObjIUnknown, 1

    With REOBJ
        .cbStruct = Len(REOBJ)
        LSet .CLSID = CLSID
        .DVASPECT = DVASPECT_CONTENT
        .cp = REO_CP_SELECTION
        .dwFlags = REO_DYNAMICSIZE
        .sizel.cx = 0
        .sizel.cy = 0
        .dwUser = 0
        Set .pStg = Storage
        Set .polesite = ClientSite
        Set .poleobj = ObjIUnknown
    End With

    RichEditOle.InsertObject REOBJ
     
    ZeroMemory REOBJ, LenB(REOBJ)
    ZeroMemory CLSID, LenB(CLSID)
      
    Set AddClass = RichEditOle
    Set OleObject = Nothing
    Set ClientSite = Nothing
    Set Storage = Nothing

    SendMessage hwnd, &HF, 0, 0

End Function
搜索更多相关主题的帖子: Long Lib ByVal Declare 
2008-04-03 14:26
zfc123
Rank: 2
等 级:论坛游民
帖 子:136
专家分:39
注 册:2007-5-4
收藏
得分:0 
这段程序是我从网上找的,在Richtextbox中插入gif的代码,可总是调试不过,能帮我调试一下吗?
2008-04-03 15:12
快速回复:求助:谁能帮我调试一下程序
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.032858 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved