求助:谁能帮我调试一下程序
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