附錄A Windows API 函數
訊息的世界
Microsoft Windows作業系統完全以訊息(message)為基礎，例如當使用者關閉視窗時，作業系統會傳給這個視窗一個WM_CLOSE訊息。當使用者按下按鍵，具有駐點(focus)的視窗會收到一個WM_CHAR訊息 (在本文中，視窗代表基本的視窗以及子控制項)。傳送訊息到視窗或是控制項也可以用來影響它們的外觀，行為或是取得它們的內容資訊。例如，您可以傳送WM_SETTEXT訊息到大多數的視窗及控制項中，來設定它們的內容字串，您也可以使用WM_GETTEXT訊息來讀取它們的內容。利用這些訊息，您可以設定或是讀取top-level視窗的標題，或是設定與讀取TextBox控制項的Text屬性，這種使用機會比較少。
廣泛來說，訊息可以分為兩種: 控制訊息(control message)及通知訊息(notification message)。控制訊息是由應用程式傳送到視窗或是控制項，藉此來取得設定或讀取它們的內容，或是更改它們的外觀或行為。通知訊息是由作業系統傳送到視窗或是控制項中，用以反應使用者在它們上面執行的動作。
Visual Basic大大的簡化的Windows應用程式的寫作，因為它自動把大多數的訊息轉換為屬性，方法及事件。Visual Basic程式設計人員可以使用Caption及Text屬性來取代WM_SETTEXT及MW_GETTEXT訊息。 他們也不需要去擔心捕捉傳送到表單的WM_CLOSE訊息，因為Visual Basic。自動即時地將它轉成Form_Unload事件。更一般地說，控制訊息對應到屬性及方法，反之，通知訊息對應到事件。
然而，並不是所有的訊息都是這樣的處理。例如，TextBox本身內建「復原」(undo)功能，但在Visual Basic中並未提供類似的屬性及方法，因此使用純的Visual Basic程式並無法使用這個功能。(在附錄中，純的Visual Basic代表不依賴外部API函數的程式)。還有另一個例子: 當使用者移動表單時，Windows會傳送WM_MOVE事件給表單，但Visual Basic會即時擷取這個訊息而不是產生一個事件。假使您的應用程式需要知道它的視窗何時被移動，可就沒那麼幸運了。
使用API函數可以解決上面的限制。在本節中，筆者將為您示範如何傳送一個控制訊息到視窗或是控制項中來改變它們的外觀或行為，而在〈回呼及subclassing〉小節中，筆者將敘述更複雜的程式設計技術，叫做Window subclassing，它可以讓您解譯那些Visual Basic不轉換的通知訊息。
在使用API函式之前，您必須先告訴Visual Basic包含該函式DLL的名稱還有每一個引數的型態，此時我們要在模組的宣告區域利用Declare陳述式來宣告。Declare必須在各種類型的模組中宣告成private，除了BAS模組外( 它也接受目前程式中可看得到的宣告成Public的Declare陳述式)。您可以在說明文件中找到關於Declare陳述式更詳細的說明。
在API函數中，主要用來傳送訊息到表單或是控制項的就是SendMessage，它的Declare陳述式如下:
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
(ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
hWnd代表您要傳送到哪一個視窗，它對應到視窗的hWnd屬性，wMsg代表訊息編號(通常是一個象徵的常數)，而wParam及lParam代表的意義會依據傳送的訊息而有所不同。請注意到lParam是宣告成As Any，因此您可以傳送任何形式的資料到這個參數，包含簡單的資料或是UDT(使用者自訂型態)。要避免傳送不合法資料的風險，筆者準備一個接收長整數版本的SendMessage函數以及一個接受字串的版本。我們也稱這種Declare陳述式為型態安全(type-safe)的。
Private Declare Function SendMessageByVal Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, Byval lParam As Long) As Long
Private Declare Function SendMessageString Lib "user32" _
Alias "SendMessageA" ByVal hWnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, ByVal lParam As String) As Long
不管這類型態安全變化，在本章中所使用的Declare函數，以及訊息象徵常數的值，都可以藉著執行Visual Basic所附的API檢視員來取得。
注意
當您使用API函數時，您是直接與作業系統作接觸，而不受Visual Basic所提供的安全機制保護。假使您錯誤的宣告或是執行API函數，您將會得到General Protection Fault(GPF)或是其它的致命性錯誤，這會使得Visual Basic發展環境立即關閉。因此﹐ 您應該再次檢查Declare陳述式及傳入到API函數的參數，並且在您執行專案之前執行存檔的動作。
| 圖A-1 在Visual Basic 6中已經改善了API檢視員，使它有能力設定常數、型態及Declare陳述式的範圍。 |
「多行」的TextBox控制項
當您使用「多行」的TextBox控制項時，SendMessage API函數將會非常有用，因為它的標準屬性及方法只能提供TextBox所有功能的一小部份。舉例而言，您可以傳送一個EM_GETLINECOUNT訊息到TextBox控制項，來得知有多少行數。
LineCount = SendMessageByVal(Text1.hWnd, EM_GETLINECOUNT, 0, 0)
或者，您也可以使用EM_GETFIRSTVISIBLELINE來得知第一個可見的行數(行數以0開始)。
FirstVisibleLine = SendMessageByVal(Text1.hWnd, EM_GETFIRSTVISIBLELINE, 0, 0)
說明
所有在本章中的範例程式都可在隨書光碟中找到。要讓這些程式可重覆使用，筆者在BAS模組中把這範例封裝到Function及Sub常式中。每個模組都包含API函數的宣告，還有使用使用Const來宣告所有象徵常數的定義。在隨書光碟中，您也可以找到使用所有常式的範例 (請參閱圖A-2)。
EM_LINESCROLL訊息可以讓您使用程式來上下左右捲動TextBox控制項的內容。在wParam您必須傳入所要水平捲動的欄數 (正數表示捲向右，負數表示捲向左)，而在lParam必須傳入垂直捲動的行數(正數表示向下，負數表示捲向上)。
' Scroll one line down and (approximately) 4 characters to the right. SendMessageByVal Text1.hWnd ,EM_LINESCROLL, 4, 1
| 圖A-2 這個範例程式示範了如何使用在TextBox.bas模組中的常式。 |
請注意，若TextBox控制項使用了未對齊(nonfixed)的字型，捲動的數目可能與傳入欄或行數的會有些出入。此外，若ScrollBars屬性設為2-Vertical，水平捲動將不會作用。您可以使用EM_SCROLLCARET捲動控制項的內容，來保證可以看見游標：
SendMessageByVal Text1.hWnd, EM_SCROLLCARET, 0, 0
在標準TextBox控制項中最令人詬病的限制就是沒有辦法去找出多長的行會分隔成多行。使用EM_FMTLINES訊息，您可以要求控制項Text屬性所傳回的值包含所謂的soft line break。Soft line break斷行是指當一行太長時，控制項在該行的切開點。Soft line break是使用CR-CR-LF序列來代表。而Hard line break是指使用者按下Enter鍵，使用CR-LF序列代表。當傳送EM_FMTLINES訊息時，您必須在wParam傳入True來啟動soft line breaks，或是傳入False來關閉它。筆者準備了一個使用這個功能將text所有行數填入到字串陣列的常式，如同在控制項中所顯示的。
' Return an array with all the lines in the control.
' If the second optional argument is True, trailing CR-LFs are preserved.
Function GetAllLines(tb As TextBox, Optional KeepHardLineBreaks _
As Boolean) As String()
Dim result() As String, i As Long
' Activate soft line breaks.
SendMessageByVal tb.hWnd, EM_FMTLINES, True, 0
' Retrieve all the lines in one operation. This operation leaves
' a trailing CR character for soft line breaks.
result() = Split(tb.Text, vbCrLf)
' We need a loop to trim the residual CR characters. If the second
' argument is True, we manually add a CR-LF pair to all the lines that
' don't contain the residual CR char (they were hard line breaks).
For i = 0 To UBound(result)
If Right$(result(i), 1) = vbCr Then
result(i) = Left$(result(i), Len(result(i)) - 1)
ElseIf KeepHardLineBreaks Then
result(i) = result(i) & vbCrLf
End If
Next
' Deactivate soft line breaks.
SendMessageByVal tb.hWnd, EM_FMTLINES, False, 0
GetAllLines = result()
End Function
要由文字區中取出一行，您可以使用EM_LINEINDEX訊息決定要由哪一行開始，EM_LINELENGTH來決定長度。筆者製作了一個可重覆使用的常式，它使用了這兩種訊息:
Function GetLine(tb As TextBox, ByVal lineNum As Long) As String
Dim charOffset As Long, lineLen As Long
' Retrieve the character offset of the first character of the line.
charOffset = SendMessageByVal(tb.hWnd, EM_LINEINDEX, lineNum, 0)
' Now it's possible to retrieve the length of the line.
lineLen = SendMessageByVal(tb.hWnd, EM_LINELENGTH, charOffset, 0)
' Extract the line text.
GetLine = Mid$(tb.Text, charOffset + 1, lineLen)
End Function
EM_LINEFROMCHAR訊息可以傳回某一文字所在的行數(line)，而EM_LINEINDEX訊息可以得知文字的欄數(column)。
' Get the line and column coordinates of a given character.
' If charIndex is negative, it returns the coordinates of the caret.
Sub GetLineColumn(tb As TextBox, ByVal charIndex As Long, line As Long, _
column As Long)
' Use the caret's offset if argument is negative.
If charIndex < 0 Then charIndex = tb.SelStart
' Get the line number.
line = SendMessageByVal(tb.hWnd, EM_LINEFROMCHAR, charIndex, 0)
' Get the column number by subtracting the line's start
' index from the character position.
column = tb.SelStart - SendMessageByVal(tb.hWnd, EM_LINEINDEX, line, 0)
End Sub
標準的TextBox控制項使用它們目前的用戶區域(client area)作編輯。您可以使用EM_GETRECT訊息來取得這個矩形的範圍，而如有需要，您也可以使用EM_SETRECT訊息來改變它的大小。在每一個實例中，您都必須加入對RECT結構的定義，很多其它的API函數也會使用到這個定義。
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
筆者包裝這些訊息，製成兩個常式。
' Get the formatting rectangle.
Sub GetRect(tb As TextBox, Left As Long, Top As Long, Right As Long, _
Bottom As Long)
Dim lpRect As RECT
SendMessage tb.hWnd, EM_GETRECT, 0, lpRect
Left = lpRect.Left: Top = lpRect.Top
Right = lpRect.Right: Bottom = lpRect.Bottom
End Sub
' Set the formatting rectangle, and refresh the control.
Sub SetRect(tb As TextBox, ByVal Left As Long, ByVal Top As Long, _
ByVal Right As Long, ByVal Bottom As Long)
Dim lpRect As RECT
lpRect.Left = Left: lpRect.Top = Top
lpRect.Right = Right: lpRect.Bottom = Bottom
SendMessage tb.hWnd, EM_SETRECT, 0, lpRect
End Sub
例如，請看看如何將矩形的寬度縮小：
Dim Left As Long, Top As Long, Right As Long, Bottom As Long GetRect tb, Left, Top, Right, Bottom Left = Left + 10: Right = Right - 10 SetRect tb, Left, Top, Right, Bottom
您可對「多行」的TextBox控制項作的最後一件事就是設定它們的定位(tab)位置。在TextBox控制項中預設的定位點是間隔32個dialog單位，而每一個dialog單位是1/4的平均字元寬。您可以使用EM_SETTABSTOPS訊息更改預設的距離：
' Set the tab stop distance to 20 dialog units ' (that is, 5 characters of average width). SendMessage Text1.hWnd, EM_SETTABSTOPS, 1, 20
您甚至可以在lParam傳入一個陣列來指定每個定位點的位置，此時在wParam需傳入陣列的大小。
Dim tabs(1 To 3) As Long ' Set three tab stops approximately at character positions 5, 8, and 15. tabs(1) = 20: tabs(2) = 32: tabs(3) = 60 SendMessage Text1.hWnd, EM_SETTABSTOPS, 3, tabs(1)
請注意要在API函數中傳入陣列時，其實是傳入陣列第一個元素的引用。
ListBox控制項
就如TextBox控制項，SendMessage API函數也在ListBox及ComboBox內建控制項中很有用。在本節中，筆者將為您描述可傳入到ListBox控制項的訊息。某些情況下，您可以在ComboBox控制項中使用與ListBox相似的訊息而得到同樣的結果，即使訊息的數值是不同的。例如，您可以使用LB_GETITEMHEIGHT(針對ListBox控制項)或是CB_GETITEMHEIGHT(針對ComboBox控制項) 訊息來取得在這控制項中每個項目的高度(單位為圖素)。筆者把這兩個訊息封裝到一個多型(polymorphic)的常式，可以用在這兩種控制項。
' The result of this routine is in pixels.
Function GetItemHeight(ctrl As Control) As Long
Dim uMsg As Long
If TypeOf ctrl Is ListBox Then
uMsg = LB_GETITEMHEIGHT
ElseIf TypeOf ctrl Is ComboBox Then
uMsg = CB_GETITEMHEIGHT
Else
Exit Function
End If
GetItemHeight = SendMessageByVal(ctrl.hwnd, uMsg, 0, 0)
End Function
| 圖A-3 這個範例程式示範了在ListBox與ComboBox控制項中使用SendMessage函數。 |
您也可以使用LB_SETITEMHEIGHT或CB_SETITEMHEIGHT訊息來為表列項目設定不同的高度。儘管項目的高度對它本身沒有價值，但它讓您算出在ListBox控制項中可顯示的項目數，在Visual Basic控制項並沒有提供這類屬性。要求得可顯示出的項目數，可以將控制項內部區域(控制項中的client area)高度除以項目高度來求得。要求得控制項的client area，您必須使用GetClientRect這個API函數。
Private Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, _ lpRect As RECT) As Long
底下這個函數使用上面的API函數來求得ListBox控制項中可見的項目數：
Function VisibleItems(lb As ListBox) As Long
Dim lpRect As RECT, itemHeight As Long
'Get client rectangle area.
GetClientRect lb.hWnd, lpRect
' Get the height of each item.
itemHeight = SendMessageByVal(lb.hWnd, LB_GETITEMHEIGHT, 0, 0)
' Do the division.
VisibleItems = (lpRect.Bottom - lpRect.Top) \ itemHeight
End Function
您可以用這個資訊來判斷ListBox控制項是否有垂直的捲動軸。
HasCompanionScrollBar = (Visibleitems(List1) < List1.ListCount)
Windows提供一些訊息可以用來在ListBox或是ComboBox控制項中快速搜尋字串。更精確地說，每個控制項各有兩個訊息，一個執行部分比對(也就是搜尋的字串要出現在表列項目中的開頭部分) ，另一個是精確比對。您要在wParam中傳入要開始搜尋的第一個項目索引，-1代表從頭開始，而在lParam傳入要搜尋的字串。這種搜尋是不分大小寫的。底下可重覆使用的常式包裝了這四個API函式，若是搜尋成功則回傳回該項目索引，若搜尋失敗則傳回-1。當然您也可以使用迴圈來得到相同的結果，但是通常使用API函數會比較快。
Function FindString(ctrl As Control, ByVal search As String, Optional _
startIndex As Long = -1, Optional ExactMatch As Boolean) As Long
Dim uMsg As Long
If TypeOf ctrl Is ListBox Then
uMsg = IIf(ExactMatch, LB_FINDSTRINGEXACT, LB_FINDSTRING)
ElseIf TypeOf ctrl Is ComboBox Then
uMsg = IIf(ExactMatch, CB_FINDSTRINGEXACT, CB_FINDSTRING)
Else
Exit Function
End If
FindString = SendMessageString(ctrl.hwnd, uMsg, startIndex, search)
End Function
因為每次的搜尋是由startIndex位置後開始，所以我們可以很簡單使用一個迴圈來列出所有相同的項目:
' Print all the elements that begin with the "J" character.
index = -1
Do
index = FindString(List1, "J", index, False)
If index = -1 Then Exit Do
Print List1.List(index)
Loop
當ListBox控制項中的內容比它的client area還要寬時，應該顯示水平捲軸，但這是Visual Basic另一個未提供的功能。要顯示水平捲軸，您必須使用LB_SETHORIZONTALEXTENT訊息來告訴控制項它的內容比client area寬 (如圖A-3)，在wParam引數中要傳入寬度(圖素)。
' Inform the ListBox control that its contents are 400 pixels wide. ' If the control is narrower, a horizontal scroll bar will appear. SendMessageByVal List1.hwnd, LB_SETHORIZONTALEXTENT, 400, 0
在標準的ListBox控制項中設定定位點，可以讓它變得更多用途。這個技巧如同在TextBox控制項中所使用的。假使您為ListBox控制項加入了水平捲軸，您便可以ListBox可以用來顯示簡單的表格，而不用求助於外部ActiveX控制項。您所需作的就是設定適當的定位點距離，並且加入用來顯示定位點的一行，如底下的程式：
' Create a 3-column table using a ListBox. ' The three columns hold 5, 20, and 25 characters of average width. Dim tabs(1 To 2) As Long tabs(1) = 20: tabs(2) = 100 SendMessage List1.hWnd, LB_SETTABSTOPS, 2, tabs(1) ' Add a horizontal scroll bar, if necessary. SendMessageByVal List1.hwnd, LB_SETHORIZONTALEXTENT, 400, 0 List1.AddItem "1" & vbTab & "John" & vbTab & "Smith" List1.AddItem "2" & vbTab & "Robert" & vbTab & "Doe"
您可以瀏覽光碟上的示範程式原始碼，來學習使用其它一些ListBox訊息。
ComboBox控制項
如同筆者在上一節所講的，ComboBox及ListBox控制項支援一些通用的訊息﹐ 即使對應的象徵常數的名稱及值不同。例如您可以使用CB_GETITEMHEIGHT及CB_SETITEMHEIGHT來讀取或更改表列項目的高度，而使用CB_FINDSTRINGEXACT及CB_FINDSTRING來搜尋項目。但ComboBox控制項也提供了其它幾個有趣的訊息。舉例而言，透過CB_SHOWDROPDOWN訊息，您可以使用程式來開啟或關閉下拉式ComboBox控制項的列表部分。
' Open the list portion. SendMessageByVal Combo1.hWnd, CB_SHOWDROPDOWN, True, 0 ' Then close it. SendMessageByVal Combo1.hWnd, CB_SHOWDROPDOWN, False, 0
而使用GETDROPPEDSTATE訊息可以取得目前列表部分的可見狀態。
If SendMessageByVal(Combo1.hWnd, CB_GETDROPPEDSTATE, 0, 0) Then
' The list portion is visible.
End If
在ComboBox控制項中最有用的訊息之一就是CB_SETDROPPEDWIDTH，它讓您設定ComboBox下拉式列表的寬度，而小於控制項寬度的值會被忽略。
' Make the drop-down list 300 pixels wide. SendMessageByVal cb.hwnd, CB_SETDROPPEDWIDTH, 300, 0
(在圖A-3中示範的ComboBox，它的下拉式列表比平常寬)。最後，您可以使用CB_LIMITTEXT訊息來設定控制項可接受的最大字元數；這很像TextBox控制項的MaxLength屬性，而ComboBox正缺少這個屬性:
' Set the maximum length of text in a ComboBox control to 20 characters. SendMessageByVal Combo1.hWnd, CB_LIMITTEXT, 20, 0
系統函數
在Windows內部有很多值及引數超過了Visual Basic的能力，但它們只是轉移到API函數。在這一節筆者將為您展示如何取得一些重要的系統設定，以及如何加強Visual Basic對滑鼠及鍵盤的支援能力。
Windows目錄及版本
即使Visual Basic隱藏了作業系統大部分的複雜性，就像在許多Windows版本間的差異，有時您還是必須區分這些不同的版本，例如要處理Windows 9x及Windows NT中些微的差異時。您可以透過檢查由GetVersion API函數所傳回長整數的最高bit來達成：
Private Declare Function GetVersion Lib iikernel32lr () As Long
If GetVersion() And &H80000000 Then
MsgBox "Running under Windows 95/98"
Else
MsgBox "Running under Windows NT"
End If
假使您要知道Windows的實際版本，您需要使用GetVersionEx API函數，它會將目前作業系統的資訊用UDT來傳回：
Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32" Alias _
"GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long
Dim os As OSVERSIONINFO, ver As String
' The function expects the UDT size in the UDT's first element.
os.dwOSVersionInfoSize = Len(os)
GetVersionEx os
ver = os.dwMajorVersion & "." & Right$("0" & Format$(os.dwMinorVersion)，2)
Print "Windows Version = " & ver
Print "Windows Build Number = " & os.dwBuildNumber
Windows 95傳回的版本號碼為4.00，而Windows 98的版本號碼為4.10(圖A-4)。您可以使用Build號碼來辨識不同的service packs。
所有的秘訣及小技巧都會告訴您要如何取得Windows的主目錄及系統目錄，在它們之中可以找到許多您感興趣的檔案。這些函數會很有用處的另一個原因是: 它們告訴您如何從API函數接收字串。通常，沒有一個API函數會直接傳會字串，相反地，當API函數傳回字串給呼叫它的程式時，會需要您先建立一個接收的字串緩衝區傳給該常式，這個字串通常會填滿空白(space)或是null。大多數的情況下，您必須把緩衝區的長度傳到另一個引數中，如可API函數才不會意外地多寫入資料。例如底下是GetWindowsDirectory API函數的宣告。
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
| 圖A-4 這個程式示範了幾個系統，鍵盤及滑鼠的API函數 |
使用這個函數必須先配置足夠的緩衝區，然後傳入到這個函數。函數所傳回的值代表結果字串的實際字元數，您可以使用這個值來切除掉多餘的字元：
Dim buffer As String, length As Integer buffer = Space$(512) length = GetWindowsDirectory(buffer, Len(buffer)) Print "Windows Directory = " & Left$(buffer, length)
您可以使用同樣的方法，透過GetSystemDirectory API函數來取得Windows\System的路徑：
Private Declare Function GetSystemDirectory Lib "kernel32" Alias _
"GetSystemDirectoryA" (ByVal lpBuffer As String, _
ByVal nSize As Long) As Long
Dim buffer As String, length As Integer
buffer = Space$(512)
length = GetSystemDirectory(buffer, Len(buffer))
Print "System Directory =" & Left$(buffer, length)
GetTempPath API函數使用了相似的語法 - 雖然引數的順序是相反的，它會傳回存放暫存檔案的目錄名稱，這個名稱最後會有一個反斜線(例如C:\WINDOWS\TEMP\)。
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Dim buffer As String, length As Integer
buffer = Space$(512)
length = GetTempPath (Len(buffer), buffer)
Print "Temporary Directory =" & Left$(buffer, length)
GetUserName函數會傳回目前登錄系統的使用者名稱。請大略看一下這個函數，您可能覺得跟筆者描述過的函數用的語法沒什麼不同。然而，說明文件透露出它並不回傳回結果字串的長度，而是傳回0代表操作失敗，1代表操作成功。在這種情況下，您必須在緩衝區中搜尋Null字元取得結果，所有的API函數都會在結果字串最後加上Null字元：
Private Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA". (ByVal lpBuffer As String, nSize As Long) As Long
Dim buffer As String * 512, length As Long
If GetUserName buffer, Len(buffer) Then
' Search the trailing Null character.
length = InStr(buffer, vbNullChar) - 1
Print "User Name = " & Left$(buffer, length)
Else
Print "GetUserName function failed"
End If
GetComputerName API函數會傳回執行目前程式的電腦名稱，它又使用了另一種方法：您必須在ByRef引數中傳入緩衝區的長度。在這個函數結束時，這個引數的數字代表結果的長度。
Private Declare Function GetComputerName Lib "kernel32" Alias _
"GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Dim buffer As String * 512, length As Long
length = Len(buffer)
If GetComputerName(buffer, length) Then
' Returns nonzero if successful, and modifies the length argument
MsgBox "Computer Name = " & Left$(buffer, length)
End If
鍵盤
Visual Basic的鍵盤事件可以讓您知道哪一個鍵被按下，以及何時被按下。然而有時候，知道某些指定的按鍵是否被按下是很有用的，即使不在鍵盤事件程序中。純Visual Basic解決的辦法是把被按下的按鍵存放在模組階段或是全域的變數中，但這個解決方案對我們要撰寫出能夠重覆使用的程式會造成負面的影響。幸運地是，您可以使用GetAsyncKeyState函數來取得某按鍵目前的狀態：
Private Declare Function GetAsyncKeyState Lib "user32" _
(ByVal vKey As Long) As Integer
這個函數會接收一個按鍵代碼，並傳回一個整數，若整數的最高位元為1 ，則代表按鍵被按下。您可以使用Visual Basic的vbKeyxxxx象徵常數當作這個函數的引數。例如您可以用這段程式來辨別是否有任一個shift按鍵被按下。
Dim msg As String If GetAsyncKeyState(vbKeyShift) And &H8000 Then msg = msg & "SHIFT " If GetAsyncKeyState(vbKeyControl) And &H8000 Then msg = msg & "CTRL " If GetAsyncKeyState(vbKeyMenu) And &H8000 Then msg = msg & "ALT " ' lblKeyboard is a Label control that displays the shift key states. lblKeyboard.Caption = msg
GetAsynchKeyState另一個有趣的特性是，即時應用程式沒有輸入駐點(input focus)也可以運作。這個特性可以讓您建立具有熱鍵(hot keys)能力的Visual Basic程式，即使使用者正在使用其它的應用程式時按下這些熱鍵。要使用這個API函數捕捉熱鍵，您必須在Timer控制項中的Timer事件程序中加入一些程式碼， 並且把Interval屬性設為適當的值，例如200毫秒(milliseconds)。
' Detect the Ctrl+Alt+A key combination.
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyA) And &H8000 Then
If GetAsyncKeyState(vbKeyControl) And &H8000 Then
If GetAsyncKeyState(vbKeyMenu) And &H8000 Then
' Process the Ctrl+Alt+A hot key here.
End If
End If
End If
End Sub
您可以使用下面常式的帶來的好處，來讓您的程式看起來更合理，這個常式會測試三個按鍵的狀態。
Function KeysPressed(KeyCode1 As KeyCodeConstants, Optional KeyCode2 As _
KeyCodeConstants, Optional KeyCode3 As KeyCodeConstants) As Boolean
If GetAsyncKeyState(KeyCode1) >= 0 Then Exit Function
If KeyCode2 = 0 Then KeysPressed = True: Exit Function
If GetAsyncKeyState(KeyCode2) >= 0 Then Exit Function
If KeyCode3 = 0 Then KeysPressed = True: Exit Function
If GetAsyncKeyState(KeyCode3) >= 0 Then Exit Function
KeysPressed = True
End Function
這三個引數的型態為KeyCodeConstant (在Visual Basic執行時期程式庫中定義的列舉型態)，所以Visual Basic會自動幫您撰寫函數的程式碼。底下是把之前的程式碼改寫後的版本，用來捕捉Ctrl+Alt+A熱鍵。
If KeysPressed(vbKeyA, vbKeyMenu, vbKeyControl) Then
' Process the Ctrl+Alt+A hot key here.
End If
您也可以更改某各按鍵目前的狀態，例如利用程式來更改CapsLock，NumLock或是ScrollLock按鍵的狀態。在
第十章 中的"Toggling the State of Lock Keys"小節中有這個技巧的範例。
滑鼠
在Visual Basic中所提供的滑鼠支援，在某些情況下顯得是有缺陷的。就像鍵盤及它的事件程序，您只能在滑鼠的MouseDown、MouseUp及MouseMove事件程序中取得一些關於滑鼠位置，按鈕狀態的資訊，這使得要在BAS模組中建立一個可重覆使用的常式變成是一項困難的任務。最使人煩惱的是，這些事件只會發生在滑鼠游標下面的控制項中，因此您必須撰寫大量的程式碼，來找出滑鼠在哪些指定的位置上。很幸運地，要使用API函數來取得滑鼠的資訊是很簡單的。
首先，您不需用到特別的函數來取得滑鼠按鈕的狀態，因為您可以使用加上vbKeyLButton、vbKeyRButton及vbKeyMButton象徵常數的GetAsyncKeyState函數來達成。底下的常式會傳回滑鼠按鈕目前的狀態，結果就與使用Mousexxxx事件程序中傳回的Button引數相同。
Function MouseButton() As Integer
If GetAsyncKeyState(vbKeyLButton) < 0 Then
MouseButton = 1
End If
If GetAsyncKeyState(vbKeyRButton) < 0 Then
MouseButton = MouseButton Or 2
End If
If GetAsyncKeyState(vbKeyMButton) < 0 Then
MouseButton = MouseButton Or 4
End If
End Function
Windows API中包含一個讀取滑鼠游標位置的函數。
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) _
As Long
在兩種情況中，座標都是以pixels為單位，並是螢幕的相對位置。
' Display current mouse screen coordinates in pixels using a Label control. Dim lpPoint As POINTAPI GetCursorPos lpPoint lblMouseState = "X = " & lpPoint.X & " Y = " & lpPoint.Y
要把螢幕座標轉換為相對Window client area(在window邊框內的區域) 的座標，您可以使用ScreenToClient API函數：
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long
' Display mouse screen coordinates relative to current form.
Dim lpPoint As POINTAPI
GetCursorPos lpPoint
ScreenToClient Me.hWnd，lpPoint
lblMouseState = "X = " & lpPoint.X & " Y = " & lpPoint.Y
SetCursorPos API函數可以讓您將滑鼠移到螢幕上的任何地方，這是在標準的Visual Basic程式中無法達到的。
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, _ ByVal Y As Long) As Long
當您使用這個函數時，您時常必須將client座標轉換為螢幕座標，這可以藉由ClienToScreen API函數來達成。下面的程式片段會將滑鼠座標移到某個按鈕的中央。
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
lpPoint As POINTAPI) As Long
' Get the coordinates (in pixels) of the center of the Command1 button.
' The coordinates are relative to the button's client area.
Dim lpPoint As POINTAPI
lpPoint.X = ScaleX(Command1.Width / 2, vbTwips, vbPixels)
lpPoint.Y = ScaleY(Command1.Height / 2, vbTwips, vbPixels)
' Convert to screen coordinates.
ClientToScreen Command1.hWnd, lpPoint
' Move the mouse cursor to that point.
SetCursorPos lpPoint.X, lpPoint.Y
在某些情況下，例如在拖放作業中，您可能希望限制使用者將滑鼠移到某個區域外。您可以使用ClipCursor API函數來定義一個矩形的clipping area，達成上述目的。假使您時常需要將滑鼠限制在某個視窗區域中，您可以使用GetClientRect API函數來取得視窗的client area，然後將它轉換成螢幕座標。下面的常式正式您所需要的。
Private Declare Function ClipCursor Lib "user32" (lpRect As Any) As Long
Sub ClipMouseToWindow(ByVal hWnd As Long)
Dim lpPoint As POINTAPI, lpRect As RECT
' Retrieve the coordinates of the upper-left corner of the window.
ClientToScreen hWnd, lpPoint
' Get the client screen rectangle.
GetClientRect hWnd, lpRect
' Manually convert the rectangle to screen coordinates.
lpRect.Left = lpRect.Left + lpPoint.X
lpRect.Top = lpRect.Top + lpPoint.Y
lpRect.Right = lpRect.Right + lpPoint.X
lpRect.Bottom = lpRect.Bottom + lpPoint.Y
' Enforce the clipping.
ClipCursor lpRect
End Sub
底下的範例使用上面的常式來取消限制區域的效果。
' Clip the mouse cursor to the current form's client area. ClipMouseToWindow Me.hWnd ... ' When you don't need the clipping any longer. (Don't forget this!) ClipCursor ByVal 0&
(請記得假使視窗正執行MsgBox或是InputBox陳述式時，會自動失去對滑鼠的捕捉) 正常情況下，視窗會傳送滑鼠訊息給滑鼠游標下的控制項。唯一的例外是當使用者在視窗中按下滑鼠按鈕，並且拖曳到視窗外面時。這個情況下，視窗會持續接收到滑鼠訊息直到放開滑鼠按鈕。但是有時候，若能讓我們即使在視窗邊界外面也能夠接收到滑鼠通知，會變得更方便。
請假設底下的情況: 當滑鼠游標進入控制項的區域中時，您需要提供使用者一些提示 - 例如更改控制項的背景顏色。您可以在MouseMove事件中更改控制項的BackColor屬性來達到這個效果，因為當游標移到控制項時會立刻產生這個事件。不幸地，Visual Basic在滑鼠游標移開控制項時，並不會產生任何事件，所以您沒有任何辦法得知何時該還原原始的背景顏色。使用純Visual Basic，您可以在表單的MouseMove事件程序及表單中所有的控制項中撰寫程式，或是使用Timer控制項來監控滑鼠游標，來強迫達到這個目的。但這並不是漂亮且具效益的解決辦法。
比較好的做法是使用SetCapture API函數來捕捉滑鼠游標進入控制項的client area。當表單或是控制項捕捉到滑鼠時，它會接收到滑鼠訊息直到使用者在表單或是控制項的外面按下滑鼠按鈕，或是直到透過ReleaseCaptureAPI函數來放棄對滑鼠的捕捉。這個技術讓您只需在單一的程序中撰寫程式，便可解決上述的問題。
' Add these declarations to a BAS module.
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) _
As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
Private Declare Function GetCapture Lib "user32" () As Long
' Change the BackColor of Frame1 control to yellow when the mouse enters
' the control's client area，and restore it when the mouse leaves it.
Private Sub Frame1_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
' Set the mouse capture unless the control already has it.
' (The GetCapture API function returns the handle of the window that
' has the mouse capture.)
If GetCapture <> Frame1.hWnd Then
SetCapture Frame1.hWnd
Frame1.BackColor = vbYellow
ElseIf X < 0 Or Y < 0 Or X > Frame1.Width Or Y > Frame1.Height Then
' If the mouse cursor is outside the Frame's client area, release
' the mouse capture and restore the BackColor property.
ReleaseCapture
Frame1.BackColor = vbButtonFace
End If
End Sub
您可以看到在圖A-4中的示範程式中使用到了這個技術。任何時候，當使用者把滑鼠進入或是移開top-level的Frame控制項時，會變換背景顏色。通常我們會使用WindowsFromPoint API函數，來讓我們更方便撰寫處理滑鼠的程式，因為它會傳回所指定螢幕座標的視窗handle。
Private Declare Function WindowFromPointAPI Lib "user32" Alias _ "WindowFromPoint" (ByVal xPoint As Long, ByVal yPoint As Long) As Long
底下常式會傳回目前滑鼠游標下面視窗的handle：
Function WindowFromMouse() As Long
Dim lpPoint As POINTAPI
GetCursorPos lpPoint
WindowFromMouse = WindowFromPoint(lpPoint.X, lpPoint.Y)
End Function
例如您可以用下面的方法，很快地找出在滑鼠游標下面的控制項：
Dim handle As Long, ctrl As Control
On Error Resume Next
handle = WindowFromMouse()
For Each ctrl In Me.Controls
If ctrl.hWnd <> handle Then
' Not on this control, or hWnd property isn't supported.
Else
' For simplicity's sake, this routine doesn't account for elements
' of control arrays.
Print "Mouse is over control " & ctrl.Name
Exit For
End If
Next
要獲得更多的資訊，請參考隨書光碟中的原始程式。
WINDOWS REGISTRY
Windows登錄資料庫(Registry)是作業系統及大多數應用程式儲存組態資訊的地方。您的應用程式必須具備能讀寫登錄資料庫的能力，才能建立出具彈性的應用程式，可以適合不同環境。
不幸地，Visual Basic提供支援登錄資料庫功能非常少，僅只於下面四個指令及函數。
' Save a value. SaveSetting AppName, Section, Key, Setting ' Read a value. (The Default argument is optional.) value = GetSetting(AppName, Section, Key, Default) ' Return a list of settings and their values. values = GetAllSettings(AppName, Section) ' Delete a value. (Section and Key arguments are optional.) DeleteSetting AppName, Section, Key
這四個指令並不能讓您隨心所欲的讀寫登錄資料庫，它被限制只能作用在HKEY_CURRENT_USER\Software\ VB and VBA Program Settings的子樹狀目錄。例如，您可以使用SaveSetting函數來存放MyInvoicePrg應用程式主表單的啟始位置及大小。
SaveSetting "MyInvoicePrg", "frmMain", "Left", frmMain.Left SaveSetting "MyInvoicePrg", "frmMain", "Top", frmMain.Top SaveSetting "MyInvoicePrg", "frmMain", "Width", frmMain.Width SaveSetting "MyInvoicePrg", "frmMain", "Height", frmMain.Height
在圖A-5中可以看到這一連串陳述式的結果。
| 圖A-5 所有的Visual Basic登錄資料庫函數都讀寫HKEY_CURRENT_USER\Software\ VB and VBA Program Settings的子樹狀目錄 |
稍後您可以使用GetSetting函數來讀取剛剛的設定。
' Use the Move method to avoid multiple Resize and Paint events.
frmMain.Move GetSetting("MyInvoicePrg", "frmMain", "Left", "1000"), _
GetSetting("MyInvoicePrg", "frmMain", "Top"，"800"), _
GetSetting("MyInvoicePrg", "frmMain", "Width", "5000l"), _
GetSetting("MyInvoicePrg", "frmMain", "Height", "4000")
假使指定的機碼(key)不存在，當您有傳入Default引數時，GetSetting會傳回Default，若沒有傳入Default引數，則會傳回空字串。GetAllSettings會傳回一個二維陣列，包含所指定區段中所有的機碼及設定值。
Dim values As Variant, i As Long
values = GetAllSettings("MyInvoicePrg", "frmMain")
' Each row holds two items, the key name and the key value.
For i = 0 To UBound(settings)
Print "Key =" & values(I, 0) & " Value = " & values(I, 1)
Next
這組指令中最後一個函數就是DeleteSetting，可以讓您刪除個別的機碼，若您省略最後的引數就會刪除指定區段的所有機碼。
' Delete the "Left" key for the frmMain form. DeleteSetting "MyInvoicePrg", "frmMain", "Left" ' Delete all the settings for the frmMain form. DeleteSetting "MyInvoicePrg", "frmMain"
在圖A-6的範例程式示範了如何使用Visual Basic內建的登錄函數來存取設定。
| 圖A-6 這個範例程式包含了可重覆使用的存取登錄資料庫設定常式。 |
API函數
雖然Visual Basic內建的函數還能勉強應付存取程式組態資訊的需要，它們卻完全沒有能夠在登錄資料庫隨意存取任何區域的函數，這些區域可能存放一些您所需的重要系統資訊。幸運地，Windows API函數包含執行這項工作所需的函數。
注意
當您使用這種方式來「玩」登錄資料庫，必須非常小心，因為您可能會破壞其它安裝的應用程式或是作業系統本身，此時您只能重新安裝它們。但是，若您只是單純讀取登錄資料庫的資料，而不寫入，通常不會造成什麼大傷害。然而為了保險起見，您最好還是先備份系統登錄資料庫，已備毀損後還能還原。
預先定義的機碼(keys)
在開始玩API函數之前，您必須先對登錄資料庫的排列方式有些大概瞭解。系統登錄資料庫是階層的結構，由機碼(keys)，子機碼(subkeys)及設定值(values)所組成。更精確地說，登錄資料庫有一些預先設定最上層(top-level) 的機碼，筆者在表A-1列出這些機碼。
| 機碼 | 值 | 描述 |
|---|---|---|
| HKEY_CLASSES_ROOT | &H80000000 | 這個樹狀目錄包含所有安裝在這台機器上COM元件的資訊(它實際上是HKEY_LOCAL_MACHINE下的子目錄，但也顯示在樹的最上層) |
| HKEY_CURRENT_USER | &H80000001 | 這個樹狀目錄記載目前使用者的喜好(它實際上是HKEY_USERS下的子目錄，但也顯示在樹的最上層) |
| HKEY_LOCAL_MACHINE | &H80000002 | 這個樹狀目錄存放關於電腦實體組態的資訊，包含安裝的硬體及軟體 |
| HKEY_USERS | &H80000003 | 這個樹狀目錄存放預設使用者的組態，以及關於目前使用者的資訊 |
| HKEY_PERFORMANCE_DATA | &H80000004 | 這個樹狀目錄蒐集效能資料，這些資料實際上不是存放在登錄資料庫內，但也會顯示為登錄資料庫的一部份(只有Windows NT) |
| HKEY_CURRENT_CONFIG | &H80000005 | 這個樹狀目錄包含目前的組態( 它對應到HKEY_LOCAL_MACHINE中的子目錄，但也顯示在數的最上層) |
| HKEY_DYN_DATA | &H80000006 | 這個樹狀目錄蒐集效能資料; 登錄資料庫中這個部分會在每次重新開機時重新啟始( 只有Windows 95及98) |
| 表A-1 預先定義好的登錄機碼 |
每一個登錄機碼都有一個名稱，它是一個不超過260可列印字元的字串，字串不能包含反斜線(\)及萬用字元(? 及 *)。以句號開頭的名稱是系統保留字。每個機碼都包含子機碼及設定值。在Windows 3.1，一個機碼只能有一個未命名的設定值，而在32位元平台上允許無限制的數目 (但是未命名的設定值，稱為預設值，將來會較難以維護)。
說明
通常，Windows 9x及Windows NT處理登錄資料庫的方式有所不同。在Windows NT中您還必須負責額外的安全問題，通常您不被保證能開啟已存在的登錄機碼及設定值。在本節中，筆者避開了像這樣的細節，而專注於那些在所有Windows平台功能都一樣的函數。因此，筆者有時候會使用「舊」的函數而不使用新的，新的函數可以由函數名稱字尾是不是Ex來判斷，Ex代表擴充的(extended)。
使用機碼
瀏覽登錄資料庫類似探索目錄樹：要到達指定的檔案，您必須先打開包含該檔案的目錄。同樣地，在登錄資料庫的階層中，要由上層的機碼才能到達它的子機碼。在讀取機碼的子機碼及設定值前，必須先打開它，要達到這個目的，您必須提供登錄資料庫中其它打開的機碼handle。在您使用機碼後，必須關閉它，就如同處理檔案一般。在機碼中，唯一不需要關閉的就是表A-1中所列出最上層的機碼。您可以使用RegOpenKeyEx API函數打開機碼。
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" _
(ByVal hKey As Long，ByVal lpSubKey As String, ByVal ulOptions As _
Long, ByVal samDesired As Long, phkResult As Long) As Long
hKey是一個開啟機碼的handle，它可以是表A-1中的任何一個，或是您之前已經開啟的機碼。ulOptions是一個保留的引數，必須設定為0。samDesired是您想要開啟機碼的存取型態，它是一個象徵常數，例如KEY_READ，KEY_WRITE，或是KEY_ALL_ACCESS。最後，phkResult是一個長整數型態的引數，若這個函數執行成功，則該引數會傳回函數所開啟機碼的handle。您可以檢查RegOpenKeyEx所傳回的值來測試開啟的作業是否成功：0代表作業成功，而任何非0的值代表錯誤代碼。這個行為可套用在所有登錄資料庫的API函數上，所以您可以很容易地建立一個函數來測試所有形式的呼叫狀態 (請查閱MSDN文件中的錯誤代碼列表)。
如同筆者之前所提及的，當您不再使用已開啟的機碼時，就應該立刻關閉它，此時您需要使用到RegCloseKey API函數。這個函數唯一引數就是您要關閉機碼的handle，若關閉成功則傳回0。
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) _ As Long
在機碼中存在的子機碼經常已經足夠存放有意義的資料。例如，假使機器上有裝置算數處理器，Windows會建立底下的機碼：
HKEY_LOCAL_MACHINE\HARDWARE\DESCRIPTION\System\FloatingPointProcessor
所以您可以使用底下的常式來測試是否有安裝處理器：
' Assumes that all symbolic constants are correctly declared elsewhere.
Function MathProcessor() As Boolean
Dim hKey As Long, Key As String
Key = "HARDWARE\DESCRIPTION\System\FloatingPointProcessor"
If RegOpenKeyEx(HKEY_LOCAL_MACHINE, Key, 0, KEY_READ, hKey) = 0 Then
' If the open operation succeeded, the key exists.
MathProcessor = True
' Important: close the key before exiting.
RegCloseKey hKey
End If
End Function
正如您所想像的，登錄資料庫API包含建立新機碼的函數，但它的語法十分複雜：
Declare Function RegCreateKeyEx Lib "advapi32.dll"Alias "RegCreateKeyExA"_
(ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long,_
ByVal lpClass As Long, ByVal dwOptions As Long, _
ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _
phkResult As Long, lpdwDisposition As Long) As Long
大部分引數的名稱與語法和筆者之前所介紹RegOpenKeyEx函數的相同，而筆者將不再對其它大部分新的引數作描述，因為它們所牽扯的主題太過深入。您可以在lpdwDisposition引數中傳入一個長整數，並且在呼叫函數後測試這個引數的內容。REG_CREATED_NEW_KEY (1)代表這個機碼原本並不存在，而RegCreateKeyEx已經成功幫您建立並且開啟，而REG_OPENED_EXISTING_KEY (2)代表這個機碼原本就已經存在，RegCreateKeyEx只是幫您開啟而並沒有修改登錄資料庫。要減少混淆，筆者使用底下的常式，若有需要，它會建立新的機碼，若機碼已經存在，則回傳回True。
Function CreateRegistryKey(ByVal hKey As Long, ByVal KeyName As String) _
As Boolean
Dim handle As Long, disp As Long
If RegCreateKeyEx(hKey, KeyName, 0, 0, 0, 0, 0, handle, disp) Then
Err.Raise 1001, , "Unable to create the Registry key"
Else
' Return True if the key already existed.
If disp = REG_OPENED_EXISTING_KEY Then CreateRegistryKey = True
' Close the key.
RegCloseKey handle
End If
End Function
底下的程式片段將展示如何使用CreateRegistryKey函數來幫您在HKEY_CURRENT_USER\Software機碼下建立一個以您公司為名稱的機碼，還有一個以您應用程式為名稱的機碼。大多數的商業應用程式都使用這種方法，包含Microsoft及其它領導界軟體公司的產品。
CreateRegistryKey HKEY_CURRENT_USER, "Software\YourCompany" CreateRegistryKey HKEY_CURRENT_USER, "Software\YourCompany\YourApplication"
說明
CreateRegistryKey函數如同其它在隨書CD中所提供的常式，在離開時一定先關閉機碼。這種方法能確保它們的安全，但相對也會損失一點效率，因為每一次呼叫這個函式都會開啟及關閉機碼，而這個機碼可能在您稍後又會需要開啟，例如前面的程式。安全與效率您必須二擇其一。
最後，您可以使用RegDeleteKey API函數從登錄資料庫中刪除一個機碼。
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" _ (ByVal hKey As Long, ByVal lpSubKey As String) As Long
在Windows 95及98中，這個函數會刪除一個機碼及它所有的子機碼，而在Windows NT中，若機碼中含有其它的機碼，則會發生錯誤。因此，您必須先手動刪除所有的子機碼。
' Delete the keys created in the previous example. RegDeleteKey HKEY_CURRENT_USER, "Software\YourCompany\YourApplication" RegDeleteKey HKEY_CURRENT_USER, "Software\YourCompany"
使用設定值 (values)
大多數的情況中，註冊機碼含有一或多個設定值，所以您必須學會如何讀取這些設定值，此時可以藉由RegQueryValueEx API函數來達成。
Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal lpReserved As Long, lpType As Long, lpData As Any, _
lpcbData As Long) As Long
hKey是包含這個設定值的機碼handle。lpValueName您想要讀取設定值的名稱(空字串代表預設值)。lpReserved必須設為0。lpType是機碼的型態。lpData是一個指標，指到用來存放接收資料的緩衝區。lpcbData是一個傳址的長整數變數，剛開始傳入是緩衝區的大小bytes數，傳回是實際上緩衝區存放資料的大小。大多數您所想要讀取的設定值型態是REG_DWORD(長整數)，REG_SZ(null結尾的字串)，或是REG_BINARY(bytes陣列)。
Visual Basic發展環境本身將一些組態設定值存放在下面的機碼當中：
HKEY_CURRENT_USER\Software\Microsoft\VBA\Microsoft Visual Basic
您可以讀取FontHeight設定值來取得程式編輯器的字型大小，而FontFace則是字型的名稱。因為前者為長整數，而後者為字串，程式必須使用兩種方式來讀取。讀取長整數會比較容易，因為您只要在lpData中傳入長整數的引用，並且在lpcbData中傳入它的大小(長整數為4個bytes)。
Dim KeyName As String, handle As Long
Dim FontHeight As Long, FontFace As String, FontFaceLen As Long
KeyName = "Software\Microsoft\VBA\Microsoft Visual Basic"
If RegOpenKeyEx(HKEY_CURRENT_USER, KeyName, 0, KEY_READ, handle) Then
MsgBox "Unable to open the specified Registry key"
Else
' Read the ihFontHeightlH value.
If RegQueryValueEx(handle, "FontHeight", 0, REG_DWORD, FontHeight, 4) _
= 0 Then
Print "Face Height = " & FontHeight
End If
' Read the "FontFace" value.
FontFaceLen = 128 ' Prepare the receiving buffer.
FontFace = Space$(FontFaceLen)
' Notice that FontFace is passed using ByVal.
If RegQueryValueEx(handle, "FontFace", 0, REG_SZ, ByVal FontFace, _
FontFaceLen) = 0 Then
' Trim excess characters, including the trailing Null char.
FontFace = Left$(FontFace, FontFaceLen - 1)
Print "Face Name = " & FontFace
End If
' Close the Registry key.
RegCloseKey handle
End If
因為您可能時常會需要讀取登錄設定值，筆者準備了一個可重覆使用的函數，它會執行必要的動作，並將設定值以Variant型態傳回。當您所指定的機碼或是設定值不存在時，您也可以指定讀取預設值。這個手法就像您使用Visual Basic內建的GetSetting函數一樣。
Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String, ByVal KeyType As Integer, _
Optional DefaultValue As Variant = Empty) As Variant
Dim handle As Long, resLong As Long
Dim resString As String, length As Long
Dim resBinary() As Byte
' Prepare the default result.
GetRegistryValue = DefaultValue
' Open the key，exit if not found.
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit Function
Select Case KeyType
Case REG_DWORD
' Read the value, use the default if not found.
If RegQueryValueEx(handle, ValueName, 0, REG_DWORD, _
resLong, 4) = 0 Then
GetRegistryValue = resLong
End If
Case REG_SZ
length = 1024: resString = Space$(length)
If RegQueryValueEx(handle, ValueName, 0, REG_SZ, _
ByVal resString, length) = 0 Then
' If value is found, trim excess characters.
GetRegistryValue = Left$(resString, length - 1)
End If
Case REG_BINARY
length = 4096
ReDim resBinary(length - 1) As Byte
If RegQueryValueEx(handle, ValueName, 0, REG_BINARY, _
resBinary(0), length) = 0 Then
ReDim Preserve resBinary(length - 1) As Byte
GetRegistryValue = resBinary()
End If
Case Else
Err.Raise 1001, , 'Unsupported value type"
End Select
RegCloseKey handle
End Function
您可以使用RegSetValueEx API函數來建立新的登錄設定值，或是更改已存在設定值的資料：
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" _
(ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _
ByVal cbData As Long) As Long
讓我們看看如何在之前所建立的HKEY_CURRENT_
USER\Software\YourCompany\YourApplication機碼中加入LastLogin設定值：
Dim handle As Long, strValue As String
' Open the key, check whether any error occurred.
If RegOpenKeyEx(HKEY_CURRENT_USER, "Software\YourCompany\YourApplication",_
0, KEY_WRITE, handle) Then
MsgBox "Unable to open the key."
Else
' We want to add a "LastLogin" value of type string.
strValue = FormatDateTime(Now)
' Strings must be passed using ByVal.
RegSetValueEx handle, "LastLogin", 0, REG_SZ, ByVal strValue, _
Len(strValue)
' Don't forget to close the key.
RegCloseKey handle
End If
在隨書光碟中，您可以找到SetRegistryValue函數的原始程式碼，它會根據您建立的設定值型態，自動選擇正確的語法。最後，使用RegDeleteValue API函數可以刪除之前已開啟機碼中的設定值：
Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA"_ (ByVal hKey As Long, ByVal lpValueName As String) As Long
列舉機碼及設定值
當瀏覽登錄資料庫時，您會時常需要列舉出某個機碼下面的所有機碼及設定值。
RegEnumKey函數可以讓您列舉機碼：
Private Declare Function RegEnumKey Lib "advapi32.dll" _
Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, _
ByVal lpName As String, ByVal cbName As Long) As Long
您必須在hKey引數中傳入一個已開啟機碼的handle，然後重覆呼叫這個函數，並在dwIndex引數中傳入遞增的索引值。lpName引數必須是最少260字元的字串緩衝區(機碼名稱最大長度)，而lpcbName是緩衝區的長度。當您離開這個常式，緩衝區會包含一個null結尾的字串，所以您必須刪除不必要的字元。為了讓您簡化工作，筆者準備一個函數，它會重複找出指定機碼中所有的子機碼，然後傳回一個包含所有子機碼名稱的字串陣列：
Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) _
As String()
Dim handle As Long, index As Long, length As Long
ReDim result(0 To 100) As String
' Open the key, exit if not found.
If Len(Keyname) Then
If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
Exit Function
End If
' Subsequent functions use hKey.
hKey = handle
End If
For index = 0 To 999999
' Make room in the array.
If index > UBound(result) Then
ReDim Preserve result(index + 99) As String
End If
length = 260 ' Max length for a key name.
result(index) = Space$(length)
If RegEnumKey(hKey, index, result(index), length) Then Exit For
' Trim excess characters.
result(index) = Left$(result(index), InStr(result(index), _
vbNullChar) - 1)
Next
' Close the key if it was actually opened.
If handle Then RegCloseKey handle
' Trim unused items in the array, and return the results to the caller.
ReDim Preserve result(index - 1) As String
EnumRegistryKeys = result()
End Function
幸虧有EnumRegustryKey函數，它讓我們很容易地從登錄資料庫中挖掘許多有用的資訊。例如，看看有多容易使用ListBox控制項來顯示所有在本機註冊的元件名稱，它們是在HKEY_CLASS_ROOT機碼下面：
Dim keys() As String, i As Long
keys() = EnumRegistryKeys(HKEY_CLASSES_ROOT, """".)
List1.Clear
For i = LBound(keys) To UBound(keys)
List1.AddItem keys(i)
Next
隨書光碟中包含一個範例程式 (如圖A-7)，它會顯示所有已安裝的COM元件，元件的CLSID以及包含這些元件的DLL或EXE檔案。您可以很容易地擴充這個第一版本來建立您自己的工具來追蹤登錄資料庫中的異常。例如您可以列出登錄資料庫中，所有未在指定位置出現的DLL及EXE檔案 (當您試圖建立這種元件實體時，COM會產生錯誤)。
| 圖A-7 您可以使用登錄資料庫API常式來列出所有安裝在機器上的元件，它們的CLSIDs以及執行檔的位置。 |
Windows API也提供一個函數，可以用來列舉出某個已開啟的機碼中所有設定值。
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" _
(ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As _
String, lpcbValueName As Long, ByVal lpReserved As Long, _
lpType As Long, lpData As Any, lpcbData As Long) As Long
在這個函數中，lpType存放每個設定值的型態，而lpData則存放這些設定值。困難的地方在於，您無法預先知道設定值的型態，因此不知道該在lpData傳入長整數，字串或是位元組陣列。解決的方式是先傳入一個位元組陣列，然後再把結果使用CopyMemory API常式搬到長整數變數中，或是使用VBA StrConv函數轉換成字串。在隨書光碟中可以發現EnumRegistryValues常式完整的程式碼，它封裝了這些細節，並且使用二維陣列來存放設定值的名稱及資料。例如，您可以使用這個常式來取得Microsoft Visual Basic組態設定：
Dim values() As Variant, i As Long
values() = EnumRegistryValues(HKEY_CURRENT_USER, _
"Software\Microsoft\VBA\Microsoft Visual Basic")
For i = LBound(values, 2) To UBound(values, 2)
' Row 0 holds the value's name, row 1 holds its value.
List1.AddItem values(0, i) & " = " & values(1, i)
Next
CALLBACK(回呼)及SUBCLASSING
您可能還記得在附錄剛開始的〈訊息的世界〉一小節中有提到，Windows處理兩種型態的訊息：控制訊息及通知訊息。儘管傳送控制訊息只需使用SendMessage API函數，您會發現要攔截一個通知訊息非常困難，而且必須採取進階的程式設計技巧，例如window subclassing。但是要嘹解這個技巧如何運作，您必須先知道AddressOf關鍵字是什麼意義，並且如何使用它來建立callback程序。
Callback技術
只有在Visual Basic 5以後的版本才具有CallBack及subclassing能力。在Visual Basic 5中引進了新的AddressOf關鍵字，才使得這些技術得以實現。這個關鍵字可以用在BAS模組中所定義常式名稱的開頭，來算出該常式中第一個陳述式的32位元位址。
系統計時器
為了要解釋這個關鍵字的意義，筆者將為您示範如何不使用Timer控制項而建立一個計時器。這樣的一個計時器可能會很有用，例如，在BAS模組中您必須週期性地執行一段程式，而您又不想只因為要取得時間間隔而加入一個表單時。要設定一個系統計時器只需使用一組API函數：
Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent_
As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, _
ByVal nIDEvent As Long) As Long
若只為了達到我們的要求，我們可以忽略SetTimer函數中前兩個引數，只需傳入uElapse (對應Timer控制項中的Interval屬性)，以及lpTimerFunc (在我們Visual Basic程式中常式的位址)。這種常式就是我們所稱的callback程序，因為它是由Windows呼叫，而不是由我們的應用程式來呼叫。SetTimer函數會傳回計時器的ID ，若發生錯誤則傳回0 ：
Dim timerID As Long ' Create a timer that sends a notification every 500 milliseconds. timerID = SetTimer(0, 0, 500, AddressOf Timer_CBK)
若您不想程式當掉，請記得在離開應用程式前先摧毀您所建立的計時器，此時會需要計時器的ID：
' Destroy the timer created previously. KillTimer 0, timerID
讓我們看看如何建立Timer_CBK callback程序。您可以從Windows SDK文件或是MSDN中找到Windows傳送到這個程序引數的型態：
Sub Timer_CBK(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal idEvent As Long, ByVal SysTime As Long)
' Just display the system time in a label control.
Form1.lblTimer = SysTime
End Sub
在本次的實作中，您可以安全地忽略前三個引數而專注在最後一個引數，它會接收到自系統開始後的毫秒數。這個callback常式不會傳回任何值，因此以程序來實作; 在稍後您會發現大多數的情況下，callback常式會傳回值給作業系統，也因此會以函數來實作。一如往常，您可以在隨書光碟中找到在這一小節中，所有範例程式的完整程式碼。
Windows列舉
使用EnumWindows及EnumChildWindows API函數可以建立出有趣又有用的範例，它們會分別地列舉出top-level視窗及所指定視窗的子視窗。這些函數所使用的方法正是大多數API函數列舉視窗物件的典型。這些函數在主程式中每個所找到的視窗使用了callback程序，而不是將所有視窗的清單載入到陣列或是其它的結構中。在callback函數的內部，您可以以任何方式來處理想要的資料，包含將資料載入到陣列或是ListBox，甚至是TreeView控制項中。這些函數的語法如下：
Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long
hWndParent是父視窗的handle。lpEnumFunc是callback函式的位址。而lParam是傳遞到callback函式的引數；這個值可以使用在同一應用程式中，具有不同用途的相同callback函數中。這個callback函數的語法與EnumWindows及EnumChildWindows相同：
Function EnumWindows_CBK(ByVal hWnd As Long, ByVal lParam As Long) As Long
' Process the window's data here.
End Function
hWnd是所找到視窗的handle，而lParam就是傳遞給EnumWindows及EnumChildWindows函數的最後一個引數。這個函數若傳回1則代表要求作業系統繼續列舉下個視窗，若傳回0則停止列舉作業。我們很容易可以使用這些API函數來建立出可重覆使用的程序，這個程序會將指定視窗的所有子視窗handle 存放到陣列中傳回：
' An array of Longs holding the handles of all child windows
Dim windows() As Long
' The number of elements in the array.
Dim windowsCount As Long
' Return an array of Longs holding the handles of all the child windows
' of a given window. If hWnd = 0, return the top-level windows.
Function ChildWindows(ByVal hWnd As Long) As Long()
windowsCount = 0 ' Reset the result array.
If hWnd Then
EnumChildWindows hWnd，AddressOf EnumWindows_CBK, 1
Else
EnumWindows AddressOf EnumWindows_CBK, 1
End If
' Trim uninitialized elements, and return to caller.
ReDim Preserve windows(windowsCount) As Long
ChildWindows = windows()
End Function
' The callback routine, common to both EnumWindows and EnumChildWindows
Function EnumWindows_CBK(ByVal hWnd As Long, ByVal lParam As Long) As Long
If windowsCount = 0 Then
' Create the array at the first iteration.
ReDim windows(100) As Long
ElseIf windowsCount >= UBound(windows) Then
' Make room in the array if necessary.
ReDim Preserve windows(windowsCount + 100) As Long
End If
' Store the new item.
windowsCount = windowsCount + 1
windows(windowsCount) = hWnd
' Return 1 to continue the enumeration process.
EnumWindows_CBK = 1
End Function
在隨書光碟中您可以找到這個應用程式(圖A-8)的原始碼，它會將目前系統所開啟的視窗以階層來顯示。底下是將視窗階層載入到TreeView控制項的程式碼，幸虧有遞迴技術，讓程式碼變得十分簡短。
Private Sub Form_Load()
ShowWindows TreeView1, 0, Nothing
End Sub
Sub ShowWindows(tvw As TreeView, ByVal hWnd As Long, ParentNode As Node)
Dim winHandles() As Long
Dim i As Long, Node As MSComctlLib.Node
If ParentNode Is Nothing Then
' If no Parent node, let's add a "desktop" root node.
Set ParentNode = tvw.Nodes.Add(, , , "Desktop")
End If
' Retrieve all the child windows.
winHandles() = ChildWindows(hWnd)
For i = 1 To UBound(winHandles)
' Add a node for this child window--WindowDescription is a routine
' (not shown here) that returns a descriptive string for the window.
Set Node = tvw.Nodes.Add(ParentNode.Index, tvwChild, , _
WindowDescription(winHandles(i)))
' Recursively call this routine to show this window's children.
ShowWindows tvw, winHandles(i), Node
Next
End Sub
| 圖A-8 一個用來顯示所有在系統中所有已開啟視窗的工具 |
Subclassing技術
現在您已經知道什麼是callback程序，相對地，要理解subclassing如何工作也會比較容易。
基本的subclassing
您已經知道Windows是使用訊息來達成應用程式間的溝通，但您還不知道在低階中這個機制是如何作用。每個視窗都會有附隨一個視窗預設程序(window default procedure)，一旦有何訊息傳到這個視窗時，這個程序就會被呼叫。這個程序假如寫成Visual Basic ，就會像下面的程式：
Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
...
End Function
這個視窗程序的四個引數，就恰好是您(或是作業系統) 傳送訊息給指定的視窗時，傳入給SendMessage函數的引數。這個程序的作用就是處理所有傳入的訊息，並作出適當的反應。每種Windows類別 - top-level視窗，MDI視窗，TextBox控制項，ListBox控制項等等─行為都不一樣，因為它們的視窗程序都不相同。
Subclassing技術的原則很簡單：您為指定視窗撰寫一個自訂的視窗程序，並且要求Windows呼叫您的視窗程序，來取代原始的標準視窗程序。
在Windows本身(更精確地說，就是視窗預設程序) 處理傳來的訊息之前，您的Visual Basic應用程式中的程式碼要能夠先捕捉到所有傳送到視窗的訊息，筆者用底下的圖例來說明：
要使用自訂程序來代替標準視窗程序，您必須使用SetWindowLong API函數，它會將自訂常式的位址存放到與每個視窗相關的內部資料表中。
Const GWL_WNDPROC = -4 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal ndx As Long, ByVal newValue As Long) As Long
hWnd是視窗的handle。ndx代表您想要將值儲存到內部資料表位置的索引。newValue是一個32-bit的值，它會存放在內部資料表中，ndx所指定的位置內。這個函數會傳回之前存放在資料表中同樣位置的值，您必須將這個值儲存到變數中，因為在應用程式結束或是subclassed視窗關閉前，還原這個值。若是您沒有還原原始視窗程序的位址，將有可能導致GPF。概括的說，要subclasses視窗，您最少需要下面的程式碼：
Dim saveHWnd As Long ' The handle of the subclassed window
Dim oldProcAddr As Long ' The address of the original window procedure
Sub StartSubclassing(ByVal hWnd As Long)
saveHWnd = hWnd
oldProcAddr = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End Sub
Sub StopSubclassing()
SetWindowLong saveHWnd, GWL_WNDPROC, oldProcAddr
End Sub
Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Process the incoming messages here.
End Function
讓我們把焦點放在到底自訂視窗程序實際上作了些什麼。這個程序不能只處理某些訊息，而忽略了其它的。相對地，它有責任將這些訊息轉交到原始的視窗程序; 否則，視窗將無法接收到某些極其重要的訊息，例如通知它何時要resize，close或是repaint自己。換句話說，假使視窗程序阻止所有的訊息到達原始視窗程序，應用程式將不再如預期工作。負責轉送訊息的API函數是CallWindowProc：
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
lpPrevWndFunc是原始視窗程序的位址─存放在oldProcAddr變數中的值─而其它的引數是那些在自訂程序中所接收的值。
讓我們看看一個使用subclassing技術的實際範例。當一個top-level的視窗(以Visual Basic說法，就是表單) 移動時，系統會傳給它一個WM_MOVE訊息。Visual Basic會即時吃下這個訊息，而不會以任何事件顯露給應用程式，但是您可以撰寫自訂的視窗程序在Visual Basic看到之前攔截這個訊息：
Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
' Send the message to the original window procedure, and then
' return to Windows the return value from the original procedure.
WndProc = CallWindowProc(oldProcAddr, hWnd, uMsg, wParam, lParam)
' See if this is the message we're waiting for.
If uMsg = WM_MOVE Then
' The window has moved.
End If
End Function
筆者準備了一個示範程式，它使用在本節所講解的程式，來捕捉表單的一些訊息，例如WM_MOVE，WM_RESIZING，以及WM_APPACTIVATE. (參閱圖A-9)。最後一個訊息是很重要的，它讓您判斷應用程式何時失去及獲得輸入駐點(input focus)，這在純Visual Basic並不容易達成。舉例而言，在圖A-8中的顯示視窗階層工具中，subclass這個訊息可以讓使用者切換到其它應用程式而又切換回來時，自動更新內容。
| 圖A-9 這個程式示範了視窗subclassing的基本概念 |
在呼叫CallWindowProc API函數的前或後，您可一般地處理傳入的訊息。若您只對訊息何時傳遞視窗感興趣，比較好的辦法是在Visual Basic常式處理完訊息後再捕捉它，因為您可以詢問被更新的表單屬性。請記住，Windows希望您傳回一個值給它，遵守這個要求最好的方法就是使用原始視窗程序傳回的值。假使您在訊息轉送到原始程序之前處理它，您可以改變wParam或lparam的值，但這個技術需要對Winodws內部有更深一層的認識。在這個時期發生的錯誤都是生死攸關的，因為它會讓Visual Basic應用程式不正常的運作。
注意
在Visual Basic所有的進階程式技術中，subclassing毫無疑問地是最危險的一個。假使您在自訂視窗程序中發生錯誤，Windows將不會給您任何機會修復它。因此，您應該在發展環境執行程式前，先儲存檔案。此外，您絕對不可使用「結束」按鈕來結束程式，這個動作將立即停止執行的程式，並且不會產生Unload及Terminate事件，因而使您喪失復原原始視窗程序的機會。
A class for subclassing
雖然之前版本的程式能夠完美無暇的運作，它並不符合現實世界應用程式的需求。原因很簡單：在一個複雜的應用程式中，您時常必須subclass多個的表單及控制項。這項工作產生了兩個有趣的問題：
這兩個問題最佳的解決辦法就是建立一個類別模組，它用來管理在程式中所有subclassing的例行工作。筆者已經製作了這樣的類別，名稱為MsgHook，您可以在隨書光碟中找到它。底下的程式片段擷取自原始碼：
' The MsgHook.cls class module
Event AfterMessage(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long, retValue As Long)
Private m_hWnd As Long ' Handle of the window being subclassed
' Start the subclassing.
Sub StartSubclass(ByVal hWnd As Long)
' Terminate current subclassing, if necessary.
If m_hWnd Then StopSubclass
' Store argument in member variable.
m_hWnd = hWnd
' Add a new item to the list of subclassed windows.
If m_hWnd Then HookWindow Me, m_hWnd
End Sub
' Stop the subclassing.
Sub StopSubclass()
' Delete this item from the list of subclassed windows.
If m_hWnd Then UnhookWindow Me
End Sub
' This procedure is called when a message is sent to this window.
' (It's Friend because it's meant to be called by the BAS module only.)
Friend Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long, _
ByVal oldWindowProc As Long) As Long
Dim retValue As Long, Cancel As Boolean
' Call original window procedure.
retValue = CallWindowProc(oldWindowProc, hWnd, uMsg, wParam, lParam)
' Call the application.
' The application can modify the retValue argument, if desired.
RaiseEvent AfterMessage(hWnd, uMsg, wParam, lParam, retValue)
' Return the value to Windows.
WndProc = retValue
End Function
' Stop the subclassing when the object goes out of scope.
Private Sub Class_Terminate()
If m_hWnd Then StopSubclass
End Sub
如您所見，這個類別透過AfterMessage事件來跟它的client端溝通，這個事件會在原始視窗程序處理完訊息後立刻發生。以client應用程式的觀點來看，subclassing視窗變成只是對單一個事件作處理，這動作對所有的Visual Basic程式設計人員來說都很熟悉。我們現在來分析在BAS模組的程式碼中，subclassing到底作了什麼。首先，您需要一個UDT的陣列用來存放被subclass的視窗資訊。
' The WndProc.Bas module
Type WindowInfoUDT
hWnd As Long ' Handle of the window being subclassed
oldWndProc As Long ' Address of the original window procedure
obj As MsgHook ' The MsgHook object serving this window
End Type
' This array stores data on subclassed windows.
Dim WindowInfo() As WindowInfoUDT
' This is the number of elements in the array.
Dim WindowInfoCount As Long
MsgHook類別的StartSubclass及StopSubclass方法分別呼叫HookWindow及UnhookWindow函數：
' Start the subclassing of a window.
Sub HookWindow(obj As MsgHook, ByVal hWnd As Long)
' Make room in the array, if necessary.
If WindowInfoCount = 0 Then
ReDim WindowInfo(10) As WindowInfoUDT
ElseIf WindowInfoCount > UBound(WindowInfo) Then
ReDim Preserve WindowInfo(WindowInfoCount + 9) As WindowInfoUDT
End If
WindowInfoCount = WindowInfoCount + 1
' Store data in the array, and start the subclassing of this window.
With WindowInfo(WindowInfoCount)
.hWnd = hWnd
Set .obj = obj
.oldWndProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WndProc)
End With
End Sub
' Stop the subclassing of the window associated with an object.
Sub UnhookWindow(obj As MsgHook)
Dim i As Long, objPointer As Long
For i = 1 To WindowInfoCount
If WindowInfo(i).obj Is obj Then
' We've found the object that's associated with this window.
SetWindowLong WindowInfo(i).hWnd, GWL_WNDPROC, _
WindowInfo(i).oldWndProc
' Remove this element from the array.
WindowInfo(i) = WindowInfo(WindowInfoCount)
WindowInfoCount = WindowInfoCount - 1
Exit For
End If
Next
End Sub
我們看看在BAS模組中最後一個程序，那就是自訂的視窗程序。這個程序會在WindowInfo陣列中尋找所接收訊息的目標視窗handle，並且會通知所對應的MsgHook類別實體有一個訊息抵達。
' The custom window procedure
Function WndProc(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
Dim i As Long, obj As MsgHook
Const WM_DESTROY = &H2
' Find this handle in the array.
For i = 1 To WindowInfoCount
If WindowInfo(i).hWnd = hWnd Then
' Notify the object that a message has arrived.
WndProc = WindowInfo(i)obj.WndProc(hWnd, uMsg, wParam, lParam,_
WindowInfo(i).oldWndProc)
' If it's a WM_DESTROY message, the window is about to close
' so there is no point in keeping this item in the array.
If uMsg = WM_DESTROY Then WindowInfo(i).obj.StopSubclass
Exit For
End If
Next
End Function
說明
前面的程式是使用線性方式在陣列搜尋視窗handle；在陣列還小的時候，這種方法還算快，並且不會增加類別的overhead。但當您有計劃subclass很多的表單及控制項時，應該使用較複雜的搜尋演算法，例如二分法(binary search)或是雜湊表(hash table)。
一般來說，視窗會一直被subclass，直到client應用程式呼叫相關MsgHook物件中的StopSubclass方法，或是這個物件本身超出範圍(請參考這個物件Terminate事件程序中的程式碼)。在WndProc程序使用一些小技巧來確保原始視窗程序會在視窗關閉前恢復。正因為它已經subclassing視窗，所以它可以捕捉到WM_DESTROY訊息，這是在視窗關閉前所送出的最後訊息(或至少是最後訊息中之一)。當偵測到這個訊息，程式會立即停止subclassing這個視窗。
使用MsgHook類別
使用MsgHook類別十分簡單：將它的引用指定給WithEvents變數，然後便可以呼叫它的StartSubclass方法來開始subclassing。例如，您可以使用底下的程式來捕捉WM_MOVE訊息：
Dim WithEvents FormHook As MsgHook
Private Sub Form_Load()
Set FormHook = New MsgHook
FormHook.StartSubclass Me.hWnd
End Sub
Private Sub FormHook_AfterMessage(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long, retValue As Long)
Const WM_MOVE = &H3
If uMsg = WM_MOVE Then
lblStatus.Caption = "The window has moved."
End If
End Sub
假使您想要subclass其它的表單或是控制項，您必須建立多個的MsgHook類別實體─每一個被subclass的視窗都需要一個─並且把它們指定給不同的WithEvents變數。當然，您必須在每個AfterMessage事件程序中撰寫適當的程式碼。在隨書光碟中完整的類別還提供一些額外的功能，包含BeforeMessage事件(會在原始視窗程序處理訊息前發生) 以及Enabled屬性(讓您暫時停止指定視窗的subclassing)。請記住，MsgHook類別只能subclass屬於目前應用程式中的視窗; 不同行程間的視窗subclassing已經超出了Visual Basic的能力，此時就需要一些C/C++ 的魔法。
MsgHook類別模組封裝了subclassing技術中大部分具危險性的細節。當您將它轉成ActiveX DLL元件 - 或是使用隨書光碟中的版本－您可以安全地subclass任何由目前應用程式所建立的視窗。您甚至可以停止直譯的程式，而不用擔心有不良的影響，因為假使類別已經在不同元件中被編譯， 結束 按鍵並不能阻止Terminate事件發生。編譯過的版本也解決大多數(不是全部) 當直譯程式進入中斷模式，而subclassing程式無法對應到訊息時的問題。在這種情況下，通常會造成應用程式停止，但是MsgHook會避免這種情形發生。筆者計劃公佈一個這個類別更完整的版本，使用者可由
http://www.vb2themax.com 網站上取得。
更多subclassing的範例
現在您有了一個實作subclassing核心細節的工具，您最後可能希望看看subclassing如何幫助您發展出更好的應用程式。在本節中筆者所展現的範例只是為了指點您如何使用這項強大的技術。事實上，您會發現在本節中所講解的程式都是在隨書光碟中所提供的一個範例應用程式中。這個範例應用程式如圖A-10。
| 圖A-10 這個範例程式告訴您，使用MsgHook ActiveX DLL您可以做些什麼。 |
Windows會傳送很多的訊息到Visual Basic表單中，這些訊息是沒有在Visual Basic執行時以事件來呈現的。有時候您不需運用到傳進的引數，因為您subclassing這個表單只是為了要找出有哪些訊息抵達。這類的訊息範例有很多，包含WM_MOUSEACTIVATE。(當滑鼠啟動表單或是控制項時)，WM_TIMECHANGE (當系統日期或時間被更改時)，WM_DISPLAYCHANGE (當螢幕解析度被更改時)，WM_COMPACTING (當Windows記憶體不足，並且要求應用程式盡可能釋放出記憶體時)，以及WM_QUERYOPEN (當表單從圖示還原成正常大小時)。
儘管如此，有很多其的訊息不能像這麼容易的處理。例如：當使用者開始移動或是更改大小視窗時，會傳送WM_GETMINMAXINFO訊息到視窗。當這個訊息抵達，lParam包含MINMAXINFO結構的位址，它包含了關於表單可移動的區域以及視窗可接受最大最小長寬的資訊。您可以取得以及更改這些資料，因而可以在使用者更改視窗大小或是最大化時，有效率地控制表單的大小以及位置。(假使您小心地觀察圖A-10，會發現即使這個表單沒有佔滿整個螢幕，但標題旁的按鈕還是顯示最大化。)要將這些資訊搬到本地的結構中，您可以使用CopyMemory API函數：
Type POINTAPI
X As Long
Y As Long
End Type
Type MINMAXINFO
ptReserved As POINTAPI
ptMaxSize As POINTAPI
ptMaxPosition As POINTAPI
ptMinTrackSize As POINTAPI
ptMaxTrackSize As POINTAPI
End Type
Private Sub FormHook_AfterMessage(ByVal hWnd As Long, ByVal uMsg As Long, _
ByVal wParam As Long, ByVal lParam As Long, retValue As Long)
Select Case uMsg
Case WM_GETMINMAXINFO
' Windows is querying the form for its
' minimum and maximum size and position.
Dim mmInfo As MINMAXINFO
' Read contents of structure pointed to by lParam.
CopyMemory mmInfo, ByVal lParam, Len(mmInfo)
With mmInfo
' ptMaxSize is the size of the maximized form.
.ptMaxSize.X = 600
.ptMaxSize.Y = 400
' ptMaxPosition is the position of the maximized form.
.ptMaxPosition.X = 100
.ptMaxPosition.Y = 100
' ptMinTrackSize is the minimum size of a form when
' resized with the mouse.
.ptMinTrackSize.X = 300
.ptMinTrackSize.Y = 200
' ptMinTrackSize is the maximum size of a form when
' resized with the mouse (usually equal to ptMaxSize).
.ptMaxTrackSize.X = 600
.ptMaxTrackSize.Y = 400
End With
' Copy the data back into the original structure in memory.
CopyMemory ByVal lParam, mmInfo, Len(mmInfo)
' Return 0 to say that the structure has been modified.
retValue = 0
End Select
End Sub
藉由subclassing WM_MENUSELECT訊息，可以為您的應用程式加入專業的風格。這個訊息發生在當使用者使用滑鼠或上下鍵反白一個功能表項目時，而您可以使用它來顯示一個簡短說明，就像大多數的商業應用程式 (請參照圖A-10)
使用這個訊息的困難在於您必須處理存放在wParam及lParam的值，來取得反白功能表項目的標題：
' Put this code inside a FormHook_AfterMessage event procedure.
Case WM_MENUSELECT
' The menu item identifier is in the low-order word of wParam.
' The menu handle is in lParam.
Dim mnuId As Long, mnuCaption As String, length As Long
mnuId = (wParam And &HFFFF&)
' Get the menu caption.
mnuCaption = Space$(256)
length = GetMenuString(lParam, mnuId, mnuCaption, Len(mnuCaption), 0)
mnuCaption = Left$(mnuCaption, length)
Select Case mnuCaption
Case "&New"
lblStatus.Caption = "Create a new file"
Case "&Open"
lblStatus.Caption = "Open an existing file"
Case "&Save"
lblStatus.Caption = "Save a file to disk"
Case "E&xit"
lblStatus.Caption = "Exit the program"
End Select
表單在許多時機會接收到WM_COMMAND訊息，它是一個多用途的訊息 - 例如，當功能表被選取或是當控制項傳遞給表單一個通知訊息時。在TextBox控制項的編輯區域被捲動時，您可以捕捉它傳遞給所屬表單的EN_HSCROLL及EN_VSCROLL通知訊息：
' Put this code inside a FormHook_AfterMessage event procedure.
Case WM_COMMAND
' If this is a notification from a control, lParam holds its handle.
If lParam = txtEditor.hwnd Then
' In this case, the notification message is in the
' high-order word of wParam.
Select Case (wParam \ &H10000)
Case EN_HSCROLL
' The TextBox control has been scrolled horizontally.
Case EN_VSCROLL
' The TextBox control has been scrolled vertically.
End Select
End If
當然，您可以subclass任何具有hWnd屬性的控制項，不光只是表單。例如，TextBox會在使用者在它上面按下滑鼠右鍵時接收到WM_CONTEXTMENU訊息。這個訊息的預設動作是顯示預設的編輯快顯功能表，但您可以subclass TextBox控制項來阻止這個動作，如此一來便可以顯示您自訂的快顯功能表 (請比較第三章中 〈快顯功能表〉 中所使用的技巧)。要達到這個結果，您必須在BeforeMessage事件程序中撰寫程式，並且將程序中的Cancel引數設定為False來要求MsgHook類別不要執行原始視窗程序(這是少數幾個的安全例子之一)。
Dim WithEvents TextBoxHook As MsgHook
Private Sub Form_Load()
Set TextBoxHook = New MsgHook
TextBoxHook.StartSubclass txtEditor.hWnd
End Sub
Private Sub TextBoxHook_BeforeMessage(hWnd As Long, uMsg As Long, _
wParam As Long, lParam As Long, retValue As Long, Cancel As Boolean)
If uMsg = WM_CONTEXTMENU Then
' Show a custom popup menu.
PopupMenu mnuMyCustomPopupMenu
' Cancel the default processing (i.e. the default context menu).
Cancel = True
End If
End Sub
附錄花去您十分長的時間來探索API的領域。但正如筆者在一開始所講的，這幾頁只是大概地描述Windows API函數所能帶給您的無限威力，特別是將它與subclassing結合在一起時。在隨書光碟中的MsgHook類別是一個可以用來探索這些功能非常好的工具，因為您不必去擔心實作時的細節，而可以專心於那些達成您所感興趣效果的程式碼。
假使您想要學習更多關於API的技術，筆者建議您去找本書，例如Dan Appleman所著的《Visual Basic Programmer's Guide to the Win32 API》。您手邊也需隨時準備Microsoft Developer Network來取得Windows所提供眾多函數的官方說明文件。一旦您對API程式寫作很有經驗，您會發現幾乎沒有什麼事是Visual Basic不能達到的。