Private Const MF_CHECKED = &H8&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const TPM_CENTERALIGN = &H4&
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_RIGHTALIGN = &H8&
Private Const TPM_BOTTOMALIGN = &H20&
Private Const TPM_TOPALIGN = &H0&
Private Const TPM_VCENTERALIGN = &H10&
Private Const TPM_NONOTIFY = &H80&
Private Const TPM_RETURNCMD = &H100&
Private Const TPM_HORNEGANIMATION = &H800&
Private Const TPM_HORPOSANIMATION = &H400&
Private Const TPM_NOANIMATION = &H4000&
Private Const TPM_VERNEGANIMATION = &H2000&
Private Const TPM_VERPOSANIMATION = &H1000&
Private Const TPM_RECURSE = &H1&
Private Type POINTAPI
x As Long
y As Long
End Type
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal HWnd As Long, ByVal lptpm As Any) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
Dim pt As POINTAPI
Dim Retval As Long, hMenu As Long
hMenu = CreatePopupMenu()
AppendMenu hMenu, MF_STRING, 1, "Open File"
AppendMenu hMenu, MF_SEPARATOR, 2, ByVal 0&
AppendMenu hMenu, MF_STRING, 3, "Compress >>"
AppendMenu hMenu, MF_STRING, 4, "Decompress <<"
AppendMenu hMenu, MF_SEPARATOR, 5, ByVal 0&
AppendMenu hMenu, MF_STRING, 6, "..:: Customize ::.."
AppendMenu hMenu, MF_SEPARATOR, 7, ByVal 0&
AppendMenu hMenu, MF_STRING, 8, "//[Console App]\\"
AppendMenu hMenu, MF_STRING, 9, "^^ About ^^"
GetCursorPos pt
Retval = TrackPopupMenuEx(hMenu, TPM_VCENTERALIGN Or TPM_RETURNCMD, pt.x, pt.y, Me.hwnd, ByVal 0&)
If Retval = 1 Then Call PictureButton1_Click
If Retval = 3 Then Call PictureButton2_Click
If Retval = 4 Then Call PictureButton3_Click
If Retval = 6 Then Customize.Show 1
If Retval = 9 Then About.Show 1
If Retval = 8 Then
objDOS.ExecuteCommand
objDOS.CommandLine = App.Path + "\console.exe"
objDOS.ExecuteCommand
Text2.Text = objDOS.Outputs
End If
DestroyMenu hMenu
End Sub