插入对象

核心提示：'说明：表单一个；命令按钮一个为CmdInsertObject；RichTextBox控件一个为RichTextBox1OptionExplicitPRivateDeclareFunctionOleUIInsertObjectLib"oledlg.dll"Alias"OleUIIn

'说明：表单一个；命令按钮一个为CmdInsertObject；RichTextBox控件一个为RichTextBox1

OptionExplicit

PRivateDeclareFunctionOleUIInsertObjectLib"oledlg.dll"Alias"OleUIInsertObjectA"(inParamAsAny)AsLong

PrivateDeclareFunctionProgIDFromCLSIDLib"ole32.dll"(clsidAsAny,strAddessAsLong)AsLong

PrivateDeclareSubCoTaskMemFreeLib"ole32.dll"(ByValpvoidAsLong)

PrivateDeclareSubCopyMemoryLib"kernel32"Alias"RtlMoveMemory"(DestinationAsAny,SourceAsAny,ByValLengthAsLong)

PrivateDeclareFunctionlstrlenWLib"kernel32"(ByVallpStringAsLong)AsLong

PrivateTypeGUID
Data1AsLong
Data2AsInteger
Data3AsInteger
Data4(0To7)AsByte
EndType

PrivateTypeOleUIInsertObjectType
cbStructAsLong
dwFlagsAsLong
hWndOwnerAsLong
lpszCaptionAsString
lpfnHookAsLong
lCustDataAsLong
hInstanceAsLong
lpszTemplateAsString
hResourceAsLong
clsidAsGUID
lpszFileAsString
cchFileAsLong
cClsidExcludeAsLong
lpClsidExcludeAsLong
IIDAsGUID
oleRenderAsLong
lpFormatEtcAsLong
lpIOleClientSiteAsLong
lpIStorageAsLong
ppvObjAsLong
scAsLong
hMetaPictAsLong
EndType

PrivateConstIOF_SHOWHELP=&H1
PrivateConstIOF_SELECTCREATENEW=&H2
PrivateConstIOF_SELECTCREATEFROMFILE=&H4
PrivateConstIOF_CHECKLINK=&H8
PrivateConstIOF_CHECKDISPLAYASICON=&H10
PrivateConstIOF_CREATENEWOBJECT=&H20
PrivateConstIOF_CREATEFILEOBJECT=&H40
PrivateConstIOF_CREATELINKOBJECT=&H80
PrivateConstIOF_DISABLELINK=&H100
PrivateConstIOF_VERIFYSERVERSEXIST=&H200
PrivateConstIOF_DISABLEDISPLAYASICON=&H400
PrivateConstIOF_HIDECHANGEICON=&H800
PrivateConstIOF_SHOWINSERTCONTROL=&H1000
PrivateConstIOF_SELECTCREATECONTROL=&H2000

PrivateConstOLEUI_FALSE=0
PrivateConstOLEUI_OK=1
PrivateConstOLEUI_CANCEL=2

PrivateSubCmdInsertObject_Click()

Dimlu_InsertObjectAsOleUIInsertObjectType
Dimll_ReturnValueAsLong
Dimll_StringPointerAsLong
Dimll_TextLengthAsLong
Dimls_ProgIDAsString

'初始化插入对象
Withlu_InsertObject
.cbStruct=LenB(lu_InsertObject)
.dwFlags=IOF_SELECTCREATENEW
.hWndOwner=Me.hWnd
.lpszFile=Space(255)
.cchFile=255
EndWith

'显示插入对象对话框
ll_ReturnValue=OleUIInsertObject(lu_InsertObject)

Ifll_ReturnValue=OLEUI_OKThen
If(lu_InsertObject.dwFlagsAndIOF_SELECTCREATENEW)=IOF_SELECTCREATENEWThen
'选择"新建"按钮时
'给出进程ID与类ID
ll_ReturnValue=ProgIDFromCLSID(lu_InsertObject.clsid,ll_StringPointer)
'进程ID长度，是Unicode字符串
ll_TextLength=lstrlenW(ll_StringPointer) 1
'初始化字符串
ls_ProgID=Space(ll_TextLength)
'拷贝ll_StringPointer指针到字符串ls_ProgID
CopyMemoryByValStrPtr(ls_ProgID),ByValll_StringPointer,ll_TextLength*2
'清除内存
CoTaskMemFreell_StringPointer

'添加对象到RichTextBox中
RichTextBox1.OLEObjects.Add,,"",ls_ProgID

Else

'选择："从文件创建"时
RichTextBox1.OLEObjects.Add,,lu_InsertObject.lpszFile

EndIf
EndIf

EndSub->