Embedded Visual Basic Windows Ce And Pocket Pc Mobile Applications [Electronic resources] نسخه متنی

Non-UDT API Examples

Now that we've covered how to declare APIs, let's look at something a bit more interesting: their use. We'll start by looking at some simple APIs that I find provide useful functionality beyond what eVB exposes and that don't require any workarounds, such as the UDT workaround covered later, to use.

BringWindowToTop

Declare Function BringWindowToTop Lib "Coredll" (ByVal hwnd As Long) As LongA common annoyance in Windows CE is the inability to show forms modally. This can lead to users sending your application behind another form, often by accidentally clicking just outside your form or by pressing one of their device's hardware buttons.

To bring the form back to the top of the z-order, simply call the BringWindowToTop API with the target window's hWnd. For example, if your application has a form named frmMain, to bring it to the top, and therefore make it visible to users, you would call

BringWindowToTop(frmMain.hWnd)

CompareString

Declare Function CompareString Lib "Coredll" Alias "CompareStringW"  _
(ByVal Locale As Long, _
ByVal dwCmpFlags As Long, _
ByVal lpString1 As String, _
ByVal cchCount1 As Long, _
ByVal lpString2 As String, _
ByVal cchCount2 As Long) As Long

Comparing strings for exact equality is a simple task in eVB. For example, you can compare apples and oranges as in Listing 9.1's code.

Listing 9.1 The Non-API Way of Comparing Strings

Private Sub TestCompareString()
Dim strString1 As String
Dim strString2 As String
Dim bEqual As Boolean
strString1 = "apples"
strString2 = "oranges"
bEqual = strString1 = strString2
If bEqual Then
MsgBox "They're Equal"
Else
MsgBox "They're Not Equal"
End If
End Sub

And you would get a message box telling users that They're Not Equal.

But what if you wanted to compare Apples to apples? Or AppLes to aPplEs? One option would be to change the case on both to all uppercase or all lowercase and then make the comparison, but then you lose the original string.

A faster, more elegant solution is to use the CompareString API. With CompareString, you can make comparisons without worrying about the case..

Look at the parameters to CompareString. First, you need to provide a

locale, which is simply a regional setting for the device that may affect the comparison. For example, comparisons in Chinese would be different than in U.S. English. It's simplest to use 0, which equates to LANG_NEUTRAL, SUBLANG_NEUTRAL, and SORT_DEFAULT.

Next you need to provide comparison flag(s). Here the following two flags are useful, and either or both can be used: NORM_IGNORECASE and NORM_IGNORESYMBOLS. The first ignores case; the second ignores any symbols and punctuation. The constants are defined as

Const NORM_IGNORECASE = &H1
Const NORM_IGNORESYMBOLS = &H4

The next two parameters are the first string to compare and its length in character, and the last two parameters are the second string to compare and its length in characters.

Rather than return true or false, this function returns one of three values, defined as

Const CSTR_LESS_THAN = 1        ' string 1 less than string 2
Const CSTR_EQUAL = 2            ' string 1 equal to string 2
Const CSTR_GREATER_THAN = 3     ' string 1 greater than string

So using the previous example, you could create the code shown in Listing 9.2 and you would get a message box declaring that They're Equal, even though the cases vary and both have symbols in them.

Listing 9.2 Comparing Strings with an API Call to Ignore Case as Well as Punctuation and Symbols

Private Sub TestCompareString()
Dim strString1 As String
Dim strString2 As String
Dim iCompare As Integer
strString1 = "AppLes?"
strString2 = "[aPp.lEs]"
iCompare = CompareString(0, NORM_IGNORECASE Or NORM_IGNORESYMBOLS, _
strString1, Len(strString1), strString2, Len(strString2))
If iCompare = CSTR_EQUAL Then
MsgBox "They're Equal"
ElseIf iCompare = CSTR_GREATER_THAN Then
MsgBox strString1 & " is greater than " & strString2
Else
MsgBox strString1 & " is less than " & strString2
End If
End Sub

CopyFile

Declare Function CopyFile Lib "Coredll" Alias "CopyFileW" _
(ByVal lpExistingFileName As String, _
ByVal lpNewFileName As String, _
ByVal bFailIfExists As Long) As Long

Occasionally I find that I need to copy a file in an application, but don't necessarily want to deal with the overhead of creating a full CEFileSystem object to do so. The CopyFile API works great for this situation. The first parameter is the name of the file to be copied, including path. The second parameter is the name of the new file to be created. The third is a flag to tell it whether to overwrite any existing file with the same name.

So if I wanted to make a copy of my application's error log file, ERRLOG.TXT, to a different directory and mark it with the app name and date, I could use the code in Listing 9.3.

Listing 9.3 A Simple File Copy Operation

Private Sub MoveErrLog()
Dim strSource As String
Dim strDestination As String
Dim lReturn As Long
strSource = App.Path & "\ERRLOG.TXT"
strDestination = "\ErrLogs\MyApp" & DatePart("yyyy", Now) _
& DatePart("m", Now) _
& DatePart("d", Now) _
& ".TXT"
lReturn = CopyFile(strSource, strDestination, True)
If lReturn = 0 Then
MsgBox "File Copy Failed!", vbExclamation, "Error"
End If
End Sub

CreateProcess

Declare Function CreateProcess Lib "Coredll" Alias "CreateProcessW" _
(ByVal lpImageName As String, _
ByVal lpCmdLine As String, _
ByVal psaProcess As Long, _
ByVal psaThread As Long, _
ByVal bInheritSec As Boolean, _
ByVal lCreate As Long, _
ByVal lEnviron As Long, _
ByVal lpDirectory As Long, _
ByVal psaStartInfo As Long, _
ByVal psaProcInfo As Long) As Long

Because the VB Shell() function doesn't exist in eVB, running another program from eVB can be done only through an API call. CreateProcess isn't in the WINCEAPI.TXT API declaration file, and therefore doesn't show up in the API Text Viewer, which is surprising because it's a very useful function.

While the declaration looks a bit daunting, and a quick glance in the eMbedded Visual Tools Help file shows that it takes a lot of UDTs as parameters, most of them are unsupported and can simply be passed as zero.

The only three parameters that you need to be concerned with are lpImageName, which is the name of the file you want to run; lpCmdLine, which contains any command-line parameters you want to pass the application; and lpDirectory, which is the application's startup directory.

Launching something like the Windows CE Calculator is as simple as this:

Private Sub LaunchCalculator()
Dim lReturn As Long
lReturn = CreateProcess("\Windows\calc.exe ", ", 0, 0, 0, 0, 0, 0, 0, 0)
If lReturn = 0 Then
MsgBox "Error launching application!", vbExclamation, "Error"
End If
End Sub

Remember that an eVB application is actually interpreted, and therefore hosted within pvbload.exe, so launching another eVB app would be correctly done like this:

lReturn = CreateProcess("\Windows\pvbload.exe ", _
"\MyeVBApp.vb", 0, 0, 0, 0, 0, 0, 0, 0)

Creating Your Own DoEvents

DoEvents is probably one of the most misunderstood and maligned functions in Visual Basic, and I somehow think that the eVB team left it out for that reason. All too often I've read threads in discussion forums warning new programmers about the evils and perils that DoEvents wreaks and that there is never any good cause to call it.

If you worked through Chapter 5, "Using the Windows CE WinSock for IR Communication," you may recall when you had to poll the WinSock control waiting for it to close after an error. This often takes a fraction of a second, but it's a good idea to wait, and we don't want to inconvenience users by locking up their devices while we do. This is a good example of when DoEvents is helpful, and therefore we need to do what Microsoft didn't and write one.

Regardless of its reputation, DoEvents isn't terribly arcane or mysterious. Its function, simply, is to check the Windows message queue, if a message is waiting, DoEvents then translates and sends, or dispatches the message, removing it from the queue as it does.

To do this, you make three API calls: PeekMessage, TranslateMessage, and DispatchMessage.

So the entire implementation, with API declarations, is shown in Listing 9.4.

Listing 9.4 Implementing DoEvents in eVB

Declare Function PeekMessage Lib "coredll.dll" Alias "PeekMessageW" _
(ByVal MSG As String, ByVal hWnd As Long, ByVal wMsgFilterMin As Integer, _
ByVal wMsgFilterMax As Integer, ByVal wRemoveMsg As Integer) As Boolean
Declare Function TranslateMessage Lib "coredll.dll" (ByVal MSG As String) _
As Boolean
Declare Function DispatchMessage Lib "coredll.dll" Alias "DispatchMessageW" _
(ByVal MSG As String) As Boolean
Public Const PM_REMOVE = 1
Public MSG  As String
Public Sub DoEventsCE()
MSG = String(18, Chr(0))
' Get message from queue and dispatch it
If PeekMessage(MSG, 0, 0, 0, PM_REMOVE) Then
TranslateMessage (MSG)
DispatchMessage (MSG)
End If
End Sub

Note

I've called this function DoEventsCE because the eVB IDE will throw an error if it's named DoEvents, thinking that it's a reserved word.

Shutting Down the Device

Public Declare Sub GwesPowerOffSystem Lib "Coredll" ()

Unfortunately, Windows CE doesn't support the ExitWindowsEx API that Windows 98/NT/2000 support, so you can't use it to reset the device. In fact, there are no direct code APIs to reset the device. There is, however, an undocumented API that can be used to shut down a PocketPC, and presumably any Windows CE 3.0, device.

Calling GwesPowerOffSystem is straightforward, but rude to users if you don't confirm that it should happen (unless you shut down due to inactivity):

Private Sub ShutDown()
If MsgBox("Shutdown device now?", vbYesNo, "Shutdown") = vbNo Then Exit Sub
GwesPowerOffSystem
End Sub

Keep in mind that this just takes the device to power save mode just as if you physically pressed the power button. Although the CPU will be idle, preventing any actual processing, your app will remain in the current task list unless you specifically shut it down.

GetActiveWindow

Declare Function GetActiveWindow Lib "Coredll" () As Long

A large number of API calls require a window handle, or hWnd, as a parameter. Unfortunately, most eVB controls don't expose their hWnd as a property like they do in VB 6.

GetActiveWindow returns the hWnd or the currently active control or window, so getting the hWnd of any control is simple as long as you can set the application focus to that control.

Here's a simple example. If you have a form that contains many controls, including a TextBox called txtName, you can get that control's hWnd using this code snippet:

Dim hWnd As Long
txtName.SetFocus
hWnd = GetActiveWindow()

You can then use that hWnd for any other API calls you want to make to change the look or behavior of txtName.

GetAsyncKeyState

Declare Function GetAsyncKeyState Lib "Coredll" (ByVal vKey As Long) _
As Integer

Determining if a key is down at any given time isn't straightforward in eVB, but the GetAsyncKeyState function easily provides this functionality. You simply call the function with the virtual key value for the key in which you're interested, which for the alphanumeric is just the key's ASCII value.

The function has more use when you use it to detect whether other keys are down, such as if the stylus is onscreen or if user is tapping a hardware directional button.

To determine if the stylus is onscreen, simply call GetAsyncKeyState with VK_LBUTTON, which is defined as &H01, like this:

Dim bStylusIsDown As Boolean
bStylusIsDown = GetAsyncKeyState(VK_LBUTTON)

All the virtual key codes can be found in the eVB Toolkit's Help files under Virtual Key Codes.

By itself, GetAsyncKeyState doesn't seem to have much utility, but later in the chapter under "Putting It All Together" you'll see how it is crucial for implementing a popup menu workaround.

GetTickCount

Declare Function GetTickCount Lib "Coredll" () As Long

The best way to test function or code segment performance is to time the code's execution. You can use the timer, but it really isn't designed to determine the length of time something takes to happen. It's designed to make something happen after a certain period of time. A subtle difference, but one that makes using it for performance testing a challenge.

GetTickCount, on the other hand, returns the number of milliseconds elapsed since the device was startedat least in theory. The actual resolution is based on the device's hardware and therefore may not be down to the millisecond. Also, because GetTickCount returns a Long instead of something like a Double, after about 50 days, it will wrap back to zero and begin counting again.

To time a section of code, simply store the result from GetTickCount before you enter the code, and then again after you exit. The difference between the two values is the time elapsed in milliseconds. Of course, it's always a good idea to run several iterations of the test and average the results. Listing 9.5 gives an example of testing the performance of a For...Next loop.

Listing 9.5 Timing the Performance of Code Pieces

Private Sub TestGetTickCount()
Dim i As Integer
Dim j As Integer
Dim strBuffer As String
Dim lStart As Long
Dim lStop As Long
Dim lElapsed As Long
Dim lAverage As Long
' Get the start time
lStart = GetTickCount()
For i = 1 To 10 ' Do 10 tests
For j = 1 To 500
strBuffer = strBuffer & "A"
Next j
Next i
' Get the stop time
lStop = GetTickCount()
' calculate the elapsed time
lElapsed = lStop - lStart
' calculate the average
lAverage = lElapsed / 10
MsgBox "The average execution time was " & lAverage & " ms"
End Sub

PlaySound

Declare Function PlaySound Lib "Coredll" Alias "PlaySoundW" _
(ByVal lpszName As String, _
ByVal hModule As Long, _
ByVal dwFlags As Long) As Long

Being able to notify users audibly that something has happened is often a nice feature. In VB 6, you can use the Beep function, but even with Windows NT, which does allow pitch changes that Windows 98 doesn't, the functionality is somewhat limited.

eVB doesn't support Beep, but the PlaySound API is far better anyway. It allows you to play any system sound or sound file on the device with a single call. That means that you can deploy your own sounds and not have to have a separate control to play them. You simply call PlaySound with the SND_FILENAME constant, which is defined as &H20000.

For example, if I want to play the exclamation sound on my device, I simply call PlaySound with the name of the sound file (Exclam). Here I've wrapped it in a Beep function:

Public Sub Beep()
PlaySound "Exclam", 0, SND_FILENAME
End Sub

You device should have several sound files in the Windows directory from which to choose, but be sure that you always distribute your sound files with your application, as not all devices have the same sound files included with them.

RegQueryValueEx and RegSetValueEx

Declare Function RegQueryValueEx Lib "Coredll" Alias "RegQueryValueExW" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
lpType As Long, _
ByVal lpData As String, _
lpcbData As Long) As Long
Declare Function RegSetValueEx Lib "Coredll" Alias "RegSetValueExW" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal Reserved As Long, _
ByVal dwType As Long, _
ByVal lpData As String, _
ByVal cbData As Long) As Long
Declare Function RegCreateKeyEx Lib "Coredll" Alias "RegCreateKeyExW" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal Reserved As Long, _
ByVal lpClass As String, _
ByVal dwOptions As Long, _
ByVal samDesired As Long, _
lpSecurityAttributes As Long, _
phkResult As Long, _
lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "Coredll" Alias "RegOpenKeyExW" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Declare Function RegCloseKey Lib "Coredll" Alias "RegCloseKey" _
(ByVal hKey As Long) As Long

Data persistence between successive runs of an application are important in almost any application. From user preferences to server names, usernames and passwords, users expect to have a lot of information to supply only once.

One option is to use the File object and create a configuration file for your application. Another more elegant, as well as more common, option is to use the device registry.

The registry on a Windows CE device is very similar to the Registry on a desktop machine, and contains only the following three root keys: HKEY_CLASSES_ROOT, HKEY_CURRENT_USER, and HKEY_LOCAL_MACHINE.

Unlike desktop Visual Basic's SaveSetting and GetSetting methods, eVB has no native methods to access even part of the registry, so any registry manipulation must be done with API calls. We will cover both reading a value with RegQueryValueEx and writing a value with RegSetValueEx by writing functions that mimic the desktop functions. They are named SaveSettingCE and GetSettingCE and we will try to preserve their original behavior.

To test and debug the functions it will be extremely helpful to be able to view a device's registry. Fortunately, eMbedded Visual Tools installs a registry editor by default, which can be accessed through the eVB Tools, Remote Tools, Registry Editor menu. In fact, you can use the Windows CE Remote Registry Editor to view and modify the local desktop registry as well.

If you launch the Windows CE Remote Registry Editor and select Connection, Add Connection, you will be prompted with the Select a Windows CE Device dialog (see Figure 9.3). From here you can select either your physical device or an emulator.

Initially, the editor presents a root node in the TreeView for the local desktop machine. Selecting a device will add to the TreeView a parent node for the connected device, as you can see in Figure 9.4.

Because Visual Basic 6's SaveSetting and GetSetting functions read and write from the HKEY_CURRENT_USER/Software/Microsoft key, we'll maintain that functionality.

SaveSettingCE

First, to save a value to the registry, open the desired key. If the key isn't there, you must create it. Both actions are handled by RegCreateKeyEx. Although RegCreateKeyEx has many parameters, Reserved, lpClass, dwOptions, samDesired, and lpSecurityAttributes are unsupported in Windows CE and simply take zero as a value. Also, lpdwDisposition returns a value of whether the key existed or was created, and in this case it's irrelevant so you can pass zero for it as well.

This leaves three parameters that you need to be concerned with: hKey, lpSubkey, and phkResult. Because we've decided to emulate the desktop functions, hKey will be set to HKEY_CURRENT_USER, which is defined as &H80000001, and lpSubKey will be a concatenation of Software\Microsoft and the passed-in AppName and Key parameters.

The remaining parameter, phkResult, is a Long that the handle to the opened key. You will need to pass it to RegSetValueEx.

All registry functions that you will be using return zero for success, so check the return of each call, and inform users if you fail. In production code, you would probably want to handle this more elegantly, but for these purposes, a simple error message box is sufficient.

After you have an open key, call RegSetValueEx to set whatever value you want. The parameters are: the key's handle, the ValueName (or section) within the key to set (which users provide), a reserved Long that you pass zero, the type of key that you pass REG_SZ (meaning a Unicode string and defined as 1), the value you want to set it to, and the value's length in bytes. Remember, a Unicode character is 2 bytes, so you need to use LenB instead of Len.

Next, check for success and notify users if there's a problem and end by closing the key you've opened.

To make this API easy to use, we can wrap it in a function named SaveSettingCE that mimics VB6's SaveSetting function (see Listing 9.6).

Listing 9.6 A Registry-Writing Function That Mimics VB6's SaveSetting Function

Public Function SaveSettingCE(AppName As String, Key As String, _
Section As String, _
Setting As String)
Dim lKey As Long
Dim lRet As Long
' Open the key, creating if necessary
lRet = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\" & _
AppName & "\" & Key, 0, 0, 0, 0, 0, lKey, 0)
' Check for success
If lRet <> 0 Then
MsgBox "Error opening key", vbExclamation, "Error"
Exit Function
End If
' Set the key value
' Value length is bytes, not characters
lRet = RegSetValueEx(lKey, Section, 0, REG_SZ, Setting, LenB(Setting))
' Check for success
If lRet <> 0 Then
MsgBox "Error saving value", vbExclamation, "Error"
Exit Function
End If
' Close the key
RegCloseKey lKey
End Function

Now saving a value to the registry is as simple as calling SaveSettingCE like this:

SaveSettingCE "Test App", "My Key", "My Section", "My Setting"

Use the Registry Editor to confirm that it worked (see Figure 9.5).

GetSettingCE

Reading a registry setting is similar to saving one. You open the key, retrieve the value, and finally close the key. There are a few other things to be aware of, as you'll see in Listing 9.7.

Listing 9.7 A Registry-Reading Function That Mimics VB6's GetSetting Function

Public Function GetSettingCE(AppName As String, Key As String, _
Section As String)
Dim lKey As Long
Dim lRet As Long
Dim strValue As String
Dim iValueLength As Integer
Dim lType As Long
' Allocate space for the value, setting it to zero
strValue = String(128, Chr(0))
' Initialize our length variable
iValueLength = Len(strValue) * 2
' Open the key
lRet = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\" & _
AppName & "\" & Key, 0, 0, lKey)
' Check for success
If lRet <> 0 Then
MsgBox "Error opening key", vbExclamation, "Error"
Exit Function
End If
' Get the key value
lRet = RegQueryValueEx(lKey, Section, 0, lType, strValue, iValueLength)
' Check for success
If lRet <> 0 Then
MsgBox "Error getting value", vbExclamation, "Error"
Exit Function
End If
' Close the key
RegCloseKey lKey
' Set return value
' Value length is bytes, not characters
GetSettingCE = LeftB(strValue, iValueLength)
End Function

Because eVB variables are Variants, you must first be sure you have enough space to hold the value the API call will be returning. I simply call the String function to create a 128-character (256 byte) string. This is arbitrary and you can adjust it to your needsjust be sure you have enough space for the longest value you will retrieve.

Next, set a variable to the byte length of the value buffer. This will tell the RegQueryValueEx API how many bytes you can accept in the buffer. If a key value is longer than what you state the buffer length is, the API call will fail.

Next, open the desired key, passing in the hKey, the ValueName, and a variable that the API will populate with the newly opened key's handle. Again you have some unsupported parametersdwOptions and samDesiredthat you pass zero to.

After checking for success, call RegQueryValueEx to retrieve your value. You need to pass the API a variable for the key type, which will come back as REG_SZ (1) for any of the values you set. You also pass it the buffer variable and the length variable. The API call will change the length variable to the length, in bytes, of the returned key value.

Again, check for success and close the key. Before returning, though, you need to trim the buffer variable to the length of the actual key value returned. LeftB returns a specific number of bytes instead of characters, so use it to grab the data and assign it as your function's return value.

You can now retrieve the value you set in the previous section like this:

GetSettingCE "Test App", "My Key", "My Section"

Sleep

Declare Sub Sleep Lib "Coredll" (ByVal dwMilliseconds As Long)

If you need your program to wait for a period of time without processing, such as when you display a splash screen, rather than use a timer control, you can simply call the Sleep API. Sleep simply pauses execution for the number of milliseconds passed in. Sleep also has the distinct advantage over something like an empty For...Next loop in that it uses no CPU cycles.

To pause for three seconds, you would call Sleep with 3000 like this:

Sleep 3000

Putting It All Together

Now that you've seen some code snippets for several API calls, let's look at how you can use API calls in an application. One significant functionality not supported by eVB is context-sensitive pop-up menus. When users tap and hold a control, it's a PocketPC standard that, if applicable, a pop-up menu should appear.

There is a way around this, though, that provides eVB developers the pop-ups available in eVC.

Basically you'll use API calls to determine if users have held the stylus down for a set period of time. If they have, you then programmatically create a pop-up menu with additional API calls and display it.

First, create a PocketPC project with a single form, frmPopupTest, and single module, modMain.

Next, add two Labels, lblPopupTestA and lblPopupTestA, to frmMain. The header for frmPopupTest should now look something like this:

Begin VB.Form frmPopupTest
Caption         =   "Popup Menu Test"
ClientHeight    =   3615
ClientLeft      =   60
ClientTop       =   840
ClientWidth     =   3480
Begin VBCE.Label lblPopupTestB
Height          =   855
Left            =   960
Top             =   1560
Width           =   1455
Caption         =   "Tap and Hold for Menu B"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Size            =   11.25
EndProperty
Alignment       =   2
End
Begin VBCE.Label lblPopupTestA
Height          =   855
Left            =   960
Top             =   420
Width           =   1455
Caption         =   "Tap and Hold for Menu A"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Size            =   11.25
EndProperty
Alignment       =   2
End
End

In modMain, add the declarations for PeekMessage, TranslateMessage, DispatchMessage, GetAsyncKeyState, GetTickCount, CreatePopupMenu, DestroyMenu, AppendMenu and TrackPopupMenuEx.

Add the following API constants: PM_REMOVE, VK_LBUTTON, MF_ENABLED, MF_STRING, MF_GRAYED, MF_CHECKED, MF_UNCHECKED, MF_SEPARATOR, TPM_TOPALIGN, TPM_LEFTALIGN, TPM_RETURNCMD, a global MSG string, and the DoEventsCE implementation.

modMain should look like the code in Listing 9.8.

Listing 9.8 API Declarations and Routines Needed for Implementing Pop-Up Menus

Option Explicit
' API Declarations
Declare Function PeekMessage Lib "coredll.dll" Alias "PeekMessageW" _
(ByVal MSG As String, _
ByVal hWnd As Long, _
ByVal wMsgFilterMin As Integer,  _
ByVal wMsgFilterMax As Integer, _
ByVal wRemoveMsg As Integer) As Boolean
Declare Function TranslateMessage Lib "coredll.dll" _
(ByVal MSG As String) As Boolean
Declare Function DispatchMessage Lib "coredll.dll" _
Alias "DispatchMessageW" _
(ByVal MSG As String) As Boolean
Public Declare Function GetAsyncKeyState Lib "Coredll" _
(ByVal vKey As Long) As Integer
Public Declare Function GetTickCount Lib "Coredll" () As Long
Public Declare Function CreatePopupMenu Lib "Coredll" () As Long
Public Declare Function DestroyMenu Lib "Coredll" _
(hMenu As Long) As Integer
Public Declare Function AppendMenu Lib "Coredll" _
Alias "AppendMenuW" (ByVal hMenu As Long, _
ByVal wFlags As Long, _
ByVal wIDNewItem As Long, _
ByVal lpNewItem As String) As Long
Public Declare Function TrackPopupMenuEx Lib "Coredll" _
(ByVal hMenu As Long, _
ByVal un As Long, _
ByVal n1 As Long, _
ByVal n2 As Long, _
ByVal hWnd As Long, _
lpTPMParams As Long) As Long
' API Constants
Public Const PM_REMOVE = &H1
Public Const VK_LBUTTON = &H1
Public Const MF_ENABLED = &H0&
Public Const MF_STRING = &H0&
Public Const MF_GRAYED = &H1&
Public Const MF_CHECKED = &H8&
Public Const MF_UNCHECKED = &H0&
Public Const MF_SEPARATOR = &H800&
Public Const TPM_TOPALIGN = &H0&
Public Const TPM_LEFTALIGN = &H0&
Public Const TPM_RETURNCMD = &H100&
Public MSG  As String
Public Sub DoEventsCE()
MSG = String(18, Chr(0))
' Get message from queue and dispatch it
If PeekMessage(MSG, 0, 0, 0, PM_REMOVE) Then
TranslateMessage (MSG)
DispatchMessage (MSG)
End If
End Sub

To determine when to pop up the menu, you need to determine that the stylus is on your control

and has been down for a certain period of time. This sample waits one second. This can all be done in the MouseDown event of a specific control. Listing 9.9 shows the MouseDown event handler for lblPopupTestA. The handler for lblPopupTestB is almost identical.

Listing 9.9 Determining Whether Users Have Held the Stylus Down for More Than a Second

Private Sub lblPopupTestA_MouseDown(ByVal Button As Integer, _
ByVal Shift As Integer, _
ByVal X As Single, _
ByVal Y As Single)
Dim lKey As Long
Dim lStart As Long
Dim lDuration As Long
' store the start time of the click
lStart = GetTickCount
Do While GetAsyncKeyState(VK_LBUTTON)
' determine how long the stylus has been down
lDuration = GetTickCount - lStart
' Allow the system to handle any other app events
DoEventsCE
' If the user has held it for 1 second, show the popup
If lDuration > 1000 Then
' display the menu
ShowMenuA Me.hWnd, lblPopupTestA.Left + X, _
lblPopupTestA.Top + Y
Exit Do
End If
Loop
End Sub

You can check the stylus state with a call to GetAsyncKeyState. As long as the stylus is down, keep checking, calling DoEventsCE with each loop iteration so that the device doesn't lock up. In the loop, keep checking the elapsed time since the stylus was first pressed down. When the elapsed time reaches 1 second, or 1000 milliseconds, show the pop-up menu.

The last item you need to add is the actual menu handler that will create, display and handle the user's selection, all of which can be done in one function.

Listing 9.10 shows two different menu handlers: ShowMenuA and ShowMenuB. Both follow the same basic logic: create a popup menu, append items to it, display it, handle the user's selection and then destroy the menu. The only difference is that ShowMenuB shows a few different menu item attributes such as the divider and a grayed item.

Listing 9.10 Creating, Displaying, and Handling User Selections on a Pop-Up Menu

Public Sub ShowMenuA(hWnd As Long, X As Long, Y As Long)
Dim hMenu As Long
'Create a popup menu
hMenu = CreatePopupMenu
' Append our menu items
AppendMenu hMenu, MF_ENABLED Or MF_STRING, 1, "Menu Item 1"
AppendMenu hMenu, MF_ENABLED Or MF_STRING, 2, "Menu Item 2"
' display the popup and handle the user's selection
Select Case TrackPopupMenuEx(hMenu, _
TPM_LEFTALIGN Or TPM_TOPALIGN _
Or TPM_RETURNCMD, _
X / Screen.TwipsPerPixelX, _
Y / Screen.TwipsPerPixelY, _
hWnd, 0)
Case 1
MsgBox "You selected Item 1"
Case 2
MsgBox "You selected Item 2"
End Select
' destroy the menu when we're done
DestroyMenu hMenu
End Sub
Public Sub ShowMenuB(hWnd As Long, X As Long, Y As Long)
Dim hMenu As Long
'Create a popup menu
hMenu = CreatePopupMenu
' Append our menu items
AppendMenu hMenu, MF_ENABLED Or MF_STRING, 1, "&Open"
AppendMenu hMenu, MF_ENABLED Or MF_STRING, 2, "&New"
AppendMenu hMenu, MF_SEPARATOR Or MF_STRING, 3, "-"
AppendMenu hMenu, MF_GRAYED Or MF_STRING, 4, "E&xit"
' display the popup and handle the user's selection
Select Case TrackPopupMenuEx(hMenu, _
TPM_LEFTALIGN Or TPM_TOPALIGN _
Or TPM_RETURNCMD, _
X / Screen.TwipsPerPixelX, _
Y / Screen.TwipsPerPixelY, _
hWnd, 0)
Case 1
MsgBox "You selected Open"
Case 2
MsgBox "You selected New"
Case 4
MsgBox "You selected Exit"
End Select
' destroy the menu when we're done
DestroyMenu hMenu
End Sub