插入对象

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

Option Explicit

Private Declare Function OleUIInsertObject Lib "oledlg.dll" Alias "OleUIInsertObjectA" (inParam As Any) As Long

Private Declare Function ProgIDFromCLSID Lib "ole32.dll" (clsid As Any, strAddess As Long) As Long

Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pvoid As Long)

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type

Private Type OleUIInsertObjectType
cbStruct As Long
dwFlags As Long
hWndOwner As Long
lpszCaption As String
lpfnHook As Long
lCustData As Long
hInstance As Long
lpszTemplate As String
hResource As Long
clsid As GUID
lpszFile As String
cchFile As Long
cClsidExclude As Long
lpClsidExclude As Long
IID As GUID
oleRender As Long
lpFormatEtc As Long
lpIOleClientSite As Long
lpIStorage As Long
ppvObj As Long
sc As Long
hMetaPict As Long
End Type

Private Const IOF_SHOWHELP = &H1
Private Const IOF_SELECTCREATENEW = &H2
Private Const IOF_SELECTCREATEFROMFILE = &H4
Private Const IOF_CHECKLINK = &H8
Private Const IOF_CHECKDISPLAYASICON = &H10
Private Const IOF_CREATENEWOBJECT = &H20
Private Const IOF_CREATEFILEOBJECT = &H40
Private Const IOF_CREATELINKOBJECT = &H80
Private Const IOF_DISABLELINK = &H100
Private Const IOF_VERIFYSERVERSEXIST = &H200
Private Const IOF_DISABLEDISPLAYASICON = &H400
Private Const IOF_HIDECHANGEICON = &H800
Private Const IOF_SHOWINSERTCONTROL = &H1000
Private Const IOF_SELECTCREATECONTROL = &H2000

Private Const OLEUI_FALSE = 0
Private Const OLEUI_OK = 1
Private Const OLEUI_CANCEL = 2

Private Sub CmdInsertObject_Click()

Dim lu_InsertObject As OleUIInsertObjectType
Dim ll_ReturnValue As Long
Dim ll_StringPointer As Long
Dim ll_TextLength As Long
Dim ls_ProgID As String

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

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

If ll_ReturnValue = OLEUI_OK Then
If (lu_InsertObject.dwFlags And IOF_SELECTCREATENEW) = IOF_SELECTCREATENEW Then
'选择"新建"按钮时
'给出进程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
CopyMemory ByVal StrPtr(ls_ProgID), ByVal ll_StringPointer, ll_TextLength * 2
'清除内存
CoTaskMemFree ll_StringPointer

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

Else

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

End If
End If

End Sub

上一篇： 如何在VB6中导出EXCEL、FOXPRO格式的表
下一篇： 用OLE自动化Outlook

标签：

版权申明：本站文章部分自网络，如有侵权，请联系：west999com@outlook.com
特别注意：本站所有转载文章言论不代表本站观点，本站所提供的摄影照片，插画，设计作品，如需使用，请与原作者联系，版权归原作者所有