| 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. Figure 9.3. Selecting the locally connected PocketPC for registry editing.  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. Figure 9.4. The Windows CE Remote Registry Editor connected to a PocketPC device.  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). Figure 9.5. The device registry after inserting your value with SaveSettingCE.  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 | 
