Question

VB怎么才能制作自定义的菜单栏，而不是采用菜单编辑器制作，那样的制作出来界面感觉都很一般？

Answer 1

'这段代码能实现部分你要的功能，就是不能自动隐藏。'把下面代码分别写入文本文件，再改下后缀。 '文件 工程1.vbp Type=Exe Form=Form1.frm Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\Windows\system32\stdole2.tlb#OLE Automation Form=FrmCd.frm Module=Module1; Module1.bas IconForm="Form1" Startup="Form1" Command32="" Name="工程1" HelpContextID="0" CompatibleMode="0" MajorVer=1 MinorVer=0 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 CompilationType=0 OptimizationType=0 FavorPentiumPro(tm)=0 CodeViewDebugInfo=0 NoAliasing=0 BoundsCheck=0 OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1 '------------------------------------------------ '文件 Form1.frm VERSION 5.00 Begin VB.Form Form1 Caption = "Form1" ClientHeight = 4035 ClientLeft = 120 ClientTop = 420 ClientWidth = 7695 LinkTopic = "Form1" ScaleHeight = 4035 ScaleWidth = 7695 StartUpPosition = 3 '窗口缺省 Begin VB.CommandButton Cmd2 Caption = "Command1" Height = 735 Left = 2520 TabIndex = 1 Top = 240 Width = 1695 End Begin VB.CommandButton Cmd1 Caption = "Command1" BeginProperty Font Name = "微软雅黑" Size = 9 Charset = 134 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 780 Left = 360 TabIndex = 0 Top = 240 Width = 1815 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Private Sub Cmd1_Click() Dim i As Integer Dim Cdss As CdStyle With Cdss ReDim .Caption(1 To 10) For i = 1 To 10 .Caption(i) = "菜单:" & i Next i .Appearance = 0 .BackColor = vbBlack .ForeColor = &H80000006 .AlignMent = 0 .CdFont.Size = 20 .CdFont.Bold = False .CdFont.Name = "宋体" .CdFont.Color = vbWhite .CdFont.Italic = False End With Call ShowCd(Me, Cmd1, Cdss) End Sub Private Sub Cmd2_Click() Dim i As Integer Dim Cdss As CdStyle With Cdss ReDim .Caption(1 To 10) For i = 1 To 10 .Caption(i) = "CD:" & i Next i .Appearance = 1 .BackColor = vbBlue .ForeColor = vbRed .AlignMent = 2 .CdFont.Size = 20 .CdFont.Bold = True .CdFont.Name = "宋体" .CdFont.Color = vbBlack .CdFont.Italic = False End With Call ShowCd(Me, Cmd2, Cdss) End Sub Private Sub Form_Unload(Cancel As Integer) End End Sub '------------------------------------------------ '文件 FrmCd.frm VERSION 5.00 Begin VB.Form CdFrm BackColor = &H80000009& BorderStyle = 0 'None Caption = "Form2" ClientHeight = 4650 ClientLeft = 0 ClientTop = 0 ClientWidth = 2805 LinkTopic = "Form2" ScaleHeight = 4650 ScaleWidth = 2805 ShowInTaskbar = 0 'False StartUpPosition = 3 '窗口缺省 Begin VB.Label Lbl2 Alignment = 2 'Center Appearance = 0 'Flat BackColor = &H80000006& BorderStyle = 1 'Fixed Single Caption = "Label1" ForeColor = &H00FFFFFF& Height = 495 Left = 0 TabIndex = 1 Top = 840 Width = 2655 End Begin VB.Label Lbl1 BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single Caption = "sdds" ForeColor = &H8000000E& Height = 4645 Left = 0 TabIndex = 0 Top = 0 Width = 2770 End End Attribute VB_Name = "CdFrm" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Dim CdKey As Integer Private Sub Lbl1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Dim NowTop As Integer, LastTop As Integer NowTop = Int(Lbl2.Top / MsgWidth) LastTop = Int(Y / MsgWidth) If NowTop <> LastTop Then Lbl2.Top = LastTop * MsgWidth Lbl2.Caption = MsgData(LastTop + 1) CdKey = LastTop End If End Sub Private Sub Lbl2_Click() Me.Hide Select Case CdKey Case 0 MsgBox "我是第一个菜单项" Case 1 MsgBox "我是传说中的第二" Case Else MsgBox MsgData(CdKey + 1) End Select End Sub '------------------------------------------------ '文件 Module1.bas Attribute VB_Name = "Module1" Type CdFont Size As Integer Bold As Boolean Name As String Color As Long Italic As Boolean End Type Type CdStyle Caption() As String Appearance As Integer BackColor As Long ForeColor As Long AlignMent As Integer CdFont As CdFont End Type Public MsgLine As Integer, MsgWidth As Integer Public MsgData() As String Public Sub ShowCd(cFrm As Object, cButton As Object, CdCss As CdStyle) Dim i As Integer MsgLine = UBound(CdCss.Caption) MsgWidth = CdCss.CdFont.Size * CdCss.CdFont.Size + 5 ReDim MsgData(1 To UBound(CdCss.Caption)) MsgData = CdCss.Caption With CdFrm .BackColor = CdCss.BackColor .Height = MsgWidth * MsgLine .Lbl1.Appearance = CdCss.Appearance .Lbl1.Caption = "" .Lbl1.FontName = CdCss.CdFont.Name .Lbl1.FontSize = CdCss.CdFont.Size .Lbl1.FontBold = CdCss.CdFont.Bold .Lbl1.ForeColor = CdCss.CdFont.Color .Lbl1.FontItalic = CdCss.CdFont.Italic .Lbl1.Height = .Height .Lbl1.Width = .Width .Lbl1.Top = 0: .Lbl1.Left = 0 .Lbl1.AlignMent = CdCss.AlignMent .Lbl2.Appearance = CdCss.Appearance .Lbl2.FontName = CdCss.CdFont.Name .Lbl2.FontBold = CdCss.CdFont.Bold .Lbl2.FontItalic = CdCss.CdFont.Italic .Lbl2.FontSize = CdCss.CdFont.Size .Lbl2.Height = .Height / MsgLine + 5 .Lbl2.Width = .Width .Lbl2.Top = 0: .Lbl2.Left = 0 .Lbl2.AlignMent = .Lbl1.AlignMent .Lbl2.BackColor = CdCss.ForeColor .Lbl2.Caption = MsgData(1) For i = 1 To MsgLine .Lbl1.Caption = .Lbl1.Caption & CdCss.Caption(i) & vbCrLf Next i .Top = cFrm.Top + cButton.Top + cButton.Height + cButton.Height / 2 .Left = cFrm.Left + cButton.Left + cButton.Width / 2 .Show 1 End With End Sub