Hello, im just wondering if anyone has managed to get VBA menu's to work properly from the FactoryTalk View SE Client application via VBA? Our Client spec requires a right click menu otherwise i would have created a seperate small popup graphic and passed it a para file.
I have used an example i found and customised it to get it working how i want it, but i have a few issues of when the menu is called and active on the screen, it wont clear when i click off the menu, change screen, press ESC etc. It also will not run again if i make a selection (i have to reload mimic everytime)
this is what i have done so far, i have got this running in a VBA module:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecends As Long)
Dim l As Long
'Private m_hMenu As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const MF_STRING = &H0&
Private Const MF_CHECKED = &H8&
Private Const MF_APPEND = &H100&
Private Const TPM_LEFTALIGN = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const TPM_RETURNCMD = &H100&
Private Const MF_MENUBARBREAK = &H20&
Private Const MF_POPUP = &H10&
Private Const MF_MENUBREAK = &H40&
Private Const MF_BYCOMMAND = &H0&
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 CreatePopupMenu Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hwnd As Long, lpTPMParams As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal m_hMenu As Long) As Long
Public Function PopupMenu(ID As String)
Dim Pt As POINTAPI
Dim m_hMenu As Long
Dim hwnd As Long
On Error GoTo ErrorHandler
'Obtain cursor position
GetCursorPos Pt
'Initialise menu variables
m_hMenu = 0
m_hMenu = CreatePopupMenu()
'Create static menu options
AppendMenu m_hMenu, MF_STRING, ByVal 1, "Status Screen"
AppendMenu m_hMenu, MF_STRING, ByVal 2, "Trend Screen"
AppendMenu m_hMenu, MF_STRING, ByVal 3, "Control Screen"
'Obtain current window handle
hwnd = FindWindow(vbNullString, vbNullString)
'Display menu
l = TrackPopupMenuEx(m_hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, Pt.X, Pt.Y, hwnd, ByVal 0&)
'If the 'status' option has been chosen
If l = 1 Then
ExecuteCommand "Display Status"
' If the 'trend' option has been chosen
ElseIf l = 2 Then
ExecuteCommand "Display Trend"
' If the 'Control' option has been chosen
ElseIf l = 3 Then
ExecuteCommand "Display Control"
End If
Exit Function
ErrorHandler:
LogDiagnosticsMessage "VBA Error with Right Click Menu Generation"
End Function
Then to call the module i use this from the object:
Private Sub WKSS_C02_MouseUp(ByVal Button As DisplayClientEx.gfxMouseButtonConstants, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)
If Button = 2 Then
Call PopupMenu("WKSS_C02")
End If
End Sub
Any help at this point would be great as ive spent many hours playing about the code with no luck, my VBA experience would probably be classed as beginner by the way - im more of a AB PLC guy than a SCADA guy - but we all got to start somewhere!
Thanks
I have used an example i found and customised it to get it working how i want it, but i have a few issues of when the menu is called and active on the screen, it wont clear when i click off the menu, change screen, press ESC etc. It also will not run again if i make a selection (i have to reload mimic everytime)
this is what i have done so far, i have got this running in a VBA module:
Option Explicit
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMillisecends As Long)
Dim l As Long
'Private m_hMenu As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Const MF_STRING = &H0&
Private Const MF_CHECKED = &H8&
Private Const MF_APPEND = &H100&
Private Const TPM_LEFTALIGN = &H0&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_SEPARATOR = &H800&
Private Const TPM_RETURNCMD = &H100&
Private Const MF_MENUBARBREAK = &H20&
Private Const MF_POPUP = &H10&
Private Const MF_MENUBREAK = &H40&
Private Const MF_BYCOMMAND = &H0&
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 CreatePopupMenu Lib "user32" () As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal un As Long, ByVal n1 As Long, ByVal n2 As Long, ByVal hwnd As Long, lpTPMParams As Any) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal m_hMenu As Long) As Long
Public Function PopupMenu(ID As String)
Dim Pt As POINTAPI
Dim m_hMenu As Long
Dim hwnd As Long
On Error GoTo ErrorHandler
'Obtain cursor position
GetCursorPos Pt
'Initialise menu variables
m_hMenu = 0
m_hMenu = CreatePopupMenu()
'Create static menu options
AppendMenu m_hMenu, MF_STRING, ByVal 1, "Status Screen"
AppendMenu m_hMenu, MF_STRING, ByVal 2, "Trend Screen"
AppendMenu m_hMenu, MF_STRING, ByVal 3, "Control Screen"
'Obtain current window handle
hwnd = FindWindow(vbNullString, vbNullString)
'Display menu
l = TrackPopupMenuEx(m_hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, Pt.X, Pt.Y, hwnd, ByVal 0&)
'If the 'status' option has been chosen
If l = 1 Then
ExecuteCommand "Display Status"
' If the 'trend' option has been chosen
ElseIf l = 2 Then
ExecuteCommand "Display Trend"
' If the 'Control' option has been chosen
ElseIf l = 3 Then
ExecuteCommand "Display Control"
End If
Exit Function
ErrorHandler:
LogDiagnosticsMessage "VBA Error with Right Click Menu Generation"
End Function
Then to call the module i use this from the object:
Private Sub WKSS_C02_MouseUp(ByVal Button As DisplayClientEx.gfxMouseButtonConstants, ByVal Shift As Integer, ByVal X As Long, ByVal Y As Long)
If Button = 2 Then
Call PopupMenu("WKSS_C02")
End If
End Sub
Any help at this point would be great as ive spent many hours playing about the code with no luck, my VBA experience would probably be classed as beginner by the way - im more of a AB PLC guy than a SCADA guy - but we all got to start somewhere!
Thanks