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.
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.
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.
`********************************************************************* ` 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.
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.
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!
`********************************************************************* ` 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.
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.
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.
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.
`********************************************************************* ` 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.
`********************************************************************* ` 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."
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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
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.
`********************************************************************* ` 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.
`********************************************************************* ` 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.
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.
© Copyright, Macmillan Computer Publishing. All rights reserved.