CAD/CAM discussion forum > CAD > VBA: - GetPoint vs. ShortCutMenu response problem

VBA: - GetPoint vs. ShortCutMenu response problem

Rank: 1

OldForumPost

Newbie

posts: 0

Registered: 2012-1-14

Message 1 of 1

18-12-2009 08:10 . pm | View his/her posts only

Hello everyone,

[VB/VBA, ZwCAD 2009/2010beta]:
how to recognize what option of standard ShortCutMenu was clicked - Enter/Cancel,
you can find description of problem below,
pls. copy/paste sample code to VBA editor and search phrase 'here is problem:'





Option Explicit
'
Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Const VK_DELETE = &H2E
Const VK_RETURN = &HD
Const VK_ESCAPE = &H1B
Const VK_SPACE = &H20
Const MK_LBUTTON = &H1
Const MK_MBUTTON = &H10
Const MK_RBUTTON = &H2
'
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Const SM_SWAPBUTTON = 23
'

Function funSpecialKeyPressed(Optional retWhatKeyPressed As String) As Boolean
funSpecialKeyPressed = True
If GetAsyncKeyState(VK_DELETE) Then
retWhatKeyPressed = "DELETE"
ElseIf GetAsyncKeyState(VK_RETURN) Then
retWhatKeyPressed = "ENTER"
ElseIf GetAsyncKeyState(VK_ESCAPE) Then
retWhatKeyPressed = "ESCAPE"
ElseIf GetAsyncKeyState(VK_SPACE) Then
retWhatKeyPressed = "SPACE"
ElseIf GetAsyncKeyState(MK_LBUTTON) Then
retWhatKeyPressed = IIf(SM_SWAPBUTTON, "RBUTTON", "LBUTTON")
ElseIf GetAsyncKeyState(MK_MBUTTON) Then
retWhatKeyPressed = "MBUTTON"
ElseIf GetAsyncKeyState(MK_RBUTTON) Then
retWhatKeyPressed = IIf(SM_SWAPBUTTON, "LBUTTON", "RBUTTON")
Else
funSpecialKeyPressed = False
retWhatKeyPressed = ""
End If
End Function
'

Sub TEST_GetPoint()

Dim retVal
Dim retWhatKeyPressed As String

Dim Pt As New ZwcadPoint
Dim sKwords As String, sKword As String
Dim sPrompt As String
Dim ErrNumber As Long
Dim ErrDescription As String


sPrompt = "option A / option B / <point>: "
sKwords = "optionA optionB"

Debug.Print
Debug.Print
Debug.Print
Debug.Print
Debug.Print

With ActiveDocument.Utility

ErrNumber = 0
ErrDescription = ""

Call funSpecialKeyPressed(retWhatKeyPressed)

.InitializeUserInput 128, sKwords

On Error Resume Next
Set retVal = .GetPoint(, sPrompt)
If Err.Number <> 0 Then
ErrNumber = Err.Number
ErrDescription = Err.Description
Err.Clear
End If
On Error GoTo 0


If ErrNumber <> 0 Then

Select Case ErrDescription

Case "User input is a keyword"
sKword = .GetInput
If InStr(1, sKwords, sKword, vbBinaryCompare) > 0 Then
'KEYWORD - OK
Debug.Print "Recognized kWord: '" & sKword & "' "
GoTo OK
Else
'KEYWORD - DD
Debug.Print "Recognized bad kWord: '" & "' "
End If

Case "Method 'GetPoint' of object 'IIcadUtility' failed"
Debug.Print ErrDescription & " "

Case "Can't move focus to the control because it is invisible, not enabled, _
or of a type that does not accept the focus."
Debug.Print ErrDescription & " "

Case "Automation error"
Debug.Print ErrDescription & " "

Case Else
Debug.Print ErrDescription & " "

End Select 'Case Err.Description

Else 'Err
Debug.Print "Point: " & Format(retVal.X, "0.00") & "," & Format(retVal.Y, "0.00")
GoTo OK
End If 'Err

End With 'ActiveDocument

If funSpecialKeyPressed(retWhatKeyPressed) Then
'ESCAPE,RETURN,SPACE,MOUSE-CLICK

'''
''' here is problem:
''' - how to rocognize what option of shortcut menu - Enter/Ecsape - was clicked
''' there is no problem if you click a keyword, but Enter/Escape are not keywords
'''

Else
Debug.Print ErrDescription & " "
End If

OK:

End Sub

greg.bednarski2009-12-18 20:15:33
See also