如何利用 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