如何利用 VB6 Addin 动态生成菜单-优快云博客

使用 addin 程序可以加快我们的开发速度

以下几个例子，是我个人在平常工作中常用到

1.统一改变窗体的控件字体及字体大小

Set objCom = VBInstance.SelectedVBComponent

If (objCom.Type <> vbext_ct_VBForm) And _
     (objCom.Type <> vbext_ct_UserControl) And _
     (objCom.Type <> vbext_ct_DocObject) And _
     (objCom.Type <> vbext_ct_PropPage) Then
    Exit Sub
End If

For Each objCtrl In objCom.Designer.VBControls
    objCtrl.ControlObject.FontName = Me.cboFont.Text
    objCtrl.ControlObject.FontSize = Val(Me.cboFontSize.Text)

    objCtrl.ControlObject.Font.Name = Me.cboFont.Text
    objCtrl.ControlObject.Font.Size = Val(Me.cboFontSize.Text)

    objCtrl.Properties("FontName").Value = Me.cboFont.Text
    objCtrl.Properties("FontSize").Value = Val(Me.cboFontSize.Text)

Next

2. 根据数据库设置，动态生成菜单

Private Sub CreateMenu(ByVal prsData As ADODB.Recordset, ByVal pobjCom As VBComponent, pobjParent As VBControl, ByVal pstrParentid As String)
Dim rs        As ADODB.Recordset
Dim objCtrls As VBControls
Dim objCtrl   As VBControl
Dim strMenuid As String
Dim strCap    As String
Dim i         As Integer
Dim intIdx    As Integer

On Error GoTo ERROR_LABEL

intIdx = 0
Set rs = prsData.Clone
rs.Filter = "parentid='" & pstrParentid & "'"
If rs.RecordCount > 0 Then
'    MsgBox rs.RecordCount
    rs.Sort = "functionindex"
    For i = 1 To rs.RecordCount

      strMenuid = Trim(rs.Collect("menuid") & "")
      strCap = Trim(rs.Collect("menuname") & "")

      If pobjParent Is Nothing Then
        Set objCtrls = pobjCom.Designer.VBControls
        Set objCtrl = objCtrls.Add("VB.Menu")
      Else
        Set objCtrl = pobjParent.ContainedVBControls.Add("VB.Menu", pobjParent)
      End If
      objCtrl.Properties!Index = Val(rs.Collect("functionindex") & "")
      objCtrl.Properties!Name = rs.Collect("functionname") & ""

      If StrComp(strCap, "-", vbTextCompare) <> 0 Then
        If Len(Trim(rs.Collect("shortcut") & "")) > 0 Then
          strCap = strCap & "(" & rs.Collect("shortcut") & "" & ")"
        Else
          intIdx = intIdx + 1
          If intIdx > 9 Then
            strCap = "&" & Chr(64 + intIdx - 9) & ". " & strCap
          Else
            strCap = "&" & CStr(intIdx) & ". " & strCap
          End If
        End If
        objCtrl.Properties!Caption = strCap
      Else
        objCtrl.Properties!Caption = strCap
      End If
      If HasChildMenu(prsData, strMenuid) Then
        Call CreateMenu(prsData, pobjCom, objCtrl, strMenuid)
      End If
      rs.MoveNext
    Next i
End If
ERROR_LABEL:
If Err.Number <> 0 Then
'    MsgBox "CreateMenu->" & Err.Description
    Err.Clear
    Resume Next
End If
End Sub