| 插入对象 |
| 来源： 作者： 发布时间：2007-04-29
|
|
'说明：表单一个；命令按钮一个为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->
|
| |
|
| 上一篇：在VB组件内调用Excel2000实现GIF饼图 下一篇：如何在VB6中导出EXCEL、FOXPRO格式的表 |
|
【关闭窗口】 |
|
|
|