Menu

Программирование на Visual Basic, главный форум. Обсуждение тем программирования на VB 1—6.
Даже если вы плохо разбираетесь в VB и программировании вообще — тут вам помогут. В разумных пределах, конечно.
Правила форума
Темы, в которых будет сначала написано «что нужно сделать», а затем просьба «помогите», будут закрыты.
Читайте требования к создаваемым темам.
Max!
Постоялец
Постоялец
Аватара пользователя
 
Сообщения: 502
Зарегистрирован: 03.04.2003 (Чт) 22:08
Откуда: Литва

Menu

Сообщение Max! » 28.11.2003 (Пт) 0:47

Я тут нашол код типа примера меню на форме вот код:

Код: Выделить всё

'Это код формы 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! Может есть код проще ! :x
Max!

Вернуться в Visual Basic 1–6

Кто сейчас на конференции

Сейчас этот форум просматривают: AhrefsBot и гости: 9

    TopList