插入对象

'说明：表单一个；命令按钮一个为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->