菜单

开发平台：
Visual Basic

Form1.frm：源码内容
							VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6765
   ClientLeft      =   60
   ClientTop       =   450
   ClientWidth     =   6930
   LinkTopic       =   "Form1"
   ScaleHeight     =   6765
   ScaleWidth      =   6930
   StartUpPosition =   3  '窗口缺省
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'**************************************************
'
'转载请注明：
'
'            功能：一个菜单栏的例子 1.01
'
'            作者：HexXiaoYou
'
'            E-mail:hexxiaoyou@gmail.com
'
'            Blog:http://hi.baidu.com/nianxiaoyou
'
'            2008.01.01
'
'            修正随窗口变化时，控件变化的问题。
'
'**************************************************
Option Explicit
Dim WithEvents listCommand1 As VB.CommandButton
Attribute listCommand1.VB_VarHelpID = -1
Dim WithEvents listCommand2 As VB.CommandButton
Attribute listCommand2.VB_VarHelpID = -1
Dim WithEvents listCommand3 As VB.CommandButton
Attribute listCommand3.VB_VarHelpID = -1
Dim WithEvents shuoming As VB.TextBox
Attribute shuoming.VB_VarHelpID = -1
Dim list_top(2 To 3) As Integer
Dim zhuangtai As Integer
Dim frmHeight As Integer
Private Sub Form_Load()
Me.Move (Screen.Width / 2 - 3000), (Screen.Height / 2 - 3000), 6000, 4000
Set shuoming = Controls.Add("VB.TextBox", "shuoming", Form1) '加入一个TextBox
With shuoming
        .Move Me.Width / 2, Me.Height / 2, 2000, 300 '设置TextBox位置和尺寸
        .Text = "程序作者：hexxiaoyou" '设置TextBox内容
        .BackColor = vbBlue    '背景颜色
        .ForeColor = vbRed      '字体颜色
        .Visible = True    '设置TextBox按钮为可见
        .SelStart = Len(shuoming.Text)  '光标位置
End With
Set listCommand1 = Controls.Add("VB.CommandButton", "listCommand1", Form1) '加入一个CommandButton
With listCommand1
        .Move 0, 0, 1500, 300 '设置CommandButton位置和尺寸
        .Caption = "菜单一" '设置CommandButton按钮的标题
        .Visible = True    '设置CommandButton按钮为可见
End With
Set listCommand2 = Controls.Add("VB.CommandButton", "listCommand2", Form1) '加入一个CommandButton
With listCommand2
        .Move 0, Me.Height - 1120, 1500, 300 '设置CommandButton位置和尺寸
        .Caption = "菜单二" '设置CommandButton按钮的标题
        .Visible = True '设置CommandButton按钮为可见
End With
Set listCommand3 = Controls.Add("VB.CommandButton", "listCommand3", Form1) '加入一个CommandButton
With listCommand3
        .Move 0, Me.Height - 820, 1500, 300 '设置CommandButton位置和尺寸
        .Caption = "菜单三" '设置CommandButton按钮的标题
        .Visible = True '设置CommandButton按钮为可见
End With
list_top(2) = listCommand2.Top '记录listCommand2在y轴上位置
list_top(3) = listCommand3.Top '记录listCommand3在y轴上位置
zhuangtai = 1
frmHeight = Me.Height
End Sub
Private Sub Form_Resize()
    list_top(2) = Me.Height - 1120 '记录listCommand2在y轴上位置
    list_top(3) = Me.Height - 820 '记录listCommand3在y轴上位置
If Me.Height < 4000 Then: Me.Height = 4000
If zhuangtai = 1 Then
    If frmHeight <> Me.Height Then
        If listCommand3.Top > frmHeight / 2 Then
            listCommand3.Top = list_top(3)
        Else
            listCommand2.Top = listCommand1.Height
        End If
        If listCommand2.Top > frmHeight / 2 Then
            listCommand2.Top = list_top(2)
        Else
            listCommand3.Top = listCommand2.Top + listCommand2.Height
        End If
    End If
End If
frmHeight = Me.Height
End Sub
Private Sub listCommand1_Click()
If listCommand3.Top < Me.Height / 2 Then  '当listCommand3在上方位置时
        Do
            DoEvents
            listCommand3.Top = listCommand3.Top + 10  '用循环逐步让listCommand3按钮向下移
        Loop Until listCommand3.Top + 10 > list_top(3)  '直到它的位置与加载时的位置相近
        listCommand3.Top = list_top(3)      '则让他回到加载时位置
End If
If listCommand2.Top < Me.Height / 2 Then    '当listCommand2在上方位置时  标记一
        Do
            DoEvents
            listCommand2.Top = listCommand2.Top + 10    '用循环逐步让listCommand2按钮向下移
        Loop Until listCommand2.Top + 10 > listCommand3.Top '直到它的位置与加载时的位置相近
        listCommand2.Top = list_top(2)      '则让他回到加载时位置
End If
End Sub
Private Sub listCommand2_Click()
    If listCommand2.Top > Me.Height / 2 Then  '当listCommand2在下方位置时  标记二
        Do
            DoEvents
            listCommand2.Top = listCommand2.Top - 10    '用循环逐步让listCommand2按钮向上移
        Loop Until listCommand2.Top - 10 < listCommand1.Height  '直到它的位置与listCommand1的位置相近
        listCommand2.Top = listCommand1.Height          '则让他回到listCommand1下方位置
    End If
    If listCommand3.Top < Me.Height / 2 Then        '同 标记一
        Do
            DoEvents
            listCommand3.Top = listCommand3.Top + 10
        Loop Until listCommand3.Top + 10 > list_top(3)
        listCommand3.Top = list_top(3)
    End If
End Sub
Private Sub listCommand3_Click()
    If listCommand2.Top > Me.Height / 2 Then    '同 标记二
        Do
            DoEvents
            listCommand2.Top = listCommand2.Top - 10
        Loop Until listCommand2.Top - 10 < listCommand1.Height
        listCommand2.Top = listCommand1.Height
    End If
    If listCommand3.Top > Me.Height / 2 Then    '当listCommand3在下方位置时
        Do
            DoEvents
            listCommand3.Top = listCommand3.Top - 10    '用循环逐步让listCommand3按钮向上移
        Loop Until listCommand3.Top - 10 < listCommand2.Top + listCommand2.Height '直到它的位置与listCommand2的位置相近
        listCommand3.Top = listCommand2.Top + listCommand2.Height  '则让他回到listCommand2下方位置
    End If
End Sub

						