Platinum Edition Using Visual Basic 5

Previous chapterNext chapterContents


- 46 -
Accessing the External Functions: The Windows API

As the structure of Windows evolved, Microsoft intentionally made a great number of programming functions available to all Windows-based programs. This strategy serves the dual purpose of giving Windows applications a consistent look and feel, as well as keeping programmers from having to duplicate programming efforts for functions that have already been coded and debugged. These functions are stored in a series of Dynamic Link Libraries (DLLs) and are known collectively as the Application Programming Interface (API). Since the evolution to the 32-bit operating systems, Windows 95 and Windows NT, the newer version is known as the Win32 API. Some of the functions in the Win32 API are available as Visual Basic commands, but the vast majority are accessible only by "calling" the API.

Although Microsoft has added what seems like thousands of great new features to Visual Basic's most recent releases, there are still many features in the Win32 API that the VB language is missing. This omission is intentional because VB includes the capability to call the API, so not every API function needs to be part of VB. The reason why it doesn't is that each Win32 API that VB "wraps" (duplicates) causes the VB runtime DLL to get larger. The larger the runtime, the slower your applications will be; it will take longer to load the runtime when your application boots. Therefore, Microsoft's exclusion of a large number of the Win32 APIs is really a good thing because the precious space in the VB runtime is being saved for cool new features.

This chapter explains how to use some of the more useful APIs, but it is far from a complete resource. No single chapter could do this subject justice, but there should be enough information here to get you started. Instead, the goal of this chapter is to turn you on to some of neat things you can do with the Win32 API. By using the API, you can write more advanced applications that are not possible with pure VB programming. Read on, and have fun playing with the examples.

Calling Basic API and DLLs

Although this chapter is not intended to teach you everything there is to know about accessing the API or writing declarations statements for use with DLLs, I will spend a little time in this section covering some fundamental basics. However, I will assume that you have already read the "Calling Procedures in DLLs" chapter in the Visual Basic Programmer's Guide. This information is designed to complement the Programmer's Guide by demonstrating how to implement a variety of helpful API calls.

GetVersionEx

The best way to learn how to use (or call) DLLs is to learn by example. The code in Listing 46.1 demonstrates how to use one of the most common Win32 API calls, GetVersionEx. When you call this API, it fills a user-defined type (UDT) called OSVERSIONINFO with information about the Windows version. Closely examine the code in this listing to see how we make this API call and use the return values.

Listing 46.1 WINVER.BAS--GetWindowsVersion Returns a Usable String Based on the Values Returned from GetVersionEx

`*********************************************************************
` Types, constants and declarations required to get the Win version
`*********************************************************************
Private Type OSVERSIONINFO
        dwOSVersionInfoSize As Long
        dwMajorVersion As Long
        dwMinorVersion As Long
        dwBuildNumber As Long
        dwPlatformId As Long
        szCSDVersion As String * 128 `Maintenance string for PSS usage
End Type
Private Const VER_PLATFORM_WIN32_NT = 2
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Declare Function GetVersionEx Lib "kernel32" Alias _
    "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
`*********************************************************************
` Returns a string suitable for displaying in a dialog box
`*********************************************************************
Public Function GetWindowsVersion() As String
    Dim strOS As String
    Dim osvVersion As OSVERSIONINFO
    Dim strMaintBuildInfo As String
    `*****************************************************************
    ` Many Win32 APIs have a first parameter that indicates the size
    ` of the structure (in bytes) so these structures will be portable
    ` to future OS versions or different systems (such as 64 bit
    ` systems or OS's). It is your responsibility to set this field
    ` prior to making the API call, and the Len function helps you
    ` to do that.
    `*****************************************************************
    osvVersion.dwOSVersionInfoSize = Len(osvVersion)
    `*****************************************************************
    ` Get the version (exit if the GetVersionEx failed)
    `*****************************************************************
    If GetVersionEx(osvVersion) = 0 Then Exit Function
    `*****************************************************************
    ` Get a string that represents the installed Operating System
    `*****************************************************************
    Select Case osvVersion.dwPlatformId
        Case VER_PLATFORM_WIN32_WINDOWS
            strOS = "Windows "
        Case VER_PLATFORM_WIN32_NT
            strOS = "Windows NT "
        Case Else ` Impossible because VB doesn't run under Win32s
            strOS = "Win32s "
    End Select
    `*****************************************************************
    ` Get the major, minor, and build numbers and concatenate them
    ` to the OS name
    `*****************************************************************
    With osvVersion
        strOS = strOS & CStr(.dwMajorVersion) & "." & _
            CStr(.dwMinorVersion) & "." & _
            CStr(.dwBuildNumber And &HFFFF&)
        
        strMaintBuildInfo = Left(.szCSDVersion, _
            InStr(.szCSDVersion, Chr(0)))
    End With
    `*****************************************************************
    ` If this isn't a maintenance build (i.e., 4.xx.xxxx A)...
    `*****************************************************************
    If strMaintBuildInfo = Chr(0) Then
        GetWindowsVersion = strOS
    `*****************************************************************
    ` Otherwise include the maintenance build info
    `*****************************************************************
    Else
        GetWindowsVersion = strOS & " " & _
            Left(strMaintBuildInfo, Len(strMaintBuildInfo) - 1)
    End If
End Function

This API call exhibits a common trait among many Win32 API calls in that it requires you to set the first member of the structure (dwOSVersionInfoSize) before calling the API. This is something new for Win32 that was not required in earlier versions of Windows. This is done so the Win32 API can be ported to future processors without requiring a new set of APIs. This means (in theory) that the Win32 code in this chapter should work unchanged in the future when the desktop computer world moves to 64-bits.

Declaring APIs

Now that you have seen how to use the GetVersionEx API call in VB, let's take a look at how you make this API available to VB. To make a function call from an external source (such as a DLL or the Win32 API), you need to write a declaration for this API in the General Declarations section. Here is what the declaration for GetVersionEx looks like:

Private Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

Let's dissect this call to understand what it really means. The first three words, Private Declare Function, mean that we are declaring an external function for use only within the current module. The next word, GetVersionEx, when used with the Alias label means that you would like to refer to this function by using the word GetVersionEx in your VB code. When using Alias, this value could be anything. If you wanted, you could have called this MyGetWinVer.

The next two words, Lib "kernel32", tell VB which "library" (DLL--the extension is optional) contains this function. The next two words, Alias "GetVersionExA," tell VB that anytime you call "GetVersionEx" in your program, it should call the function "GetVersionExA" in Kernel32.dll. Until now, the format of this API call is typical. The function, library, and alias names will differ, but all of these items appear in most API calls.

The next part of this call contains the argument list for the function GetVersionExA. It only has one parameter of type OSVERSION info that must be passed by reference (the default). Finally, the last two words, As Long, indicate that the function GetVersionExA returns a long integer.

Calling Functions in Other DLLs

Almost every document you will ever read about using DLLs in Visual Basic is going to use the API DLLs as an example. At the end of these documents, the writer explains how you can also grab these declarations out of the API Text Viewer program. This gives you a false sense of security because you depend heavily on the API Text Viewer for your API declarations. As soon as most programmers get a DLL (or new API) that doesn't appear in the API Text Viewer, they realize that they never really learned how to write a declaration themselves. Therefore, I've created an exercise where you look at the code for a small program and try to guess the API declarations.

Listing 46.2 uses two functions from a DLL that I wrote which creates and resolves shortcuts. The function names are CreateShortcut and ResolveShortcut; they are located in a DLL called Shortcut.dll, and they both return a long value. I have retained all of the comments and source code for this program, but I've relocated the declaration statements to Listing 46.3. Your mission, should you choose to accept it, is to examine the code and figure out what the declaration statement should be. Write your declaration on a sheet of paper and compare it with the actual declarations in Listing 46.3. Good luck!

Listing 46.2 SHORTCUT.FRM--Shortcut.frm Uses a Helper DLL to Manipulate Windows Shortcuts

`*********************************************************************
` Shortcut.frm - Uses Ronald R. Martinsen's shortcut.dll file to
`   create and resolve Windows 95 shortcuts.
`*********************************************************************
Option Explicit
`*********************************************************************
` Constant for the path of the shortcut file used for simplicity sake.
` This isn't required.
`*********************************************************************
Private Const SHORTCUTPATH As String = "c:\Shortcut to Notepad.lnk"
`*********************************************************************
` CreateShortcut - Required function declaration to create a shortcut
` with the helper DLL.
`--------------------------------------------------------------------
` strSourceFile - Filename of the target of the shortcut (can be a
`                 file, directory, or object)
` strLinkFile   - Name of the shortcut file on the disk (always use
`                 the LNK extension!!!!)
` strInitDir    - The current directory when the application starts*
` strArgs       - Command Line Arguments (i.e., filename)*
` intCmdShow    - Determines how to display the window (use Shell
`                 function constants)
` strIconPath   - The location of the DLL or EXE with the icon you
`                 wish to use.*
` intIconIndex  - The index of the icon you wish to use (only used if
`                 strIconPath was supplied)
` * = use vbNullString for the default
` RETURNS       - Zero if the call worked, otherwise a SCODE HRESULT.
`*********************************************************************
<< DECLARATION GOES HERE >>
`*********************************************************************
` ResolveShortcut - Required function declaration to get the target
` path to a shortcut file.
`--------------------------------------------------------------------
` hWndOfYourForm      - The handle (hWnd property) of the calling
`                       window
` strShortcutFile     - Filename of the shortcut
` strShortcutLocation - Return buffer for the path of the object the
`                       shortcut points to
` RETURNS            -  Zero if the call worked, otherwise a SCODE
`                       HRESULT.
`*********************************************************************
<< DECLARATION GOES HERE >>
`*********************************************************************
` Create the Shortcut in c:\
`*********************************************************************
Private Sub cmdCreateShortcut_Click()
    Dim strMessage As String
    `*****************************************************************
    ` Get the the path to the windows directory
    `*****************************************************************
    Dim strWinDir As String
    strWinDir = Environ("windir")
    `*****************************************************************
    ` Try to create a shortcut to notepad.exe. Build the err string
    ` if the call failed.
    `*****************************************************************
    If CreateShortcut(strWinDir & "\notepad.exe", SHORTCUTPATH, _
        "c:\", vbNullString, vbMaximizedFocus, vbNullString, 1) Then
        ` Non-zero result, so notify the user that the call failed
        strMessage = "Unable to create a shortcut to Notepad. Check "
        strMessage = strMessage & "the source code parameters and try"
        strMessage = strMessage & "again."
    `*****************************************************************
    ` Otherwise, the call worked so tell the user
    `*****************************************************************
    Else
        strMessage = "A shortcut to Notepad was created in c:\"
        `*************************************************************
        ` Enable the resolve button now, since the file exists
        `*************************************************************
        cmdResolveShortcut.Enabled = True
    End If
    `*****************************************************************
    ` Display the success or failed message
    `*****************************************************************
    MsgBox strMessage
End Sub
`*********************************************************************
` Resolve the Shortcut in c:\ (created in Command1_Click)
`*********************************************************************
Private Sub cmdResolveShortcut_Click()
    Dim strShortcutTargetPath As String, strTemp As String
    `*****************************************************************
    ` Build a buffer for the return string
    `*****************************************************************
    strShortcutTargetPath = Space(260)
    `*****************************************************************
    ` Make the call
    `-----------------------------------------------------------------
    ` NOTE: If the TARGET (the return value) can't be found,
    `       then Win95 will display search dialog while it
    `       attempts to find it
    `*****************************************************************
    If ResolveShortcut(hWnd, SHORTCUTPATH, strShortcutTargetPath) Then
        `*************************************************************
        ` Non-zero result, so notify the user that the call failed
        `*************************************************************
        MsgBox "Unable to resolve your shortcut", vbCritical
    Else
    `*****************************************************************
    ` Trim the null terminator and display the results
    `*****************************************************************
    strShortcutTargetPath = Left(strShortcutTargetPath, _
        InStr(strShortcutTargetPath, Chr(0)) - 1)
    MsgBox "Your shortcut points to " & strShortcutTargetPath, _
        vbInformation
    End If
End Sub

Listing 46.2 appears a bit long mainly because I've included a large number of comments. In reality, this program is rather trivial. The essential function, CreateShortcut, simply takes the same values that you would normally see in a property page when creating a shortcut. ResolveShortcut is even easier because you provide it with the path to a shortcut file, and it simply loads the strShortcutLocation with the path to the file to which the shortcut references. This code features some common techniques for working with APIs that use strings, so be sure to pay close attention to the comments.

As promised, Listing 46.3 contains the function declarations to the CreateShortcut and ResolveShortcut functions. Were your declarations the same? If so, congratulations! If not, then don't feel bad. Writing declarations can be a little tricky, especially if you've never programmed Windows in C.

Listing 46.3 SHORTCUT.FRM--Create and Resolve Shortcut Function Declarations

Private Declare Function CreateShortcut Lib "shortcut.dll" _
    (ByVal strSourceFile$, ByVal strLinkFile$, ByVal strInitDir$, _
    ByVal strArgs$, ByVal intCmdShow%, ByVal strIconPath$, _
    ByVal lngIconIndex As Long) As Long
Private Declare Function ResolveShortcut Lib "shortcut.dll" _
    (ByVal hWndOfYourForm As Long, ByVal strShortcutFile As String, _
    ByVal strShortcutLocation As String) As Long

This concludes my crash course on writing declarations. If you are interested in learning more, then there is a fantastic reference book called The Visual Basic Programmer's Guide to the Windows API, by Daniel Appleman, that covers this topic extensively. I encourage every VB programmer to purchase a copy of this book, as it is the only resource I know of that translates the Windows API into a form usable by Visual Basic programmers.

Using the Windows API

As with most things, learning by doing is a good way to gain some knowledge about the Windows API. I will be discussing API examples that I classify as cool. None of these APIs are especially difficult to use, but they all are extremely helpful to have in your sample code library. I'll start off easy and graduate up to a more complex use of the API in combination with advanced VB code techniques. Finally, I'll finish by writing the TransparentPaint function, which is almost pure API programming in VB. All of the listings in this section are rather large due to the complexity of the samples, but do not let that discourage you. Each sample is commented very well, so any intermediate programmer should be able to follow along.

Warming Up with the Memory Class

Rather than diving right in to a complicated example, I thought I'd begin by explaining the memory class. Most programmers like to include basic memory information in their About boxes, but Visual Basic does not provide any method for doing this. If you want to know how much RAM is installed on a machine, then you have to call the Windows API. Although this isn't a bad thing, it does mean that many of us have written duplicate code many different ways to accomplish the same thing. Frustrated by this, I decided to write what I believe to be a useful (and reusable) class for getting memory information.

Listing 46.4 is my interpretation of the ultimate memory class that will prevent you from having to mess with the API. This class is also structured so that you can easily add features that I omitted, should your application require them.

Listing 46.4 MEMORY.CLS--Memory.cls Demonstrates How to Wrap an API into a Reusable Class Object

`*********************************************************************
` Memory.cls - This class takes a snapshot of the memory status and
`   provides the user with a simple interface to get common
`   information about the current memory status.
`*********************************************************************
Option Explicit
`*********************************************************************
` Win32 required user-defined type (or struct) and declaration
`*********************************************************************
Private Type MEMORYSTATUS
        dwLength As Long
        dwMemoryLoad As Long
        dwTotalPhys As Long
        dwAvailPhys As Long
        dwTotalPageFile As Long
        dwAvailPageFile As Long
        dwTotalVirtual As Long
        dwAvailVirtual As Long
End Type
Private Declare Sub GlobalMemoryStatus Lib "kernel32" _
    (lpBuffer As MEMORYSTATUS)
`*********************************************************************
` Private member variable which holds the current memory status
`*********************************************************************
Private mmemMemoryStatus As MEMORYSTATUS
`*********************************************************************
` Returns the number of bytes of available physical RAM (OK if zero)
`*********************************************************************
Public Property Get FreeMemory() As Long
    FreeMemory = mmemMemoryStatus.dwAvailPhys
End Property
`*********************************************************************
` Returns the number of bytes of RAM installed in the computer
`*********************************************************************
Public Property Get TotalMemory() As Long
    TotalMemory = mmemMemoryStatus.dwTotalPhys
End Property
`*********************************************************************
` Returns the number of bytes of virtual memory allocated by the
` operating system
`*********************************************************************
Public Property Get TotalVirtualMemory() As Long
    TotalVirtualMemory = mmemMemoryStatus.dwTotalVirtual
End Property
`*********************************************************************
` Returns the number of bytes of virtual memory available to this
` process
`*********************************************************************
Public Property Get AvailableVirtualMemory() As Long
    AvailableVirtualMemory = mmemMemoryStatus.dwAvailVirtual
End Property
`*********************************************************************
` Calls the operating system to find out the memory status at the
` time this object is created
`*********************************************************************
Private Sub Class_Initialize()
    mmemMemoryStatus.dwLength = Len(mmemMemoryStatus)
    GlobalMemoryStatus mmemMemoryStatus
End Sub
`*********************************************************************
` Updates this object with current memory status
`*********************************************************************
Public Sub Refresh()
    GlobalMemoryStatus mmemMemoryStatus
End Sub

This class simply wraps the GlobalMemoryStatus API. When the class is created, the API call is made in the Initialize event, so this class is ready to use with no additional initialization. Your application needs only to create a new variable of this class and access the properties that satisfy your program's needs. I reluctantly included a public method called Refresh that updates mmemMemoryStatus, but I couldn't think of any good application of this method. However, it is there for the one person who will claim that he really needs this method.

Listing 46.5 uses clsMemorySnapshot the way it is designed to be used. An application should only define a variable of this class in the local sub or function where it is being used. By doing this, every time your sub or function is called, you get the current memory information. Memdemo.frm displays some of the properties from the clsMem object and includes a special note about the return value from the FreeMemory property.

Listing 46.5 MEMDEMO.FRM--Memdemo.frm Demonstrates How to Use clsMemorySnapshot

`*********************************************************************
` MemDemo.frm - Demonstrates how to use clsMemorySnapshot
`*********************************************************************
Option Explicit
`*********************************************************************
` Creates a clsMemorySnapshot object and displays the results
`*********************************************************************
Private Sub cmdGetMemoryStatus_Click()
    `*****************************************************************
    ` The efficient way to use clsMemorySnapshot is to create a new
    ` clsMemorySnapshot object every time you need to get the memory
    ` status, so that is what we will do.
    `*****************************************************************
    Dim clsMem As New clsMemorySnapshot
    `*****************************************************************
    ` Holds the current ForeColor of the form since we'll need to
    ` change it temporarily.
    `*****************************************************************
    Dim lngForeColor As Long
    `*****************************************************************
    ` Always clear the form before displaying new information
    `*****************************************************************
    Cls
    With clsMem
        `*************************************************************
        ` Print Physical Memory Information
        `*************************************************************
        Print "Total Installed RAM", Format(.TotalMemory \ 1024, _
            "###,###,###,###,##0") & " KB"
        Print "Free Physical RAM", Format(.FreeMemory \ 1024, _
            "###,###,###,###,##0") & " KB";
        `*************************************************************
        ` Print a asterisk that stands out in bold red
        `*************************************************************
        Font.Bold = True
        lngForeColor = ForeColor
        ForeColor = RGB(255, 0, 0)
        Print "*"
        `*************************************************************
        ` Restore to the default settings
        `*************************************************************
        ForeColor = lngForeColor
        Font.Bold = False
        `*************************************************************
        ` Print Virtual Memory Information
        `*************************************************************
        Print "Total Virtual Memory", Format(.TotalVirtualMemory \ 1024, _
            "###,###,###,###,##0") & " KB"
        Print "Available Virtual Memory", Format(.AvailableVirtualMemory _
            \ 1024, "###,###,###,###,##0") & " KB"
    End With
    `*****************************************************************
    ` Print a blank space, then print a comment in bold
    `*****************************************************************
    Print
    Font.Bold = True
    Print "* = It's okay (and common) for this number to be zero."
    `*****************************************************************
    ` Restore the form bold value back to false
    `*****************************************************************
    Font.Bold = False
End Sub

By wrapping the API call in a class, I have made it as easy to use as a standard VB object in our cmdGetMemoryStatus_Click event. This is a great way to simplify the use of many API calls, as well as ensure the proper use of them. Not only does it make the API call easy enough to use by new VB programmers, it also promotes building an API object library that is shared among an entire programming team. I encourage you to use this technique as much as possible and try to keep your classes as simple as possible. After all, to have the best performance, you need to remember that "less is more."

Creating Your Own API Interface

Visual Basic is great because it is simple enough for an intermediate Windows user to learn how to write a Windows application. This simplicity is what attracts everyone to it, and it is what allows people to write applications in weeks that would take months (or even years) in C. However, this simplicity comes at a price. The price is that many functions in VB were written during VB 1.0 when Microsoft only envisioned VB as being a hobbyist programming language or a Windows batch language. No one really saw VB as becoming the most common programming language for Windows that it is today, so many of the 1.0 functions contain limited functionality. One such function is Dir.

While Dir is great for your fundamental needs, it falls short when you try to do something like "search for all the files with the extension BAK on your hard drive." The reason why it falls short is simple--it doesn't support nested calls. Someone at Microsoft realized this shortcoming and wrote the WinSeek sample, which uses a file and directory list box control to overcome this limitation, but this workaround is unacceptable. The spaghetti code in WinSeek is hard to follow, poorly commented, and too slow for even the most trivial tasks.

I have written the FindFile class, shown in Listing 46.6, to overcome the shortcomings of Dir and WinSeek. This class uses the previous concept of encapsulating an API into a reusable object that makes it as easy to use as a built-in VB function. FindFile also adheres to the concept of "keep it simple," by including only a minimal amount of core functionality. This allows individual users of this class to write their own algorithms for special tasks such as searching an entire drive for a specific type of file. I encourage you to review the source code and comments for this class in the following listing.

Listing 46.6 FINDFILE.CLS--FindFile.cls Provides an Interface to the Windows API Used for Finding Files

`*********************************************************************
` FindFile.cls - Encapsulates the Win32 FindFile functions
`*********************************************************************
Option Explicit
`*********************************************************************
` Attribute constants which differ from VB
`*********************************************************************
Private Const FILE_ATTRIBUTE_COMPRESSED = &H800
Private Const FILE_ATTRIBUTE_NORMAL = &H80
`*********************************************************************
` Win32 API constants required by FindFile
`*********************************************************************
Private Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
`*********************************************************************
` Win32 data types (or structs) required by FindFile
`*********************************************************************
Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
        dwFileAttributes As Long
        ftCreationTime As FILETIME
        ftLastAccessTime As FILETIME
        ftLastWriteTime As FILETIME
       FileSizeHigh As Long
       FileSizeLow As Long
        dwReserved0 As Long
        dwReserved1 As Long
        cFileName As String * MAX_PATH
        cAlternate As String * 14
End Type
Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
End Type
`*********************************************************************
` Win32 API calls required by this class
`*********************************************************************
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
    (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias _
    "FindFirstFileA" (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindNextFile Lib "kernel32" Alias _
    "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As _
    WIN32_FIND_DATA) As Long
Private Declare Function FindClose& Lib "kernel32" (ByVal hFindFile&)
`*********************************************************************
` clsFindFiles private member variables
`*********************************************************************
Private mlngFile As Long
Private mstrDateFormat As String
Private mstrUnknownDateText As String
Private mwfdFindData As WIN32_FIND_DATA
`*********************************************************************
` Public interface for setting the format string used for dates
`*********************************************************************
Public Property Let DateFormat(strDateFormat As String)
    mstrDateFormat = strDateFormat
End Property
`*********************************************************************
` Public interface for setting the string used when the date for a
` file is unknown
`*********************************************************************
Public Property Let UnknownDateText(strUnknownDateText As String)
    mstrUnknownDateText = strUnknownDateText
End Property
`*********************************************************************
` Returns the file attributes for the current file
`*********************************************************************
Public Property Get FileAttributes() As Long
    If mlngFile Then FileAttributes = mwfdFindData.dwFileAttributes
End Property
`*********************************************************************
` Returns true if the compress bit is set for the current file
`*********************************************************************
Public Property Get IsCompressed() As Boolean
    If mlngFile Then IsCompressed = mwfdFindData.dwFileAttributes _
                                        And FILE_ATTRIBUTE_COMPRESSED
End Property
`*********************************************************************
` Returns the value of the Normal attribute bit for dwFileAttributes
`*********************************************************************
Public Property Get NormalAttribute() As Long
   ormalAttribute = FILE_ATTRIBUTE_NORMAL
End Property
`*********************************************************************
` Primary method in this class for finding the FIRST matching file in
` a directory that matches the path &|or pattern in strFile
`*********************************************************************
Public Function Find(strFile As String, Optional blnShowError _
    As Boolean) As String
    `*****************************************************************
    ` If you are already searching, then end the current search
    `*****************************************************************
    If mlngFile Then
        If blnShowError Then
            If MsgBox("Cancel the current search?", vbYesNo Or _
                vbQuestion) = vbNo Then Exit Function
        End If
        `*************************************************************
        ` Call cleanup routines before beginning new search
        `*************************************************************
        EndFind
    End If
    `*****************************************************************
    ` Find the first file matching the search pattern in strFile
    `*****************************************************************
    mlngFile = FindFirstFile(strFile, mwfdFindData)
    `*****************************************************************
    ` Check to see if FindFirstFile failed
    `*****************************************************************
    If mlngFile = INVALID_HANDLE_VALUE Then
        mlngFile = 0
        `*************************************************************
        ` If blnShowError, then display a default error message
        `*************************************************************
        If blnShowError Then
            MsgBox strFile & " could not be found!", vbExclamation
        `*************************************************************
        ` Otherwise raise a user-defined error with a default err msg
        `*************************************************************
        Else
            Err.Raise vbObjectError + 5000, "clsFindFile_Find", _
                strFile & " could not be found!"
        End If
        Exit Function
    End If
    `*****************************************************************
    ` Return the found filename without any nulls
    `*****************************************************************
    Find = Left(mwfdFindData.cFileName, _
        InStr(mwfdFindData.cFileName, Chr(0)) - 1)
End Function
`*********************************************************************
` Call this function until it returns "" to get the remaining files
`*********************************************************************
Public Function FindNext() As String
    `*****************************************************************
    ` Exit if no files have been found
    `*****************************************************************
    If mlngFile = 0 Then Exit Function
    `*****************************************************************
    ` Be sure to clear the contents of cFileName before each call to
    ` avoid garbage characters from being returned in your string.
    `*****************************************************************
    mwfdFindData.cFileName = Space(MAX_PATH)
    `*****************************************************************
    ` If another file is found, then return it. Otherwise EndFind.
    `*****************************************************************
    If FindNextFile(mlngFile, mwfdFindData) Then
        FindNext = Left(mwfdFindData.cFileName, _
            InStr(mwfdFindData.cFileName, Chr(0)) - 1)
    Else
        EndFind
    End If
End Function
`*********************************************************************
` A private helper method which is called internally to close the
` FindFile handle and clear mlngFile to end a FindFile operation.
`*********************************************************************
Private Sub EndFind()
    FindClose mlngFile
    mlngFile = 0
End Sub
`*********************************************************************
` Return the short name of a found file (default = long filename)
`*********************************************************************
Public Function GetShortName() As String
    Dim strShortFileName As String
    `*****************************************************************
    ` If no current file, then exit
    `*****************************************************************
    If mlngFile = 0 Then Exit Function
    `*****************************************************************
    ` Get the short filename (without trailing nulls)
    `*****************************************************************
    strShortFileName = Left(mwfdFindData.cAlternate, _
        InStr(mwfdFindData.cAlternate, Chr(0)) - 1)
    `*****************************************************************
    ` If there is no short filename info, then strShortFilename will
    ` equal null (because of the (- 1) above)
    `*****************************************************************
    If Len(strShortFileName) = 0 Then
        `*************************************************************
        ` If no short filename, then its already a short filename so
        ` set strShortFileName = .cFileName.
        `*************************************************************
        strShortFileName = Left(mwfdFindData.cFileName, _
            InStr(mwfdFindData.cFileName, Chr(0)) - 1)
    End If
    `*****************************************************************
    ` Return the short filename
    `*****************************************************************
    GetShortName = strShortFileName
End Function
`*********************************************************************
` Return the date the current file was created. If the optional args
` are provided, then they will be set = to date and time values.
`*********************************************************************
Public Function GetCreationDate(Optional datDate As Date, _
    Optional datTime As Date) As String
    
    If mlngFile = 0 Then Exit Function
    `*****************************************************************
    ` If dwHighDateTime, then Win32 couldn't determine the date so
    ` return the unknown string. "Unknown" is the default.  Set this
    ` value to something else by using the UnknownDateText property.
    `*****************************************************************
    If mwfdFindData.ftCreationTime.dwHighDateTime = 0 Then
        GetCreationDate = mstrUnknownDateText
        Exit Function
    End If
    `*****************************************************************
    ` Get the time (in the current local/time zone)
    `*****************************************************************
    With GetSystemTime(mwfdFindData.ftCreationTime)
        `*************************************************************
        ` If datDate was provided, then set it to a date serial
        `*************************************************************
        datDate = DateSerial(.wYear, .wMonth, .wDay)
        `*************************************************************
        ` If datTime was provided, then set it to a time serial
        `*************************************************************
        datTime = TimeSerial(.wHour, .wMinute, .wSecond)
        `*************************************************************
        ` Use datDate and datTime as local variables (even if they
        ` weren't passed ByRef in the optional args) to create a
        ` a valid date/time value.  Return the date/time formatted
        ` using the default format of "m/d/yy h:nn:ss AM/PM" or
        ` the user-defined value which was set using the DateFormat
        ` property.
        `*************************************************************
        GetCreationDate = Format(datDate + datTime, mstrDateFormat)
    End With
End Function
`*********************************************************************
` Similar to GetCreationDate.  See GetCreationDate for comments.
`*********************************************************************
Public Function GetLastAccessDate(Optional datDate As Date, _
    Optional datTime As Date) As String
    
    If mlngFile = 0 Then Exit Function
    
    If mwfdFindData.ftLastAccessTime.dwHighDateTime = 0 Then
        GetLastAccessDate = mstrUnknownDateText
        Exit Function
    End If
    
    With GetSystemTime(mwfdFindData.ftLastAccessTime)
        datDate = DateSerial(.wYear, .wMonth, .wDay)
        datTime = TimeSerial(.wHour, .wMinute, .wSecond)
        GetLastAccessDate = Format(datDate + datTime, mstrDateFormat)
    End With
    
End Function
`*********************************************************************
` Similar to GetCreationDate.  See GetCreationDate for comments.
`*********************************************************************
Public Function GetLastWriteDate(Optional datDate As Date, _
    Optional datTime As Date) As String
    
    If mlngFile = 0 Then Exit Function
    
    If mwfdFindData.ftLastWriteTime.dwHighDateTime = 0 Then
        GetLastWriteDate = mstrUnknownDateText
        Exit Function
    End If
    
    With GetSystemTime(mwfdFindData.ftLastWriteTime)
        datDate = DateSerial(.wYear, .wMonth, .wDay)
        datTime = TimeSerial(.wHour, .wMinute, .wSecond)
        GetLastWriteDate = Format(datDate + datTime, mstrDateFormat)
    End With
    
End Function
`*********************************************************************
` Takes a FILETIME and converts it into the local system time
`*********************************************************************
Private Function GetSystemTime(ftmFileTime As FILETIME) As SYSTEMTIME
    Dim ftmLocalTime As FILETIME
    Dim stmSystemTime As SYSTEMTIME
    FileTimeToLocalFileTime ftmFileTime, ftmLocalTime
    FileTimeToSystemTime ftmLocalTime, stmSystemTime
    GetSystemTime = stmSystemTime
End Function
`*********************************************************************
` Sets the default values for private members when this object is
` created
`*********************************************************************
Private Sub Class_Initialize()
    mstrUnknownDateText = "Unknown"
    mstrDateFormat = "m/d/yy h:nn:ss AM/PM"
End Sub
`*********************************************************************
` Ends any open finds, if necessary
`*********************************************************************
Private Sub Class_Terminate()
    If mlngFile Then EndFind
End Sub

The FindFile class contains private declarations for everything it needs to be both an independent and complete object. What's more, it is about 60 percent faster than WinSeek. However, performance is not the only reason to use the FindFile class. It provides a wealth of information about each found file and supports searching unmapped networked drives using UNC paths.

Now that you have seen FindFile, let's use it. FindFile is similar to Dir in that your first call specifies the search criteria and subsequent calls retrieve the files that correspond to that search criteria. However, FindFile is different in that your first call is to the Find method, and subsequent calls are to the FindNext method. Your application should keep looping as long as strings are being returned from FindNext, or until you are ready to begin the next search by calling Find again.

Listing 46.7 demonstrates a simple use of the FindFile class. In this function, the purpose is to retrieve all of the files in the current directory that satisfy a given search criteria. All of the items found are loaded into a collection provided by the caller. Finally, this function returns the number of files that were added to the colFiles collection.

Listing 46.7 FINDFILE.FRM--Searching for Files in a Single Directory

`*********************************************************************
` A simple routine that finds all of the files in a directory that
` match the given pattern, loads the results in a collection, then
` returns the number of files that are being returned.
`*********************************************************************
Private Function FindFilesInSingleDir(ByVal strDir As String, _
    strPattern$, colFiles As Collection) As Integer
    `*****************************************************************
    ` Create a new FindFile object every time this function is called
    `*****************************************************************
    Dim clsFind As New clsFindFile
    Dim strFile As String
    `*****************************************************************
    ` Make sure strSearchPath always has a trailing backslash
    `*****************************************************************
    If Right(strDir, 1) <> "\" Then _
        strDir = strDir & "\"
    `*****************************************************************
    ` Get the first file
    `*****************************************************************
    strFile = clsFind.Find(strDir & strPattern)
    `*****************************************************************
    ` Loop while files are being returned
    `*****************************************************************
    Do While Len(strFile)
        `*************************************************************
        ` If the current file found is not a directory...
        `*************************************************************
        If (clsFind.FileAttributes And vbDirectory) = 0 Then
            colFiles.Add strFile ` don't include the path
        End If
        `*************************************************************
        ` Find the next file or directory
        `*************************************************************
        strFile = clsFind.FindNext()
    Loop
    `*****************************************************************
    ` Return the number of files found
    `*****************************************************************
    FindFilesInSingleDir = colFiles.Count
End Function

This function begins by creating a new clsFindFile object and building the search string. The first file is then retrieved by a call to the Find method, and subsequent files are retrieved by looping until FindNext no longer returns a value. If no files are found, FindFilesInSingleDir returns zero, and no changes are made to the colFiles collection. This function is sufficient for your basic needs, but isn't much better than Dir because it does not support searching sub- directories. However, this limitation is due to the implementation of the FindFile class and not a limitation of the class itself.

Listing 46.8 goes one step further by including support for searching subdirectories. The FindAllFiles function overcomes the limitations of Dir and FindFilesInSingleDir, but it is slightly slower than the previous function. Your application determines if it really needs to search subdirectories and call the appropriate function. This way, the results can be obtained by using the fastest method possible.

Listing 46.8 FINDFILE.FRM--FindAllFiles Includes Subdirectories in Its Search but It Pays a Small Performance Price

`*********************************************************************
` A complex routine that finds all of the files in a directory (and its
` subdirectories), loads the results in a collection, and returns the
` number of subdirectories that were searched.
`*********************************************************************
Private Function FindAllFiles(ByVal strSearchPath$, strPattern As _
    String, Optional colFiles As Collection, Optional colDirs As _
    Collection, Optional blnDirsOnly As Boolean, Optional blnBoth _
    As Boolean) As Integer
    `*****************************************************************
    ` Create a new FindFile object every time this function is called
    `*****************************************************************
    Dim clsFind As New clsFindFile
    Dim strFile As String
    Dim intDirsFound As Integer
    `*****************************************************************
    ` Make sure strSearchPath always has a trailing backslash
    `*****************************************************************
    If Right(strSearchPath, 1) <> "\" Then _
        strSearchPath = strSearchPath & "\"
    `*****************************************************************
    ` Get the first file
    `*****************************************************************
    strFile = clsFind.Find(strSearchPath & strPattern)
    `*****************************************************************
    ` Loop while files are being returned
    `*****************************************************************
    Do While Len(strFile)
        `*************************************************************
        ` If the current file found is a directory...
        `*************************************************************
        If clsFind.FileAttributes And vbDirectory Then
            `*********************************************************
            ` Ignore . and ..
            `*********************************************************
            If Left(strFile, 1) <> "." Then
                `*****************************************************
                ` If either bln optional arg is true, then add this
                ` directory to the optional colDirs collection
                `*****************************************************
                If blnDirsOnly Or blnBoth Then
                    colDirs.Add strSearchPath & strFile & "\"
                End If
                `*****************************************************
                ` Increment the number of directories found by one
                `*****************************************************
                intDirsFound = intDirsFound + 1
                `*****************************************************
                ` Recursively call this function to search for matches
                ` in subdirectories.  When the recursed function
                ` completes, intDirsFound must be incremented.
                `*****************************************************
                intDirsFound = intDirsFound + FindAllFiles( _
                    strSearchPath & strFile & "\", strPattern, _
                    colFiles, colDirs, blnDirsOnly)
            End If
            `*********************************************************
            ` Find the next file or directory
            `*********************************************************
            strFile = clsFind.FindNext()
        `*************************************************************
        ` ... otherwise it must be a file.
        `*************************************************************
        Else
            `*********************************************************
            ` If the caller wants files, then add them to the colFiles
            ` collection
            `*********************************************************
            If Not blnDirsOnly Or blnBoth Then
                colFiles.Add strSearchPath & strFile
            End If
            `*********************************************************
            ` Find the next file or directory
            `*********************************************************
            strFile = clsFind.FindNext()
        End If
    Loop
    `*****************************************************************
    ` Return the number of directories found
    `*****************************************************************
    FindAllFiles = intDirsFound
End Function

The main feature that allows FindAllFiles to search subdirectories is the fact that it recursively calls itself. It does this by checking to see if the current file is a directory. If it is, then it makes another call to FindAllFiles using all of the same parameters passed in by the original caller with one exception. The strSearchPath parameter is modified to point to the next subdirectory to search.

Now that we have our search routines written, let's look at some of the code in FindFile.frm (shown in Figure 46.1) that use this code based on requests from the user of our search dialog box. In Listing 46.9, we perform our search based on the values the user set in our search dialog box. We also play a FindFile video during our search, so the user has something to look at during long searches.

FIG. 46.1
FindFile.frm is our VB version of the Windows FindFile dialog box.


NOTE: When using this sample, the caption displays the number of files and directories found when your search is completed. This value is the correct value, but it might be different from the values returned by the MS-DOS Dir command and the Windows Find dialog box. Both Dir and the Find dialog box use a different mechanism for counting the number of "files" returned, neither of which is completely accurate. The method I use correlates to the value returned when you view the properties of a directory in the Windows Explorer.

Listing 46.9 FINDFILE.FRM--Choosing the Right Search Technique

`*********************************************************************
` Find matching files based on the contents of the text boxes
`*********************************************************************
Private Sub cmdFind_Click()
    `*****************************************************************
    ` Prevent the user from clicking the find button twice, and
    ` hide the browse button so the AVI can be seen
    `*****************************************************************
    cmdFind.Enabled = False
    cmdBrowse.Visible = False
    `*****************************************************************
    ` Give the user a video to watch (wasteful, but cool)
    `*****************************************************************
    With aniFindFile
        .Open App.Path & "\findfile.avi"
        .Visible = True
        Refresh
        .Play
    End With
    `*****************************************************************
    ` Tell the user what you are doing and display an hourglass pointer
    `*****************************************************************
    Caption = "Searching..."
    Screen.MousePointer = vbHourglass
    `*****************************************************************
    ` Always clear before performing the operation (in case the list
    ` is already visible to the user)
    `*****************************************************************
    lstFound.Clear
    `*****************************************************************
    ` Perform the appropriate search
    `*****************************************************************
    If chkSearchSubs Then
        SearchSubDirs
    Else
        SearchCurDirOnly
    End If
    `*****************************************************************
    ` End the video, then restore the buttons and pointer
    `*****************************************************************
    aniFindFile.Stop: aniFindFile.Visible = False
    cmdFind.Enabled = True
    cmdBrowse.Visible = True
    Screen.MousePointer = vbDefault
End Sub

This code simply controls the user interface, but doesn't actually do any searching. Instead, it determines which helper function to call based on the default value property of the chkSearchSubs control. I chose this technique because the helper search functions are rather complex, so including it in the Click event would make this code difficult to read.

Listing 46.10 starts with the simple SearchCurDirOnly helper routine. This routine simply calls FindFilesInSingleDir and loads the results from the colFiles collection into a list box (if necessary). That is simple enough, but the next routine, SearchSubDirs, is a little more complicated. The reason is because, if the user wants to search for all the files with the extension TMP, then we must first get a list of all of the directories by calling FindAllFiles. After we have our list of directories, then we can search each of them for TMP files.

Listing 46.10 FINDFILE.FRM--Using the Results from Our Find Functions

`*********************************************************************
` Performs a simple search in a single directory (like dir *.*)
`*********************************************************************
Private Sub SearchCurDirOnly()
    Dim dblStart As Long
    Dim colFiles As New Collection
    `*****************************************************************
    ` Begin timing then search
    `*****************************************************************
    dblStart = Timer
    FindFilesInSingleDir txtSearchDir, txtSearchPattern, colFiles
    `*****************************************************************
    ` Adding items to the list is slow, so only do it if you have to
    `*****************************************************************
    If chkDisplayInList Then LoadCollectionInList colFiles
    `*****************************************************************
    ` Tell the user how many files were found and how long it took
    ` to find (and load) the files
    `*****************************************************************
    Caption = CStr(colFiles.Count) & " files found in" & _
        Str(Timer - dblStart) & " seconds"
End Sub
`*********************************************************************
` Performs a complex search in multiple directories (like dir *.* /s)
`*********************************************************************
Private Sub SearchSubDirs()
    Dim dblStart As Long
    Dim colFiles As New Collection
    Dim colDirs As New Collection
    Dim intDirsFound As Integer
    Dim vntItem As Variant
    `*****************************************************************
    ` Don't forget to add the search directory to your collection
    `*****************************************************************
    colDirs.Add txtSearchDir.Text
    `*****************************************************************
    ` If the user searches for *.*, then the search is simple (and
    ` much faster)
    `*****************************************************************
    If Trim(txtSearchPattern) = "*.*" Then
        dblStart = Timer
        intDirsFound = FindAllFiles(txtSearchDir, "*.*", colFiles, _
            colDirs, , True)
    `*****************************************************************
    ` Otherwise things get sorta complicated
    `*****************************************************************
    Else
        `*************************************************************
        ` First search to get a collection of all the directories
        `*************************************************************
        intDirsFound = FindAllFiles(txtSearchDir, "*.*", , colDirs, True)
        `*************************************************************
        ` Start timing now, since the last search was just prep work
        `*************************************************************
        dblStart = Timer
        `*************************************************************
        ` Search for the file pattern in each directory in the list
        `*************************************************************
        For Each vntItem In colDirs
            `*********************************************************
            ` Display the current search directory in the caption
            `*********************************************************
            Caption = vntItem
            FindAllFiles CStr(vntItem), txtSearchPattern, colFiles
       ext vntItem
    End If
    `*****************************************************************
    ` Adding items to the list is slow, so only do it if you have to
    `*****************************************************************
    If chkDisplayInList Then LoadCollectionInList colFiles
    `*****************************************************************
    ` Tell the user how many files were found in how many dirs and
    ` how long it took to find (and load) the files
    `*****************************************************************
    Caption = CStr(colFiles.Count) & " files found in" & _
        Str(intDirsFound) & " directories in" & Str(Timer - dblStart) _
        & " seconds"
End Sub

You might notice that, when each of the two routines listed previously complete, they display some basic results in the caption. This is done so that you can experiment with the FindFile program to see that FindFile itself is very fast, but loading the items into a list can be very slow. When using the FindFile.vbp demo program, experiment with different types of searches such as searching a networked drive by using a UNC path. Try improving it to support all of the features that the Windows Find dialog box supports.

Going Graphical with the GDI API

One of the most complex features in the Win32 API are the Graphics Device Interface (GDI) APIs. Because these APIs are very complicated, tedious, and GPF-prone, Microsoft played it safe and excluded most of them from VB. While this shelters you from the complexity and makes your programs more robust, it severely limits your ability to do the cool things that many users expect. VB4 helped to relieve this problem to some extent by providing new features such as PaintPicture and the ImageList control, but it still fell short. This means that sometime in the near future, you are going to find yourself calling the GDI APIs from your application. This section demonstrates some of the more common GDI APIs by writing a cool function called TransparentPaint.


NOTE: Although I would like to take complete credit for the TransparentPaint routine, I cannot. The version you see in this chapter is my Win32 version of the TransparentBlt code (written by Mike Bond) that originally appeared in the Microsoft Knowledge Base KB article number Q94961. However, I have made many modifications to this code and included a wealth of new comments.

TransparentPaint, shown in Listing 46.11, is designed to treat a bitmap like an icon when you paint it on a surface. Icons allow you to designate a part of them to be transparent, but bitmaps don't. TransparentPaint overcomes this limitation by allowing you to make all of a single color on a bitmap transparent. To accomplish this difficult feat, it is necessary to create a series of temporary bitmaps and do some painting in memory only. Although this abstract concept can be very complicated, the comments in TransparentPaint try to explain what is happening at each step.

Listing 46.11 TRANSPARENT.BAS--Transparent.bas Allows You to Display Transparent Bitmaps

`*********************************************************************
` Paints a bitmap on a given surface using the surface backcolor
` everywhere lngMaskColor appears on the picSource bitmap
`*********************************************************************
Sub TransparentPaint(objDest As Object, picSource As StdPicture, _
    lngX As Long, lngY As Long, ByVal lngMaskColor As Long)
    `*****************************************************************
    ` This sub uses a bunch of variables, so let's declare and explain
    ` them in advance...
    `*****************************************************************
    Dim lngSrcDC As Long     `Source bitmap
    Dim lngSaveDC As Long    `Copy of Source bitmap
    Dim lngMaskDC As Long    `Monochrome Mask bitmap
    Dim lngInvDC As Long     `Monochrome Inverse of Mask bitmap
    Dim lngNewPicDC As Long  `Combination of Source & Background bmps
    
    Dim bmpSource As BITMAP  `Description of the Source bitmap
    
    Dim hResultBmp As Long   `Combination of source & background
    Dim hSaveBmp As Long     `Copy of Source bitmap
    Dim hMaskBmp As Long     `Monochrome Mask bitmap
    Dim hInvBmp As Long      `Monochrome Inverse of Mask bitmap
    
    Dim hSrcPrevBmp As Long  `Holds prev bitmap in source DC
    Dim hSavePrevBmp As Long `Holds prev bitmap in saved DC
    Dim hDestPrevBmp As Long `Holds prev bitmap in destination DC
    Dim hMaskPrevBmp As Long `Holds prev bitmap in the mask DC
    Dim hInvPrevBmp As Long  `Holds prev bitmap in inverted mask DC
    
    Dim lngOrigScaleMode&    `Holds the original ScaleMode
    Dim lngOrigColor&        `Holds original backcolor from source DC
    `*****************************************************************
    ` Set ScaleMode to pixels for Windows GDI
    `*****************************************************************
    lngOrigScaleMode = objDest.ScaleMode
    objDest.ScaleMode = vbPixels
    `*****************************************************************
    ` Load the source bitmap to get its width (bmpSource.bmWidth)
    ` and height (bmpSource.bmHeight)
    `*****************************************************************
    GetObject picSource, Len(bmpSource), bmpSource
    `*****************************************************************
    ` Create compatible device contexts (DC's) to hold the temporary
    ` bitmaps used by this sub
    `*****************************************************************
    lngSrcDC = CreateCompatibleDC(objDest.hdc)
    lngSaveDC = CreateCompatibleDC(objDest.hdc)
    lngMaskDC = CreateCompatibleDC(objDest.hdc)
    lngInvDC = CreateCompatibleDC(objDest.hdc)
    lngNewPicDC = CreateCompatibleDC(objDest.hdc)
    `*****************************************************************
    ` Create monochrome bitmaps for the mask-related bitmaps
    `*****************************************************************
    hMaskBmp = CreateBitmap(bmpSource.bmWidth, bmpSource.bmHeight, _
        1, 1, ByVal 0&)
    hInvBmp = CreateBitmap(bmpSource.bmWidth, bmpSource.bmHeight, _
        1, 1, ByVal 0&)
    `*****************************************************************
    ` Create color bitmaps for the final result and the backup copy
    ` of the source bitmap
    `*****************************************************************
    hResultBmp = CreateCompatibleBitmap(objDest.hdc, _
        bmpSource.bmWidth, bmpSource.bmHeight)
    hSaveBmp = CreateCompatibleBitmap(objDest.hdc, _
        bmpSource.bmWidth, bmpSource.bmHeight)
    `*****************************************************************
    ` Select bitmap into the device context (DC)
    `*****************************************************************
    hSrcPrevBmp = SelectObject(lngSrcDC, picSource)
    hSavePrevBmp = SelectObject(lngSaveDC, hSaveBmp)
    hMaskPrevBmp = SelectObject(lngMaskDC, hMaskBmp)
    hInvPrevBmp = SelectObject(lngInvDC, hInvBmp)
    hDestPrevBmp = SelectObject(lngNewPicDC, hResultBmp)
    `*****************************************************************
    ` Make a backup of source bitmap to restore later
    `*****************************************************************
    BitBlt lngSaveDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngSrcDC, 0, 0, vbSrcCopy
    `*****************************************************************
    ` Create the mask by setting the background color of source to
    ` transparent color, then BitBlt'ing that bitmap into the mask
    ` device context
    `*****************************************************************
    lngOrigColor = SetBkColor(lngSrcDC, lngMaskColor)
    BitBlt lngMaskDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngSrcDC, 0, 0, vbSrcCopy
    `*****************************************************************
    ` Restore the original backcolor in the device context
    `*****************************************************************
    SetBkColor lngSrcDC, lngOrigColor
    `*****************************************************************
    ` Create an inverse of the mask to AND with the source and combine
    ` it with the background
    `*****************************************************************
    BitBlt lngInvDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngMaskDC, 0, 0, vbNotSrcCopy
    `*****************************************************************
    ` Copy the background bitmap to the new picture device context
    ` to begin creating the final transparent bitmap
    `*****************************************************************
    BitBlt lngNewPicDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        objDest.hdc, lngX, lngY, vbSrcCopy
    `*****************************************************************
    ` AND the mask bitmap with the result device context to create
    ` a cookie cutter effect in the background by painting the black
    ` area for the non-transparent portion of the source bitmap
    `*****************************************************************
    BitBlt lngNewPicDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngMaskDC, 0, 0, vbSrcAnd
    `*****************************************************************
    ` AND the inverse mask with the source bitmap to turn off the bits
    ` associated with transparent area of source bitmap by making it
    ` black
    `*****************************************************************
    BitBlt lngSrcDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngInvDC, 0, 0, vbSrcAnd
    `*****************************************************************
    ` XOR the result with the source bitmap to replace the mask color
    ` with the background color
    `*****************************************************************
    BitBlt lngNewPicDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngSrcDC, 0, 0, vbSrcPaint
    `*****************************************************************
    ` Paint the transparent bitmap on source surface
    `*****************************************************************
    BitBlt objDest.hdc, lngX, lngY, bmpSource.bmWidth, _
        bmpSource.bmHeight, lngNewPicDC, 0, 0, vbSrcCopy
    `*****************************************************************
    ` Restore backup of bitmap
    `*****************************************************************
    BitBlt lngSrcDC, 0, 0, bmpSource.bmWidth, bmpSource.bmHeight, _
        lngSaveDC, 0, 0, vbSrcCopy
    `*****************************************************************
    ` Restore the original objects by selecting their original values
    `*****************************************************************
    SelectObject lngSrcDC, hSrcPrevBmp
    SelectObject lngSaveDC, hSavePrevBmp
    SelectObject lngNewPicDC, hDestPrevBmp
    SelectObject lngMaskDC, hMaskPrevBmp
    SelectObject lngInvDC, hInvPrevBmp
    `*****************************************************************
    ` Free system resources created by this sub
    `*****************************************************************
    DeleteObject hSaveBmp
    DeleteObject hMaskBmp
    DeleteObject hInvBmp
    DeleteObject hResultBmp
    DeleteDC lngSrcDC
    DeleteDC lngSaveDC
    DeleteDC lngInvDC
    DeleteDC lngMaskDC
    DeleteDC lngNewPicDC
    `*****************************************************************
    ` Restores the ScaleMode to its original value
    `*****************************************************************
    objDest.ScaleMode = lngOrigScaleMode
End Sub

For simplicity's sake, I have omitted the API declarations from Listing 46.11. I could go on for pages explaining exactly what is happening during each step of TransparentPaint, but I won't because this sub contains the same comments I've made in this listing. It also would be more difficult to follow this listing if it were broken into several smaller blocks. After reading the comments for this sub, I encourage you to single-step through the TRANSPARENT.VBP project, which you can get from the book's companion CD-ROM. This will help you to visualize what is happening at each step.

Although TransparentPaint is a difficult procedure to follow, using it is easy. Listing 46.12 loads a bitmap from a resource and paints it on the upper-left corner of the form using TransparentPaint. Next, it paints it using PaintPicture. The last parameter, vbGreen, tells TransparentPaint to replace any bits in the bitmap that are green with the background color of the form. The result is shown in Figure 46.2.

FIG. 46.2
TransparentPaint is a must for your multimedia applications.

Listing 46.12 TRANSPARENT.FRM--Transparent.frm Demonstrates the TransparentPaint Procedure

`*********************************************************************
` Transparent.frm - Demonstrates how to use basTransparent's
` TransparentPaint using a bitmap from a resource file.
`*********************************************************************
Option Explicit
`*********************************************************************
` Gets a StdPicture handle by loading a bitmap from a resource file
` and paints it transparently on the form by using Gray as the mask
` color.
`*********************************************************************
Private Sub cmdPaintTransBmp_Click()
    TransparentPaint Me, LoadResPicture(103, 0), 0, 0, QBColor(7)
End Sub

Try replacing the resource file in this project with your own resource file to see how TransparentPaint works. Also, try using different mask colors as well as the images from picture boxes. Now you never again have to write an application that appears to be of inferior quality because it doesn't use transparent bitmaps.

Registry Revisited

The listing in this section, like most sections in this chapter, is long because I have included the discussion of the code in line with the code in the form of comments. Before and after each listing, I make some additional comments on the code, but the most important comments are in the listing itself. Given the sheer size of Registry.bas, I have elected to include only some of the functions from that module.

The most common interaction between VB programs and the Registry is writing and reading strings to and from a specific key. Listing 46.13 contains two functions, GetRegString and SetRegString, that accomplish this task. In addition to setting Registry strings, SetRegString also creates new keys in the Registry. If either of these functions fails, it raises a user-defined error. This way, your application can handle this error without notifying your user.

Listing 46.13 REGISTRY.BAS--GetRegSetting and SetRegSetting Read and Write Registry Strings

`*********************************************************************
` REGISTRY.BAS - Contains the code necessary to access the Windows
`                registration database.
`*********************************************************************
` GetRegString takes three arguments. A HKEY constant (listed above),
` a subkey, and a value in that subkey. This function returns the
` string stored in the strValueName value in the registry.
`*********************************************************************
Public Function GetRegString(HKEY As Long, strSubKey As String, _
                                strValueName As String) As String
    Dim strSetting As String
    Dim lngDataLen As Long
    Dim hSubKey As Long
    `*****************************************************************
    ` Open the key. If success, then get the data from the key.
    `*****************************************************************
    If RegOpenKeyEx(HKEY, strSubKey, 0, KEY_ALL_ACCESS, hSubKey) = _
        ERROR_SUCCESS Then
        strSetting = Space(255)
        lngDataLen = Len(strSetting)
        `*************************************************************
        ` Query the key for the current setting. If this call
        ` succeeds, then return the string.
        `*************************************************************
        If RegQueryValueEx(hSubKey, strValueName, ByVal 0, _
            REG_SZ, ByVal strSetting, lngDataLen) = _
            ERROR_SUCCESS Then
            If lngDataLen > 1 Then
                GetRegString = Left(strSetting, lngDataLen - 1)
            End If
        Else
            Err.Raise ERRBASE + 1, "GetRegString", _
                "RegQueryValueEx failed!"
        End If
        `*************************************************************
        ` ALWAYS close any keys that you open.
        `*************************************************************
        RegCloseKey hSubKey
    End If
End Function
`*********************************************************************
` SetRegString takes four arguments. A HKEY constant (listed above),
` a subkey, a value in that subkey, and a setting for the key.
`*********************************************************************
Public Sub SetRegString(HKEY As Long, strSubKey As String, _
                                strValueName As String, strSetting _
                                As String)
    Dim hNewHandle As Long
    Dim lpdwDisposition As Long
    `*****************************************************************
    ` Create & open the key. If success, then get then write the data
    ` to the key.
    `*****************************************************************
    If RegCreateKeyEx(HKEY, strSubKey, 0, strValueName, 0, _
        KEY_ALL_ACCESS, 0&, hNewHandle, lpdwDisposition) = _
        ERROR_SUCCESS Then
        If RegSetValueEx(hNewHandle, strValueName, 0, REG_SZ, _
            ByVal strSetting, Len(strSetting)) <> ERROR_SUCCESS Then
            Err.Raise ERRBASE + 2, "SetRegString", _
                "RegSetValueEx failed!"
        End If
    Else
        Err.Raise ERRBASE + 3, "SetRegString", "RegCreateKeyEx failed!"
    End If
    `*****************************************************************
    ` ALWAYS close any keys that you open.
    `*****************************************************************
    RegCloseKey hNewHandle
End Sub

Although these two functions accomplish different tasks, the method they use to accomplish their task is virtually identical. The user provides a predefined long constant HKEY value (such as HKEY_CURRENT_USER), a subkey (such as "Software\Microsoft" with no leading backslash), and a value to read from or write to. Both functions (using different Registry functions) begin by opening the subkey and then reading or writing to or from it. Finally, they both end by closing the key they opened.

Listing 46.13 demonstrates a fundamental technique required during all coding with the Registry. Subkeys must be opened and closed before any values can be retrieved. The HKEY values are opened and closed by Windows, so you never have to worry about opening or closing them. This concept is repeated during every function in Registry.bas, so keep this in mind should you decide to write your own Registry functions.

Listing 46.14 demonstrates this fundamental technique again using DWORD (or Long) values. The GetRegDWord and SetRegDWord functions allow you to read and write long values to and from the Registry. Because most Registry values you'll ever use will be strings, I have included a conditional compilation argument in Registry.bas called LEAN_AND_MEAN. Because this conditional compilation constant is undefined by default, its value will be 0. This means that all of the code in the LEAN_AND_MEAN section will be included in your application by default. However, if you wanted to write an application that did not take advantage of any of the functions in the LEAN_AND_MEAN section, then you could edit your project properties and set the LEAN_AND_MEAN conditional compilation constant equal to 1. This would prevent this code from being included in your executable, thus reducing its size and memory requirements. All of the remaining code in Registry.bas that appears in this section is part of the LEAN_AND_MEAN section that may be excluded from your application.

Listing 46.14 REGISTRY.BAS--Extended Registry Functions Using Conditional Compilation

`*********************************************************************
` Extended registry functions begin here
`*********************************************************************
#If LEAN_AND_MEAN = 0 Then
`*********************************************************************
` Returns a DWORD value from a given registry key
`*********************************************************************
Public Function GetRegDWord(HKEY&, strSubKey$, strValueName$) As Long
    Dim lngDataLen As Long
    Dim hSubKey As Long
    Dim lngRetVal As Long
    `*****************************************************************
    ` Open the key. If success, then get the data from the key.
    `*****************************************************************
    If RegOpenKeyEx(HKEY, strSubKey, 0, KEY_ALL_ACCESS, hSubKey) = _
        ERROR_SUCCESS Then
        `*************************************************************
        ` Query the key for the current setting. If this call
        ` succeeds, then return the string.
        `*************************************************************
        lngDataLen = 4 `Bytes
        If RegQueryValueEx(hSubKey, strValueName, ByVal 0, _
            REG_DWORD, lngRetVal, lngDataLen) = ERROR_SUCCESS Then
            GetRegDWord = lngRetVal
        Else
            Err.Raise ERRBASE + 1, "GetRegDWord", _
                "RegQueryValueEx failed!"
        End If
        `*************************************************************
        ` ALWAYS close any keys that you open.
        `*************************************************************
        RegCloseKey hSubKey
    End If
End Function
`*********************************************************************
` Sets a registry key to a DWORD value
`*********************************************************************
Public Sub SetRegDWord(HKEY&, strSubKey$, strValueName$, lngSetting&)
    Dim hNewHandle As Long
    Dim lpdwDisposition As Long
    `*****************************************************************
    ` Create & open the key. If success, then get then write the data
    ` to the key.
    `*****************************************************************
    If RegCreateKeyEx(HKEY, strSubKey, 0, strValueName, 0, _
        KEY_ALL_ACCESS, 0&, hNewHandle, lpdwDisposition) = _
        ERROR_SUCCESS Then
        If RegSetValueEx(hNewHandle, strValueName, 0, REG_DWORD, _
            lngSetting, 4) <> ERROR_SUCCESS Then
            Err.Raise ERRBASE + 2, "SetRegDWord", _
                "RegSetValueEx failed!"
        End If
    Else
        Err.Raise ERRBASE + 3, "SetRegString", "RegCreateKeyEx failed!"
    End If
    `*****************************************************************
    ` ALWAYS close any keys that you open.
    `*****************************************************************
    RegCloseKey hNewHandle
End Sub

The way you read and write DWORD (or Long) values to and from the Registry are almost identical to the method you use for strings. The only difference is that, instead of passing the length of your string or buffer to RegQueryValueEx and RegSetValueEx, you pass the number of bytes of memory occupied by a Long. Because a Long holds 4 bytes, we pass in the number 4.

The last function I'm going to discuss in Registry.bas is the GetRegKeyValues function, shown in Listing 46.15. This function enumerates through a given subkey in the Registry and returns all of its values and settings. This function was used to load our ListView control with all of the values of the subkey selected in the TreeView control in Registry.frm. Although this function isn't extraordinarily difficult, it is long and complex given the nature of enumeration and multidimensional arrays.

This function is unique to most functions you've ever used or written because it returns a multidimensional array that contains the values in the first dimension and the settings in the second dimension. This gives the calling function the flexibility to use the values returned from this function in any manner it chooses. However, it is the responsibility of the caller to both check to make sure an array was returned (in case there were no keys) and to treat the results from this function as a two-dimensional array.

GetRegKeyValues begins like every function in Registry.bas by opening the subkey, but then it does something unique. It calls a helper function (not shown) called QueryRegInfoKey which returns some helpful information about the subkey. QueryRegInfoKey simply wraps a Registry function called RegQueryInfoKey that provides us with information about subkey like how many values it contains, and the length of the longest value and setting. This information helps to determine if we should begin the enumeration, the size array we will need, and how large our string buffer needs to be. After we have this information, we are ready to begin the enumeration.

Listing 46.15 REGISTRY.BAS--GetRegKeyValues Demonstrates Registry Enumeration

`*********************************************************************
` Returns a multi dimensional variant array of all the values and
` settings in a given registry subkey.
`*********************************************************************
Public Function GetRegKeyValues(HKEY&, strSubKey$) As Variant
    Dim lngNumValues As Long      ` Number values in this key
    
    Dim strValues() As String     ` Value and return array
    Dim lngMaxValSize  As Long    ` Size of longest value
    Dim lngValRetBytes As Long    ` Size of current value
    
    Dim lngMaxSettingSize As Long ` Size of longest REG_SZ in this key
    Dim lngSetRetBytes As Long    ` Size of current REG_SZ
    
    Dim lngSetting As Long        ` Used for DWORD
            
    Dim lngType As Long           ` Type of value returned from
                                  ` RegEnumValue
    
    Dim hChildKey As Long         ` The handle of strSubKey
    Dim i As Integer              ` Loop counter
    `*****************************************************************
    ` Exit if you did not successfully open the child key
    `*****************************************************************
    If RegOpenKeyEx(HKEY, strSubKey, 0, KEY_ALL_ACCESS, hChildKey) _
        <> ERROR_SUCCESS Then
        Err.Raise ERRBASE + 4, "GetRegKeyValues", _
            "RegOpenKeyEx failed!"
        Exit Function
    End If
    `*****************************************************************
    ` Find out the array and value sizes in advance
    `*****************************************************************
    If QueryRegInfoKey(hChildKey, , , lngNumValues, lngMaxValSize, _
        lngMaxSettingSize) <> ERROR_SUCCESS Or lngNumValues = 0 Then
        Err.Raise ERRBASE + 5, "GetRegKeyValues", _
            "RegQueryInfoKey failed!"
        RegCloseKey hChildKey
        Exit Function
    End If
    `*****************************************************************
    ` Resize the array to fit the return values
    `*****************************************************************
    lngNumValues = lngNumValues - 1 ` Adjust to zero based
    ReDim strValues(0 To lngNumValues, 0 To 1) As String
    `*****************************************************************
    ` Get all of the values and settings for the key
    `*****************************************************************
    For i = 0 To lngNumValues
        `*************************************************************
        ` Make the return buffers large enough to hold the results
        `*************************************************************
        strValues(i, 0) = Space(lngMaxValSize)
        lngValRetBytes = lngMaxValSize
        
        strValues(i, 1) = Space(lngMaxSettingSize)
        lngSetRetBytes = lngMaxSettingSize
        `*************************************************************
        ` Get a single value and setting from the registry
        `*************************************************************
        RegEnumValue hChildKey, i, strValues(i, 0), lngValRetBytes, _
            0, lngType, ByVal strValues(i, 1), lngSetRetBytes
        `*************************************************************
        ` If the return value was a string, then trim trailing nulls
        `*************************************************************
        If lngType = REG_SZ Then
            strValues(i, 1) = Left(strValues(i, 1), lngSetRetBytes - 1)
        `*************************************************************
        ` Else if it was a DWord, call RegEnumValue again to store
        ` the return setting in a long variable
        `*************************************************************
        ElseIf lngType = REG_DWORD Then
            `*********************************************************
            ` We already know the return size of the value because
            ` we got it in the last call to RegEnumValue, so we
            ` can tell RegEnumValue that its buffer size is the
            ` length of the string already returned, plus one (for
            ` the trailing null terminator)
            `*********************************************************
            lngValRetBytes = lngValRetBytes + 1
            `*********************************************************
            ` Make the call again using a long instead of string
            `*********************************************************
            RegEnumValue hChildKey, i, strValues(i, 0), _
                lngValRetBytes, 0, lngType, lngSetting, lngSetRetBytes
            `*********************************************************
            ` Return the long as a string
            `*********************************************************
            strValues(i, 1) = CStr(lngSetting)
        `*************************************************************
        ` Otherwise let the user know that this code doesn't support
        ` the format returned (such as REG_BINARY)
        `*************************************************************
        Else
            strValues(i, 1) = REG_UNSUPPORTED
        End If
        `*************************************************************
        ` Store the return value and setting in a multi dimensional
        ` array with the value in the 0 index and the setting in
        ` the 1 index of the second dimension.
        `*************************************************************
        strValues(i, 0) = RTrim(Left(strValues(i, 0), lngValRetBytes))
        strValues(i, 1) = RTrim(strValues(i, 1))
   ext i
    `*****************************************************************
    ` ALWAYS close any keys you open
    `*****************************************************************
    RegCloseKey hChildKey
    `*****************************************************************
    ` Return the result as an array of strings
    `*****************************************************************
    GetRegKeyValues = strValues
End Function

During the enumeration, we set all of our string buffers in advance. Next, we attempt to retrieve the value and setting as strings. If the setting was a string, then we trim off any trailing nulls. If the setting was a DWORD, then we make the call again this time passing in a long value and 4 bytes as the buffer size. After the DWORD has been retrieved, we convert it into a string and load it into the array. If the setting was neither a string nor a DWORD, then we load the array with a special string that tells the caller the return value was in an unsupported format.

We repeat the enumeration for all of the values and settings. When completed, we close the key we opened and return the two-dimensional array by its name. The caller will get a variant return value that contains this two-dimensional array.

The remaining functions are described in detail in Registry.bas. I encourage you to read these comments and experiment with each of them. I've also included some examples that demonstrate how to use each of the functions in Registry.bas in the Form_Load event of Registry.frm. These functions are at the end of the Form_Load event and are commented out. Feel free to use them in Registry.frm, the immediate pane in VB, or in a separate application to see how each of the Registry.bas functions work.

Callbacks Revisited

By using the Windows API, you can create callbacks in Visual Basic. This feature allows the operating system to call a procedure in your Visual Basic program. For example, you can have Windows call a procedure in response to a Windows event. Windows knows how to call your procedure because you pass the address of it to Windows when using the API. Before version 5.0, callbacks of this type were not available in VB.

Listing 46.16 demonstrates how to use the EnumWindows API call. EnumWindows takes a function pointer and a pointer to a value that you would like passed to your function pointer. In turn, it iterates through the Windows task list, calling your callback function during each iteration. Callback.bas contains our callback function and some helper routines that allow us to print a list of visible windows on a form.

Listing 46.16 CALLBACK.BAS--Callback.bas Shows a Sample Callback Function

`*********************************************************************
` Callback.bas - Demonstrates how to do callbacks in VB
`*********************************************************************
Option Explicit
`*********************************************************************
` EnumWindows takes a function pointer (AddressOf your callback
` function) and a lParam argument (can be a pointer to anything you
` would like sent to your callback function)
`*********************************************************************
Private Declare Function EnumWindows Lib "user32" _
    (ByVal lpfn As Long, lParam As Any) As Boolean
`*********************************************************************
` There are a lot of windows loaded that are never visible, so
` I usually use the IsWindowVisible API call to filter out only the
` top-level windows the user sees
`*********************************************************************
Private Declare Function IsWindowVisible Lib "user32" _
    (ByVal hWnd As Long) As Long
`*********************************************************************
` I use the following APIs to get the captions and classnames of the
` visible windows
`*********************************************************************
Private Declare Function GetWindowText Lib "user32" Alias _
    "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _
    ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias _
    "GetWindowTextLengthA" (ByVal hWnd As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias _
    "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName$, _
    ByVal nMaxCount As Long) As Long
`*********************************************************************
` This is a callback function. Notice how the function is declared
` as Private. This private flag only applies to VB, not to Windows,
` so it is okay to declare your callback functions as Private if you
` don't want them to be accessible in external modules. Also notice
` how we used the lParam pointer to pass as a form to our callback
`*********************************************************************
Private Function CallBackFunc(ByVal hWnd As Long, _
    lParam As Form) As Long
    Dim strhWnd As String * 8
    Dim strClass As String * 20
    `*****************************************************************
    ` If the window is visible, then print some information about it
    ` on the lParam form
    `*****************************************************************
    If IsWindowVisible(hWnd) Then
        strhWnd = "&H" & Hex(hWnd)
        strClass = GetWindowClassName(hWnd)
        lParam.Print strhWnd & strClass & GetWindowCaption(hWnd)
    End If
    `*****************************************************************
    ` Only return false if you want to stop EnumWindows from calling
    ` this callback again
    `*****************************************************************
    CallBackFunc = True
End Function
`*********************************************************************
` Returns the caption of a window
`*********************************************************************
Private Function GetWindowCaption(hWnd As Long) As String
    Dim lngCaptionLen As Long
    Dim strCaption As String
    `*****************************************************************
    ` Get the length of the caption and add 1 to account for the
    ` null terminator
    `*****************************************************************
    lngCaptionLen = GetWindowTextLength(hWnd) + 1
    `*****************************************************************
    ` Allocate your buffer to hold the caption
    `*****************************************************************
    strCaption = Space(lngCaptionLen)
    `*****************************************************************
    ` Get the caption, and return the characters up to (but not
    ` including) the null terminator
    `*****************************************************************
    lngCaptionLen = GetWindowText(hWnd, strCaption, lngCaptionLen)
    GetWindowCaption = Left(strCaption, lngCaptionLen)
End Function
`*********************************************************************
` Get the class name using the same techniques described above
`*********************************************************************
Private Function GetWindowClassName(hWnd As Long) As String
    Dim strClassName As String
    Dim lngClassLen As Integer
    lngClassLen = 50
    strClassName = Space(lngClassLen)
    lngClassLen = GetClassName(hWnd, strClassName, lngClassLen)
    GetWindowClassName = Left(strClassName, lngClassLen)
End Function
`*********************************************************************
` Print some headers and call EnumWindows to print the window info
`*********************************************************************
Public Sub CallbackDemo(frmName As Form)
    frmName.Cls
    frmName.Print "Handle" & "  Class Name", "Window Caption"
    frmName.Print "------" & "  ----------", "--------------"
    EnumWindows AddressOf CallBackFunc, frmName
End Sub

CallBackFunc begins with our callback function that is declared as private. It is private, because we won't be calling this code anywhere in our VB application. However, the private qualifier has no effect on Windows capability to call this function. Each time this function is called, we check to see if the current window is visible. If it is, then we print its hwnd, class name, and window caption on the form passed in as the lParam of EnumWindows. Finally, we always return True. If, for some reason, we wanted to end the enumeration, we would return False from our callback function. You might do this if you used EnumWindows to find a specific window. After you find the window you are searching for, you can stop the enumeration.

GetWindowCaption and GetWindowClassName simply wrap a couple of APIs, so your callback routine is as simple as possible. Because both of these functions are retrieving strings from an API, they both build string buffers before the API call and trim off the null terminator after the API call.

The last, but perhaps the most important, function in Listing 46.16 is the public CallbackDemo method. This method is the public interface to your application that is responsible for calling EnumWindows and printing the results on the form you provide when you call CallbackDemo.

Figure 46.3 shows our callback function at work in Callback.frm. Listing 46.17 demonstrates how to build this task list. We pass in a reference to the form where we make the call by using the Me keyword.

FIG. 46.3
EnumWindows is great for creating a task list.

Listing 46.17 CALLBACK.FRM--Callback.frm Uses Our Sample Callback Function

`*********************************************************************
` Callback.frm - Demonstrates how to use basCallback
`*********************************************************************
Option Explicit
`*********************************************************************
` Updates the form with the current window list every time it gets
` a paint event
`*********************************************************************
Private Sub Form_Paint()
    CallbackDemo Me
End Sub

Because windows are always being added and removed, I elected to put our call to CallbackDemo in the Form_Paint event. Because creating or removing windows usually causes our form to be repainted, this technique allows our form to contain the latest visible window list.

From Here...

Now that you've had a small taste of what the Win32 API can do for you, it's time to experiment on your own. Take the samples in this chapter apart and use them in your own applications. Experiment, extend, and optimize them for your own code library. You'll find that, after you get the hang of writing VB programs that leverage the power of Win32, your dependency on third-party controls will be much less. Can you think of any controls you have now that could be replaced by the code in this chapter? If so, begin reworking your program right away.


Previous chapterNext chapterContents


Macmillan Computer Publishing USA

© Copyright, Macmillan Computer Publishing. All rights reserved.