'这个样子差不多了吧。。。
'把下面代码分别写入文本文件,再改下后缀。
'文件 工程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
二次补充:你添加这个代码试试,是不是你想要得效果?(mnu是已经定义好的一个带子菜单的菜单)
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = vbRightButton Then PopupMenu mnu
End Sub
===============================
补充:你看这里。https://gss0.baidu.com/7LsWdDW5_xN3otqbppnN2DJv/arteriosclerosis/pic/item/918fe55122115d4a1038c23f.jpg
================================
试试这个办法吧。比方说,你在菜单编辑器里设定标题为“菜单”,名称为“mnuTest”。那么,代码如下。
备注:代码中的255、500等数据是根据菜单大小来设定的,因为这个菜单有两个字符,所以这样设定。如果不是这样,你可以根据实际情况灵活调整数据,我这个代码只是一个思路与范例。
管用的。
===============================
Private Sub Form_Load()
mnuTest.Visible = False
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If X > 0 And X 0 And Y mnuTest.Visible = True
Else
mnuTest.Visible = False
End If
End Sub
如果你是做弹出式菜单,用菜单编辑器也是可以滴,将作为弹出式的菜单隐藏掉,在需要的地方显示就O了。
api做popmenu....