⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 typelib.frm

📁 不错的一个VB菜单设计 界面和功能都不错
💻 FRM
字号:
VERSION 5.00
Object = "*\A..\SOURCE\FAST2003.vbp"
Object = "*\A..\SOURCE\FAST2003.vbp"
Begin VB.Form frmTypeLib 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "TypeLib Information"
   ClientHeight    =   6675
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   8235
   Icon            =   "TypeLib.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   6675
   ScaleWidth      =   8235
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'CenterScreen
   Begin VB.TextBox txtParam 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Height          =   960
      Left            =   5205
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   11
      TabStop         =   0   'False
      Top             =   5565
      Width           =   2805
   End
   Begin VB.ListBox lstParam 
      BackColor       =   &H8000000F&
      Height          =   1035
      Left            =   2610
      Sorted          =   -1  'True
      TabIndex        =   10
      Top             =   5535
      Width           =   2400
   End
   Begin VB.TextBox txtElement 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Height          =   1095
      Left            =   2625
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   8
      TabStop         =   0   'False
      Top             =   4365
      Width           =   5550
   End
   Begin VB.ListBox lstElements 
      BackColor       =   &H8000000F&
      Height          =   2205
      Left            =   90
      Sorted          =   -1  'True
      TabIndex        =   7
      Top             =   4365
      Width           =   2400
   End
   Begin VB.OptionButton optView 
      Caption         =   "Data types"
      Height          =   195
      Index           =   1
      Left            =   1350
      TabIndex        =   4
      Top             =   2160
      Width           =   1095
   End
   Begin VB.OptionButton optView 
      Caption         =   "Classes"
      Height          =   195
      Index           =   0
      Left            =   180
      TabIndex        =   3
      Top             =   2160
      Value           =   -1  'True
      Width           =   915
   End
   Begin VB.TextBox txtMember 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Height          =   1635
      Left            =   2640
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   2475
      Width           =   5550
   End
   Begin VB.TextBox txtInfo 
      BackColor       =   &H8000000F&
      BorderStyle     =   0  'None
      Height          =   1275
      Left            =   90
      Locked          =   -1  'True
      MultiLine       =   -1  'True
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   765
      Width           =   7470
   End
   Begin VB.CommandButton cmdInfo 
      Caption         =   "Go"
      Default         =   -1  'True
      Height          =   375
      Left            =   6615
      TabIndex        =   1
      Top             =   315
      Width           =   1320
   End
   Begin VB.ListBox lstMembers 
      BackColor       =   &H8000000F&
      Height          =   1620
      Left            =   90
      Sorted          =   -1  'True
      TabIndex        =   5
      Top             =   2475
      Width           =   2400
   End
   Begin VB.TextBox txtFilename 
      Height          =   330
      Left            =   90
      TabIndex        =   0
      Text            =   "c:\windows\system\comctl32.ocx"
      Top             =   315
      Width           =   6315
   End
   Begin FLWSystem.FWSysInfo objSysInfo 
      Left            =   7695
      Top             =   1380
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin FLWSystem.FWTypeLib objTypeLib 
      Left            =   7695
      Top             =   810
      _ExtentX        =   820
      _ExtentY        =   820
   End
   Begin VB.Label lblLabel 
      AutoSize        =   -1  'True
      Caption         =   "Filename"
      Height          =   195
      Left            =   90
      TabIndex        =   9
      Top             =   90
      Width           =   630
   End
End
Attribute VB_Name = "frmTypeLib"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Sub cmdInfo_Click()
  Dim objTypeLibClass    As FLWSystem.IFWTypeLibClass
  Dim objTypeLibDataType As FLWSystem.IFWTypeLibDataType
  Dim blnOk              As Boolean
  
  Screen.MousePointer = vbHourglass
  blnOk = objTypeLib.Create(txtFilename)
  Screen.MousePointer = vbNormal
  
  If blnOk Then
    
    txtInfo = objTypeLib.FileName & vbCrLf & _
              "Internal library name " & objTypeLib.Name & vbCrLf & _
              "Operating system " & objTypeLib.SysKindStr & vbCrLf & _
              "Registry GUID is " & objTypeLib.Guid & vbCrLf & _
              "Library version " & objTypeLib.MajorVersion & "." & objTypeLib.MinorVersion & vbCrLf & _
              "Help file and context ID is " & objTypeLib.HelpFile & "  (" & objTypeLib.HelpContext & ")"
    txtInfo.Visible = True
    
    Call lstMembers.Clear
    If optView(0).Value Then
      For Each objTypeLibClass In objTypeLib.Classes
        Call lstMembers.AddItem(objTypeLibClass.Name)
      Next
    Else
      For Each objTypeLibDataType In objTypeLib.DataTypes
        Call lstMembers.AddItem(objTypeLibDataType.Name)
      Next
    End If
    If lstMembers.ListCount > 0 Then
      lstMembers.ListIndex = 0
    End If
    lstMembers.Visible = True
    optView(0).Visible = True
    optView(1).Visible = True
    lstElements.Visible = True
    txtMember.Visible = True
    txtElement.Visible = True
  Else
    lstParam.Visible = False
    txtInfo.Visible = False
    lstMembers.Visible = False
    optView(0).Visible = False
    optView(1).Visible = False
    lstElements.Visible = False
    txtMember.Visible = False
    txtElement.Visible = False
    Call MsgBox("The specified file does not exist or the OLE information is not available")
  End If
End Sub

Private Sub Form_Load()
  lstParam.Visible = False
  txtInfo.Visible = False
  lstMembers.Visible = False
  optView(0).Visible = False
  optView(1).Visible = False
  lstElements.Visible = False
  txtMember.Visible = False
  txtElement.Visible = False
  txtFilename = objSysInfo.System & "\comct232.ocx"
End Sub

Private Sub lstMembers_Click()
  Dim objTypeLibClass    As FLWSystem.IFWTypeLibClass
  Dim objTypeLibDataType As FLWSystem.IFWTypeLibDataType
  Dim objTypeLibElement  As FLWSystem.IFWTypeLibElement
  
  Call lstElements.Clear
  If optView(0).Value Then
    Set objTypeLibClass = objTypeLib.Class(lstMembers.Text)
    txtMember = "Member name " & objTypeLibClass.Name & vbCrLf & _
                "Registry GUID is " & objTypeLibClass.Guid & vbCrLf & _
                "Member type " & objTypeLibClass.TypeKindStr & vbCrLf & _
                "Help file and context ID is " & objTypeLibClass.HelpFile & "  (" & objTypeLibClass.HelpContext & ")"
    For Each objTypeLibElement In objTypeLibClass.Elements
      Call lstElements.AddItem(objTypeLibElement.Name)
    Next
  Else
    Set objTypeLibDataType = objTypeLib.DataType(lstMembers.Text)
    txtMember = "Member name " & objTypeLibDataType.Name & vbCrLf & _
                "Registry GUID is " & objTypeLibDataType.Guid & vbCrLf & _
                "Member type " & objTypeLibDataType.TypeKindStr & vbCrLf & _
                "Help file and context ID is " & objTypeLibDataType.HelpFile & "  (" & objTypeLibDataType.HelpContext & ")"
    For Each objTypeLibElement In objTypeLibDataType.Elements
      Call lstElements.AddItem(objTypeLibElement.Name)
    Next
  End If
  If lstElements.ListCount > 0 Then
    lstElements.ListIndex = 0
  End If
End Sub

Private Sub lstMembers_DblClick()
  Call lstMembers_Click
End Sub

Private Sub optView_Click(Index As Integer)
  cmdInfo.Value = True
End Sub

Private Sub lstElements_Click()
  Dim objTypeLibElement As FLWSystem.IFWTypeLibElement
  Dim objTypeLibParam   As FLWSystem.IFWTypeLibParameter
      
  If optView(0).Value Then
    Set objTypeLibElement = objTypeLib.Class(lstMembers.Text).Element(lstElements.Text)
    txtElement = objTypeLibElement.InvokeKindStr & " " & objTypeLibElement.Name & vbCrLf & _
                 "Return type " & objTypeLibElement.ReturnTypeName & " (" & objTypeLibElement.ReturnType & ")" & vbCrLf & _
                 "Member ID is " & objTypeLibElement.MemberId & vbCrLf & _
                 "Help file and context ID is " & objTypeLibElement.HelpFile & "  (" & objTypeLibElement.HelpContext & ")"
    Call lstParam.Clear
    For Each objTypeLibParam In objTypeLibElement.Parameters
      Call lstParam.AddItem(objTypeLibParam.Name)
    Next
    If lstParam.ListCount > 0 Then
      lstParam.ListIndex = 0
      txtParam.Visible = True
    Else
      txtParam.Visible = False
    End If
    lstParam.Visible = True
  Else
    Set objTypeLibElement = objTypeLib.DataType(lstMembers.Text).Element(lstElements.Text)
    txtElement = objTypeLibElement.Name & " = " & objTypeLibElement.Value & vbCrLf & _
                 "Member ID is " & objTypeLibElement.MemberId & vbCrLf & _
                 "Help file and context ID is " & objTypeLibElement.HelpFile & "  (" & objTypeLibElement.HelpContext & ")"
    lstParam.Visible = False
  End If
End Sub

Private Sub lstElements_DblClick()
  Call lstElements_Click
End Sub

Private Sub lstParam_Click()
  Dim objTypeLibParam As FLWSystem.IFWTypeLibParameter
      
  Set objTypeLibParam = objTypeLib.Class(lstMembers.Text).Element(lstElements.Text).Parameter(lstParam.Text)
  
  txtParam = "Data type " & objTypeLibParam.DataTypeName & " (" & objTypeLibParam.DataType & ")"
  If objTypeLibParam.ParamIO Then
    txtParam = txtParam & vbCrLf & "By reference"
  Else
    txtParam = txtParam & vbCrLf & "By value"
  End If
  If objTypeLibParam.IsOptional Then
    txtParam = txtParam & vbCrLf & "Optional"
  End If
  If objTypeLibParam.Default Then
    txtParam = txtParam & vbCrLf & "Default value " & objTypeLibParam.DefaultValue
  End If
End Sub

Private Sub lstParam_DblClick()
  Call lstParam_Click
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -