- Код: Выделить всё
'Это код формы Menu она-же разверт.
Option Explicit
Private Declare Function ReleaseCapture Lib "user32" () As Long
Dim MAX As Long
Dim TX As String
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If x > 0 And x < Me.ScaleWidth And y < Me.ScaleHeight And y > 0 Then
If Item((y \ TextHeight("A") + 1)).Enabled = False Then Exit Sub
Else
Closed = True
ReleaseCapture
Unload Menu
Me.Refresh
Set Menu = Nothing
End If
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim Y1&
Me.Cls
Form_Load
Y1 = (y \ TextHeight("A")) * TextHeight("A")
If x < 0 Or x > ScaleWidth Or y < 0 Or y > ScaleHeight Then
Exit Sub
Else
If (y \ TextHeight("A")) > MaxCount - 1 Then
Else
If Item((y \ TextHeight("A") + 1)).Enabled = True Then
Line (0, Y1)-(Width - 40, Y1 + TextHeight("A")), 0, BF
Line (0, Y1)-(Width - 40, Y1 + TextHeight("A")), &HC0C0C0, B
End If
End If
End If
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Item((y \ TextHeight("Start") + 1)).Enabled Then
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
If Item((y \ TextHeight("About") + 1)).Enabled Then
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
If Item((y \ TextHeight("Open exe File") + 1)).Enabled Then
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
If Item((y \ TextHeight("Exit") + 1)).Enabled Then
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
End Sub
Private Sub Form_Load()
Dim i&, LenSep As Long, ii&
Closed = False
Me.Height = MaxCount * TextHeight("A") + 50
For i = 1 To MaxCount
If MAX < TextWidth(Item(i).Text) Then
MAX = TextWidth(Item(i).Text)
LenSep = Len(Item(i).Text)
End If
Next
For i = 1 To MaxCount
If Item(i).Text = "SePor" Then
Me.ForeColor = &H8000000C
For ii = 1 To LenSep + 2
TX = TX & "-"
Next
Print TX
Else
CurrentX = 30
If Item(i).Enabled = False Then
Me.ForeColor = &H8000000C
Print Item(i).Text
Else
Me.ForeColor = vbBlack
Print Item(i).Text
End If
End If
Next
Me.Width = MAX + 70
End Sub
'___________________________________________
'Это код Модуля:
Option Explicit
Public Type ItTyp
Enabled As Boolean
Text As String
Key As String
End Type
Public MaxCount As Long
Global Closed As Boolean
Public Item() As ItTyp
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function SetCapture Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Dim XY As POINTAPI
Public Sub AddItem(Enabled As Boolean, Text As String, Optional Key As String)
Static i&
i = i + 1
ReDim Preserve Item(i)
Item(i).Enabled = Enabled
Item(i).Text = Text
Item(i).Key = Key
MaxCount = i
End Sub
Public Sub ShowMenu()
Dim XY As POINTAPI
GetCursorPos XY
Load Menu
Menu.Left = XY.x * Screen.TwipsPerPixelX
Menu.Top = XY.y * Screen.TwipsPerPixelY
Menu.Show
SetCapture Menu.hwnd
Do
If Closed = True Then
Exit Do
End If
DoEvents
Loop
End Sub
'Этот код вставляется в форму на каторой разв. Menu
Dim a&
AddItem True, "Start"
AddItem True, "About"
AddItem False, "SePor"
AddItem False, "Open exe File"
AddItem False, "SePor"
AddItem True, "Exit"
Проблема в том что у меня не выходит сделать чтобы этот код реагировал на выбор пользователя , например:
- Код: Выделить всё
If Item((y \ TextHeight("Start") + 1)).Enabled Then
'Здесь я вставляю например
MsgBox "Strat"
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
If Item((y \ TextHeight("About") + 1)).Enabled Then
'И здесь я вставляю
MsgBox "About"
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
If Item((y \ TextHeight("Open exe File") + 1)).Enabled Then
MsgBox "Open"
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
If Item((y \ TextHeight("Exit") + 1)).Enabled Then
MsgBox "Exit now"
ReleaseCapture
Unload Menu
Menu.Refresh
Set Menu = Nothing
End If
Здесь и проблема прога реагирует на нажатие на развернувшемся меню но ана не выполняет то что выбрал пользователь а делает все подрят ! Сначало идет MsgBox "Start" и так все праходят за одно нажатие!
Help me! Может есть код проще !
