精华区文章阅读

发信人: bloom (├┝┞┟┠┢┣�), 信区: VB
标  题: VB API教程（王国荣版）（四）(转载)
发信站: 哈工大紫丁香 (2000年09月07日18:42:49 星期四), 转信

【以下文字转载自 cnTemp 讨论区】
【原文由 bloom 所发表】
发信人: Love1976 (狄飞惊), 信区: VisualBasic
发信站: BBS 水木清华站 (Thu Apr  6 04:20:32 2000)

发信人: coolknight (酷骑士~找工作中), 信区: VB
标  题: VB 與 Windows API 講座(四)
发信站: 武汉白云黄鹤站 (Tue Nov  9 20:07:52 1999), 站内信件

VB 與 Windows API 講座(四)
VB 無解問題與 API 的解決方案
------------------------------------------------------------------------
----
----
　王國榮
上一期介紹 Windows 的訊息系統，對有些讀者來說可能比較艱澀(或者說比較無
趣)，
這是筆者想極力避免卻又無法避免的事情，畢竟訊息的觀念在 Windows API 的程
式設
計中是不可或缺的，以本期所提出的 15 則問題，就有 2 則的解決方案與訊息有
關係
。除了訊息的應用之外，由於本期預定刊載於 Run!PC 2 月號，屬於新春期間，
筆者
想來點輕鬆而又實用的東西，所以特別挑選讀者問過而 VB 無法解決的問題，以
Wind
ows API 來加以解決，除了第 4 則與第 15 則之外，這些解決方案大抵上沒有太
艱澀
的技術，您只要跟著筆者所介紹的方法，就可以將它們應用於您的 VB 程式中。

問題1：我只是想將檔案丟到「資源回收筒」，而不是從硬碟中刪除。
問題2：如何複製整個目錄(包含子目錄及其所有檔案)？
問題3：如何快速改變檔案的所在目錄？
問題4：如何讓 TextBox 在按下滑鼠右鈕時不顯示快顯功能表？
問題5：如何讀取 Windows 的所在目錄？
問題6：如何將程式建立成「啟動」資料夾的捷徑？
問題6：如何將程式建立成「啟動」資料夾的捷徑？
問題7：如何啟動 Windows 預設的執行檔開啟某一文件？
問題8：如何在啟動某一個程式之後，等待此一程式結束執行後才繼續執行。
問題9：在多行的 TextBox 中，如何計算行數？
問題10：如何判斷某一個 Drive 是否為光碟機？
問題11：如何讀取檔案的建立時間及存取時間？
問題12：如何以程式控制多行 TextBox 的捲動？
問題13：如何像一般的繪圖軟體一樣填滿某一區域的顏色？
問題14：如何讀取磁碟的空間及可用空間？
問題15：將表單縮小時，希望它的圖示顯示在工作列的右下角。
閱讀本文以前：
------------------------------------------------------------------------
----
----
在 Windows API 的呼叫過程中，我們必須事先宣告所呼叫的 API 函數及其相關
常數、
自訂型別，但這些宣告式通常是又臭又長，有礙閱讀，所以筆者把它們集中放在
最後
的附錄，當然，為了方便您引用，這些宣告式亦收錄於筆者的網站，請自行下
載。此
外，本文討論的所有問題也都附有範例程式，一樣包含在下載的檔案中。
　
問題1：我只是想將檔案丟到「資源回收筒」，而不是從硬碟中刪除。
------------------------------------------------------------------------
----
----
　
這個絕對不能呼叫 VB 所提供的 Kill 敘述， Kill 敘述只會將檔案從磁碟中刪除
，若
這個絕對不能呼叫 VB 所提供的 Kill 敘述， Kill 敘述只會將檔案從磁碟中刪除
，若
要將檔案丟到資源回收筒，必須呼叫 SHFileOperation API 函數，假設我們想
將 c:
\test.txt 丟到資源回收筒，則呼叫的敘述如下：
　
Dim SHFileOp As SHFILEOPSTRUCT
　
SHFileOp.wFunc = FO_DELETE

SHFileOp.pFrom = "c:\test.txt" + Chr(0)
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
　
在以上敘述中有幾件值得注意的事情：
　
FOF_ALLOWUNDO 表示被刪除的檔案將來可以還原，此一設定值是絕對必要的。
FOF_NOCONFIRMATION 表示不顯示交談窗詢問使用者「是否將檔案丟到資源回收筒
」，若
要詢問使用者，則應取消此一設定值。
請注意 "c:\test.txt" 之後必須加上 Chr(0)。
　
利用以上方法也可以一次刪除多個檔案，此時只要將多個檔案名稱串在一起，並
且以
Chr(0) 分隔即可，假設我們想刪除 c:\test1.txt、c:\test2.txt、及 c:
\test3.txt
等三個檔案，則程式如下：
　
Dim SHFileOp As SHFILEOPSTRUCT
Dim SHFileOp As SHFILEOPSTRUCT
Dim Files As String
Files = "c:\test1.txt" + Chr(0) + "c:\test2.txt" + Chr(0) + "c:\test3.
txt" +
Chr(0)
SHFileOp.wFunc = FO_DELETE
SHFileOp.pFrom = Files
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
　
問題2：如何複製整個目錄(包含子目錄及其所有檔案)？
------------------------------------------------------------------------
----
----
　
如果使用 VB 所提供的功能，必須使用的敘述及函數大致上有 Dir、Mkdir、及
FileC
opy 等幾個，而所需撰寫的程式也不算簡單，在此就不做介紹，若呼叫
SHFileOper
ation API，則只需短短的幾行，假設我們想將 c:\temp 目錄的所有檔案(包含
其子目
錄)複製到 c:\temp2 目錄底下，則程式如下：
　
Dim SHFileOp As SHFILEOPSTRUCT
　
SHFileOp.wFunc = FO_COPY
SHFileOp.pFrom = "c:\temp\*.*"
SHFileOp.pTo = "c:\temp2\*.*"
SHFileOp.pTo = "c:\temp2\*.*"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR
Call SHFileOperation(SHFileOp)
　
在以上敘述中請注意一件事情：FOF_NOCONFIRMMKDIR 表示不顯示交談窗詢問使用
者「是
否建立目錄」，如果取消此一設定值，而當 SHFileOp.pTo 所指定的目錄不存在
時，
則 Windows 會詢問使用者是否建立目錄。(SHFileOp.pTo = "c:\temp2\*.*" 寫成
SHF
ileOp.pTo = "c:\temp2 亦可)
　
問題3：如何快速改變檔案的所在目錄？
------------------------------------------------------------------------
----
----
　
當我們想改變某一個檔案的所在目錄，若使用 VB 所提供的功能，必須先執行
FileC
opy 將檔案複製到另一個目錄，然後才將原檔案刪除，例如：
　
FileCopy Path1 & FileName, Path2 & FileName
Kill Path1 & FileName
　
此一方法對於比較大的檔案(假設是 100MB)，十分浪費時間，若使用
SHFileOperati
on API 函數，則可以不必複製檔案，而直接將檔案移至另一個目錄，方法如下
：(假
設將 c:\test4.txt 移至 c:\temp 目錄)
　
　
Dim SHFileOp As SHFILEOPSTRUCT
　
SHFileOp.wFunc = FO_MOVE
SHFileOp.pFrom = "c:\test4.txt" + Chr(0)
SHFileOp.pTo = "c:\temp"
SHFileOp.fFlags = FOF_ALLOWUNDO + FOF_NOCONFIRMATION
Call SHFileOperation(SHFileOp)
　
在以上敘述中有幾件值得注意的事情：
　
SHFileOp.pTo 所指定的參數必須是一個已存在的目錄。
檔案可以移到另一個磁碟機，但它的作用相當於複製檔案，再把原檔案刪除，唯
有在
同一磁碟中移動才具有快速移動的效果。
如果想一次移動多個檔案，請參閱本文「問題 1」的說明。
　
問題4：如何讓 TextBox 在按下滑鼠右鈕時不顯示快顯功能表？
------------------------------------------------------------------------
----
----
　
當我們在 TextBox 上面按下滑鼠右鈕時， TextBox 總是會顯示含有「復原、剪下
、複
製、貼上…」的快顯功能表，如何叫 TextBox 不要這麼做呢？
　
　
這個問題有點難，必須利用我們上一期介紹的「視窗程序的插隊遊戲」。為了不
讓 Te
xtBox 顯示預設的快顯功能表，我們必須利用插隊的視窗程序將
WM_RBUTTONDOWN(表示
Right Button Down)訊息吃掉，在製作的細節上，則包含以下幾點：
　
1. 設定插隊的視窗程序：假設 TextBox 的名稱為 Text1，而我們所撰寫的視窗
程序名
稱為 WndProc，則如下：
　
Dim ret As Long
prevWndProc = GetWindowLong(Text1.hWnd, GWL_WNDPROC)
ret = SetWindowLong(Text1.hWnd, GWL_WNDPROC, AddressOf WndProc)
　
2. 視窗程序的撰寫：
　
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam
As Long
, ByVal lParam As Long) As Long
If Msg = WM_RBUTTONDOWN Then
' 吃掉這個訊息
Else
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End If
End Function
　
　
當以上視窗程序收到 WM_RBUTTONDOWN 訊息時，不再呼叫 CallWindowProc，所以
Tex
tBox 便不會收到「按下滑鼠右鈕」的訊息，也就不會顯示預設的快顯功能表。
　
3. 取消插隊行為：
　
' prevWndProc 是插隊時所儲存下來的前一個視窗程序的位址
ret = SetWindowLong(Text1.hWnd, GWL_WNDPROC, prevWndProc)
　
使用以上解決方案請特別注意，由於我們的程式把 WM_RBUTTONDOWN 訊息吃掉了
，因此
當使用者按下滑鼠「右鈕」時， TextBox 也不會發生 MouseDown 事件，這將使
得 Te
xt1_MouseDown 事件程序中的程式只有在使用者按下滑鼠「左鈕」時才會被執行，
此時
的解決方案是在 WndProc 視窗程序收到 WM_RBUTTONDOWN 訊息時呼叫
Text1_MouseDow
n 事件程序，如下：
　
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam
As Long
, ByVal lParam As Long) As Long
If Msg = WM_RBUTTONDOWN Then
Call Text1_MouseDown( 參數… )
Else
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End If
End Function
End Function
　
問題5：如何讀取 Windows 的所在目錄？
------------------------------------------------------------------------
----
----
雖然 Windows 安裝的預設目錄是 "c:\Windows"，但由於使用者可以自由設定
Windows
安裝的目錄，所以不能假設 "c:\Windows" 是 Windows 的所在目錄，要讀取
Windo
ws 的所在目錄，需利用 GetWindowsDirectory API 函數，以下是呼叫的例子：

　
Dim S As String * 80, Length As Long
Dim WinPath As String
　
Length = GetWindowsDirectory(S, Len(S))
WinPath = Left(S, Length)
　
則執行之後 WinPath 將等於 Windows 的所在目錄。
　
問題6：如何將程式建立成「啟動」資料夾的捷徑？
------------------------------------------------------------------------
----
----
　
想要建立捷徑，使用 Windows API 比較麻煩，因此筆者想藉助一個附屬於 VB
的 DL
L 檔案 ─ vb5stkit.dll(如果是 VB 4.0 32-bit 版，則為 stkit432.dll)，在
安裝有
L 檔案 ─ vb5stkit.dll(如果是 VB 4.0 32-bit 版，則為 stkit432.dll)，在
安裝有
VB 的機器裡面，此一檔案會出現在 Windows 的 System 目錄底下，此外，在
VB 的
setupkit\kitfil32 目錄底下也有這一個檔案。在 vb5stkit.dll 裡面有一個叫
做 fC
reateShellLink 的函數，可用來建立「捷徑」(ShortCut)，此一函數含有 4 個
參數，
意義如下：
　
1. folder：資料夾，此一參數雖然稱為資料夾，但與磁碟的資料夾(目錄)略有出
入，
它的根目錄("\")表示「開始」工具列底下的「程式集」資料夾，而 ".." 表示「
開始
」工具列， "..\.." 表示 Windows 的所在目錄。
2. ShortCutName：捷徑名稱。
3. ExePath：程式或檔案的完整路徑。
4. Params：參數三 ExePath 的程式參數。
　
假設我們想把 "c:\Windows\Notepad.exe" 執行檔設定成「啟動」資料夾名稱為
"記事
本" 的捷徑，則呼叫的方式如下：
　
ret = fCreateShellLink("\啟動", "記事本", "c:\Windows\Notepad.exe",
"")
　
在以上程式中參數一 folder 最值得注意，由於「啟動」資料夾是「程式集」的
子資料
夾，所以將此一參數寫成 "\啟動"，再舉個例子，假設我們想把同樣的捷徑建立
在「
桌面」上，則此一參數應設定為 "..\..\Desktop"(NT 中文版則為 "..\..\桌面
")，因
為 "..\.." 代表 Windows 的所在目錄，而所謂「桌面」其實就是 Windows 底下
的 D
esktop(桌面)子資料夾，所以將此一參數寫成 "..\..\Desktop"("..\..\桌面")
。
esktop(桌面)子資料夾，所以將此一參數寫成 "..\..\Desktop"("..\..\桌面")
。
　
除了 4 個參數之外， fCreateShellLink 的傳回值表示「是否成功地建立了捷徑
」，如
果等於 1，表示成功，等於 0，表示失敗。
　
在 VB5 裡面使用 fCreateShellLink，必須撰寫的 API 宣告式如下：
　
Declare Function fCreateShellLink Lib "vb5stkit.DLL" (ByVal folder As
String
, ByVal ShortCutName As String, ByVal ExePath As String, ByVal Params As
Str
ing) As Long
　
但如果您使用的是 VB4 32-bit 版，則必須將以上的 vb5stkit.dll 改成
stkit432.d
ll。最後請注意， vb5stkit.dll(stkit432.dll) 不是 Windows 所提供 API 函數
，呼
叫之前，必須將此一檔案複製到 Windows、Windows 的 System 目錄、或應用程
式所在
目錄，但如果您使用 VB 的「安裝精靈」安裝應用程式，則「安裝精靈」會自動
複製此
一檔案到 Windows 的 System 目錄。
　
為了讓您進一步體驗 fCreateShellLink 函數的使用，筆者特別準備了如圖-1的
表單(
放置於範例程式的 Form3)：
　
圖-1 筆者所撰寫的 fCreateShellLink 試驗程式
　
您可以利用此一表單設定不同的參數(參數與表單上各欄位的對應如圖-1之標示)，
然後
您可以利用此一表單設定不同的參數(參數與表單上各欄位的對應如圖-1之標示)，
然後
檢測建立捷徑的情況，檢測時，筆者必須說明的是，呼叫建立
fCreateShellLink 之
後，再按下「開始」工具列時，被建立的捷徑不一定會馬上出現在其中，這是
因為「
開始」工具列未即時更新的緣故，但您可以利用檔案總管功能表的「檢視/重新整
理」讓
「開始」工具列立即更新。
　
附帶說明：中文 Windows 的「啟動」資料夾名稱是 "啟動"，但英文 Windows 卻
是 "
StartUp"，而不同語言的 Windows 可能又所不同，「桌面」的情況亦然，因此
如果您
要在「啟動」資料夾中或「桌面」上建立捷徑，必須考慮不同語言的問題。
　
問題7：如何啟動 Windows 預設的執行檔開啟某一文件？
------------------------------------------------------------------------
----
----
　
舉例來說， .txt 的文件希望用「記事本」開啟、.doc 的文件用 Word 開啟、.
bmp 的
文件用「小畫家」開啟…，就好像利用「檔案總管」開啟文件一樣。
　
當我們想在 VB 程式中執行某一個程式時，最簡單的方法是呼叫 Shell 敘述，例
如「
Shell "Notepadc:\test.txt"」，但 Shell 敘述必須指定好執行檔，所以並不適
用於
此一問題。想要像檔案總管一樣開啟文件，需呼叫 ShellExecute API 函數，先
舉個
簡單的例子，假設想開啟 c:\Windows 目錄的 general.txt 文件，則方法如下
：
　
Call ShellExecute(Me.hwnd, "open", "c:\Windows\general.txt", "", "",
SW_SHOW
Call ShellExecute(Me.hwnd, "open", "c:\Windows\general.txt", "", "",
SW_SHOW
)
　
以上敘述筆者省略了參數四及參數五，其中參數四表示傳遞給執行檔的參數，但
由於此
一 ShellExcute 敘述已經是用來開啟文件，所以此一參數通常設定為 ""，參數
五則
表示工作目錄，若設定為 ""，則以文件的所在目錄為工作目錄。此外，參數六
表示文
件開啟後顯示的方式， SW_SHOW 表示正常大小，若設定成 SW_SHOWMINIMIZED，
則以最
小化的視窗來顯示，若設定成 SW_SHOWMAXIMIZED，則以最大化的視窗來顯示。

　
問題8：如何在啟動某一個程式之後，等待此一程式結束執行後才繼續執行。
------------------------------------------------------------------------
----
----
　
當我們呼叫 Shell 時，會傳回一個數值，此一數值稱為 Process Id，利用此
一 Pr
ocess Id，我們可以呼叫 OpenProcess API 取得 Process Handle，然後再利用
Pro
cess Handle 呼叫 WaitForSingleObject，即可等待被 Shell 執行的程式執行完
畢後
，才繼續向下執行。程式如下：(以執行 Notepad 程式為例)
　
Dim pId As Long ' 宣告 Process Id 變數
Dim pHndn As Long ' 宣告 Process Handle 變數
pId = Shell("Notepad", vbNormalFocus) ' Shell 傳回 Process Id
pHnd = OpenProcess(SYNCHRONIZE, 0, pId) ' 取得 Process Handle
If pHnd <> 0 Then
If pHnd <> 0 Then
Call WaitForSingleObject(pHnd, INFINITE) ' 無限等待，直到程式結束
Call CloseHandle(pHnd)
End If
　
至於程式的工作原理，由於故事很長，原諒筆者暫時不做進一步的解說。使用此
一方
法時，請特別注意，在等待的時候，原來的程式是完全不能操作的，因此筆者
建議在
呼叫 WaitForSingleObject 之前，先將原程式的視窗隱藏起來，直到等待結束
時(也
就是 WaitForSingleObject 之後)，才重新顯示視窗。
　
問題9：在多行的 TextBox 中，如何計算行數？
------------------------------------------------------------------------
----
----
　
這個問題如果不使用 Windows API，使用 VB，則方法如下：
　
Dim S As String, N As Integer, pos As Integer
S = Text1.Text
pos = InStr(S, vbCr + vbLf) ' vbCr + vbLf 為 TextBox 的斷行字元
While pos > 0
N = N + 1
S = Mid(S, pos + 2)
pos = InStr(S, vbCr + vbLf)
pos = InStr(S, vbCr + vbLf)

Wend
N = N + 1
' N 即等於 Text1 的行數
　
但以上程式遇到 TextBox 行數很多時，執行效能會比較差一點，因此可以考慮
使用以
下的 API 方法：
　
Dim N As Long
N = SendMessage(Text1.hwnd, EM_GETLINECOUNT, 0, ByVal 0&)
' N 即等於 Text1 的行數
　
問題10：如何判斷某一個 Drive 是否為光碟機？
------------------------------------------------------------------------
----
----
　
須呼叫 Windows API 的 GetDriveType 函數，假設我們想判斷 "D:" 碟是否為光
碟機
，則方法如下：
　
DriveType = GetDriveType ( "D:\")
If DriveType = DRIVE_CDROM Then ' 表示光碟機
　
請注意 GetDriveType 的參數不可以寫成 "D" 或 "D:"，必須寫成 "D:\"。
GetDriveTy
請注意 GetDriveType 的參數不可以寫成 "D" 或 "D:"，必須寫成 "D:\"。
GetDriveTy
pe 除了可以用判斷光碟機之外，以下是各種傳回值的意義：
　
傳回值意義
0 無從判斷
1 根目錄不存在
DRIVE_REMOVABLE(= 2) 可移式磁碟，例如軟碟
DRIVE_FIXED(= 3) 硬碟
DRIVE_REMOTE(= 4) 遠端(網路)儲存裝置
DRIVE_CDROM(= 5) 光碟機
DRIVE_RAMDISK(= 6) RAM Disk
　
如果我們想列舉出所有磁碟機的類型，則可先在表單上佈置一個 DriveListBox(
假設它
的名稱是 Drive1) 控制元件，然後再利用以下程式列舉：
　
Dim dTypeStr(0 To 6) As String, dType As Long
　
dTypeStr(0) = "無從判斷" : dTypeStr(1) = "根目錄不存在"
dTypeStr(2) = "軟碟" : dTypeStr(3) = "硬碟"
dTypeStr(4) = "遠端(網路)儲存裝置"
dTypeStr(5) = "光碟機" : dTypeStr(6) = "RAM Disk"
For I = 0 To Drive1.ListCount - 1
Drv = Left(Drive1.List(I), 2) & "\"
Drv = Left(Drive1.List(I), 2) & "\"
dType = GetDriveType(Drv)
Debug.Print Drv & " is " & dTypeStr(dType)
Next
　
問題11：如何讀取檔案的建立時間及存取時間？
------------------------------------------------------------------------
----
----
　
如果我們利用 VB 所提供的 FileDateTime 來讀取檔案的時間，則所得到的是檔
案最後
一次被修改的時間，但是當我們利用檔案總管來檢視某一個檔案時，除了檔案「
修改時
間」之外，卻還可以看到檔案的「建立時間」與「存取時間」，如圖-2。
　
圖-2 檔案總管所顯示的檔案內容除了「修改時間」之外，還有「建立時間」與「
存取時
間」。
　
想要進一步讀取檔案的相關資訊，必須先呼叫 API 函數的 OpenFile 取得檔案的
Han
dle，然後再利用 Handle 呼叫 GetFileInformationByHandle 讀取檔案的相關資
訊，
而在讀取的檔案相關資訊中便含有檔案建立、修改、及存取時間，程式執行過程
如下：
(假設想讀取的檔案是 "c:\autoexec.bat")
　
Dim FileHandle As Long
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Dim FileInfo As BY_HANDLE_FILE_INFORMATION
Dim lpReOpenBuff As OFSTRUCT, ft As SYSTEMTIME
Dim tZone As TIME_ZONE_INFORMATION
　
Dim dtCreate As Date ' 建立時間
Dim dtAccess As Date ' 存取日期
Dim dtWrite As Date ' 修改時間
Dim bias As Long
　
' 先取得 autoexec.bat 的 File Handle
FileHandle = OpenFile("c:\autoexec.bat", lpReOpenBuff, OF_READ)
' 利用 File Handle 讀取檔案資訊
Call GetFileInformationByHandle(FileHandle, FileInfo)
Call CloseHandle(FileHandle)
　
' 讀取 Time Zone 資訊，因為上一步驟的檔案時間是「格林威治」時間
Call GetTimeZoneInformation(tZone)
bias = tZone.bias ' 時間差，以「分」為單位
　
Call FileTimeToSystemTime(FileInfo.ftCreationTime, ft) ' 轉換時間資料結
構
dtCreate = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + TimeSerial(ft.
wHour, f
t.wMinute - bias, ft.wSecond)
Call FileTimeToSystemTime(FileInfo.ftLastAccessTime, ft)
Call FileTimeToSystemTime(FileInfo.ftLastAccessTime, ft)
dtAccess = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + TimeSerial(ft.
wHour, f
t.wMinute - bias, ft.wSecond)
Call FileTimeToSystemTime(FileInfo.ftLastWriteTime, ft)
dtWrite = DateSerial(ft.wYear, ft.wMonth, ft.wDay) + TimeSerial(ft.
wHour, ft
.wMinute - bias, ft.wSecond)
　
執行以上程式所得到的 dtCreate、dtWrite、及 dtAccess 變數，即分別為檔案
建立、
修改、及存取時間。
　
問題12：如何以程式控制多行 TextBox 的捲動？
------------------------------------------------------------------------
----
----
　
首先請回顧問題-9的程式，在問題-9 的程式中，我們利用 SendMessage 傳送
EM_GE
TLINECOUNT 訊息給 TextBox，而 TextBox 收到訊息時，會判斷訊息的編號，然
後計
算行數並且回傳，此一工作模式，我們可以把傳送給 TextBox 的訊息當成對
TextBo
x 所下的指令，而對於控制 TextBox 的捲動來說，所傳送的訊息(下達的指令)
是 EM
_LINESCROLL，程式則如下：
　
Dim N As Long
Call SendMessage(Text1.hwnd, EM_LINESCROLL, 0&, ByVal N ) ' 下捲N行
Call SendMessage(Text1.hwnd, EM_LINESCROLL, 0&, ByVal -N ) ' 上捲N行
Call SendMessage(Text1.hwnd, EM_LINESCROLL, 0&, ByVal -N ) ' 上捲N行
Call SendMessage(Text1.hwnd, EM_LINESCROLL, N, ByVal 0&) ' 右捲N列
Call SendMessage(Text1.hwnd, EM_LINESCROLL, -N, ByVal 0&) ' 左捲N列
　
舉例來說，想要上捲 5 行右捲 3 列，呼叫的敘述如下：
　
Call SendMessage(Text1.hwnd, EM_LINESCROLL, 3&, ByVal -5& )
　
問題13：如何像一般的繪圖軟體一樣填滿某一區域的顏色？
------------------------------------------------------------------------
----
----
　
想要把某一區域填滿成某一顏色，可以呼叫 FloodFill API 函數，此一函數含
有以下
四個參數：
　
hDC：handle of DC，有關 DC(Device Context) 的意義請參閱上上期的解說，對
VB
的物件而言， Form 及 PictureBox 都具有名稱為 hDC 的屬性，可據以呼叫
FloodFi
ll 函數。
X, Y：座標位置，但請注意，單位是 pixel(像素)。
crColor：封閉區域的邊框顏色。
　
讓筆者舉例來說明以上參數 2、3、4 的設定方法，參考圖-3，假設我們想填滿
某一方
形區域，則 (X, Y) 可以設定成區域內的任何一點，而 crColor 則必須設定成邊
框的
形區域，則 (X, Y) 可以設定成區域內的任何一點，而 crColor 則必須設定成邊
框的
顏色，假設邊框顏色是黑色，則設定值等於 RGB(0,0,0)(等於 0)，假設邊框顏
色是紅
色，則設定值等於 RGB(255,0,0)。
　
圖-3 FloodFill 的參數意義
　
雖然 FloodFill 是填滿區域的函數，但單純呼叫此一函數並不能填滿區域，因為
Win
dows GDI 規定，填滿區域之前必須先設定 brush(圖刷)物件給 DC 才可以，而
brush
物件的顏色就成為填滿的顏色。為了建立 brush 物件，並且設定給 DC，我們必
須這
麼做：
　
Dim hBrush As Long
hBrush = CreateSolidBrush(顏色設定值) ' 建立 brush 物件
Call SelectObject(hDC, hBrush) ' 將 brush 物件設定給 DC
' 接著再呼叫 FloodFill，例如：
Call FloodFill(hDC, X, Y, RGB(0, 0, 0))
　
有關實際範例，您可以參閱筆者所完成的 runpc49h.frm 表單，如圖-4，使用
此一表
單時，只要選取顏色，再以滑鼠選取欲填滿顏色的區域，即可看到 FloodFill
執行的
結果，在此範例中，請注意一件事情：筆者將表單的 ScaleMode 屬性設定成
"3-像素
"，因為 FloodFill 的 (X, Y) 參數是以像素為座標單位。
　
圖-4 FloodFill 範例程式
圖-4 FloodFill 範例程式
　
問題14：如何讀取磁碟的空間及可用空間？
------------------------------------------------------------------------
----
----
　
讀取磁碟的空間及可用空間需呼叫 GetDiskFreeSpace API 函數，此一函數含有
5 個
參數，意義如下：
　
RootPathName：磁碟機根目錄，以 C: 為例，必須寫成 "C:\"，不可以寫成
"C:" 或
"C"。
SectorsPerCluster：每一叢集的磁軌數。
BytesPerSector：每一磁軌的位元組數。
NumberOfFreeClusters：可用的叢集數。
TotalNumberOfClusters：總叢集數。
　
而計算磁碟空間(位元組數)的公式等於＝(每一磁軌的位元組數×每一叢集的磁軌
數×叢
集數)，所以求取磁碟空間與可用空間的程式如下：(以 C: 為例)
　
Dim Sectors As Long, Bytes As Long, Free As Long, Total As Long
Dim FreeKB As Long, TotalKB As Long
Call GetDiskFreeSpace("C:\", Sectors, Bytes, Free, Total)
FreeKB = Bytes * Sectors * Free \ 1024 ' 可用空間, 以 KB 為單位
FreeKB = Bytes * Sectors * Free \ 1024 ' 可用空間, 以 KB 為單位
TotalKB = Bytes * Sectors * Total \ 1024 ' 總空間, 以 KB 為單位
　
問題15：將表單縮小時，希望它的圖示顯示在工作列的右下角。
------------------------------------------------------------------------
----
----
　
最後來一題超難的，但問此一問題的讀者很多。
　
圖-5 將程式縮到右下角，可能嗎？
　
基本上，表單縮小後只有一個歸宿─「開始」功能表右邊的工作列，要縮到右下
角，
別想。但為什麼有的程式可以縮到右下角呢？其實右下角的圖示都不是表單或程式
，對
Windows 來說，它只是一個圖示，而想建立此一圖示，方法是呼叫
Shell_NotifyI
conA API 函數，如下：
　
Dim nid As NOTIFYICONDATA
Call Shell_NotifyIconA(NIM_ADD, nid)
　
呼叫 Shell_NotifyIconA 之前，必須間填好 NOTIFYICONDATA 資料結構(如以上
的 ni
d 變數)的內容，而 NOTIFYICONDATA 各資料成員的意義如下：
　
cbSize：需填入 NOTIFYICONDATA 資料結構的長度。
cbSize：需填入 NOTIFYICONDATA 資料結構的長度。
hWnd：handle of window，例如設定成 Form1.hWnd。
uID：使用者為圖示所設定的 ID。
uFlags：用來設定以下三個參數(uCallbackMessage、hIcon、szTip)是否有效，通
常設
定成 (NIF_MESSAGE + NIF_ICON + NIF_TIP) 表示全部有效。
uCallbackMessage：將來使用者在圖示上按下滑鼠時， Windows 會以訊息通知視
窗程序
，而此一參數為訊息之編號。
hIcon：圖示。
szTip：提示訊息。
　
以上共有 7 個資料成員，看起來挺嚇人的，別擔心，這幾個資料成員很容易設
定，
首先讓筆者舉個最簡單的例子：
　
Dim nid As NOTIFYICONDATA
nid.cbSize = Len(nid) ' 取資料結構的長度設定給 cbSize
nid.hWnd = Me.hWnd ' 設定成表單的 hWnd
nid.uID = 9999 ' 取一個編號，可自訂
nid.uFlags = NIF_ICON ' NIF_ICON 表示設定圖示
nid.hIcon = Me.hIcon ' 設定成表單的圖示
Call Shell_NotifyIconA(NIM_ADD, nid)
　
結果執行之後， Me(目前表單) 的圖示就會出現在工作列的右下角(以下簡稱工作
列)，
您可以直接參閱筆者所完成的範例，以檢視程式執行的結果。在以上的設定中
uID 必
您可以直接參閱筆者所完成的範例，以檢視程式執行的結果。在以上的設定中
uID 必
須取一個唯一的編號，將來我們若要從工作列除去此一圖示， Windows 會比對此
一 u
ID 與 hWnd，所以除去的方法如下：
　
Dim nid As NOTIFYICONDATA
nid.cbSize = Len(nid)
nid.hWnd = Me.hWnd
nid.uID = 9999
Call Shell_NotifyIconA(NIM_DELETE, nid)
　
筆者的習慣是將 nid 宣告成全域變數，所以執行 Shell_NotifyIconA(NIM_ADD,
nid)
之後， nid 資料結構會保存 uID 及 hWnd 的值，所以接下來不必再設定 nid
的資料
成員，即可直接呼叫 Shell_NotifyIconA(NIM_DELETE, nid)，筆者的範例程式
就是這
麼寫的。
　
設定「提示訊息」
　
圖-6 滑鼠移到圖示上面會出現「提示訊息」
　
參考圖-6，當我們把滑鼠移到圖示上面時，有些圖示還會顯示「提示訊息」，這
是怎
麼辦到的呢？直接來看程式：
　
nid.cbSize = Len(nid)
nid.cbSize = Len(nid)
nid.hWnd = Me.hWnd
nid.uID = 9998
nid.uFlags = NIF_ICON + NIF_TIP ' 增加「提示訊息」的設定
nid.hIcon = Me.Icon
nid.szTip = "學 VB 找王國榮" + Chr(0)
Call Shell_NotifyIconA(NIM_ADD, nid)
　
首先 uFlags 資料成員要加上 NIF_TIP，而 szTip 資料成員則設定成提示訊息，
請注
意此一提示訊息的最後應加上 Chr(0)，否則提示訊息的最後會多出很多空白字元
。
　
圖示的修改
　
Shell_NotifyIconA 函數除了可用來建立及刪除圖示之外，也可以修改圖示，例
如以下
程式可以將 uID = 9998 圖示的提示訊息由「學 VB 找王國榮」改成「學
Visual Basi
c 找王國榮」：
　
nid.hWnd = Me.hWnd
nid.uID = 9998
nid.uFlags = NIF_ICON + NIF_TIP
nid.szTip = "學 Visual Basic 找王國榮" + Chr(0)
Call Shell_NotifyIconA(NIM_MODIFY, nid)
　
　
接收 Windows 的訊息
　
想想，我們在工作列裡面建立圖示有什麼用呢？首先，假設我們將 Form1 的圖
示設定
到工作列中，那麼接下來可以利用以下敘述讓 Form1 不會顯示在正規的工作列中
：
　

Form1.Hide
　
因為右下角的工作列比較不佔空間，對於一些處理「背景」(background)工作的
表單而
言，這確實是個不錯的表現方式，以數據機、印表機…為例，就採用此一表現方
式，
而有意思的是，數據機(或印表機)狀態改變時，程式也會利用
Shell_NotifyIconA(N
IM_MODIFY, nid) 改變圖示，讓使用者感覺到程式有在執行。
　
以數據機或印表機為例，當我們在圖示上面按下滑鼠時，它們都會開啟視窗，這
又是
如何辦到的呢？筆者稍早說過，工作列的圖示只是圖示，不是視窗，因此無法
接收「
按下滑鼠」的訊息，而實際上，當使用者在工作列的圖示按下滑鼠時，收到訊息
的是
Windows 的 Shell 程式，為了讓 Shell 程式能夠將按下滑鼠的訊息轉送給我們
的視
窗，在建立圖示時，必須這麼做：
　
Dim nid As NOTIFYICONDATA
nid.cbSize = Len(nid)
nid.hWnd = Me.hWnd
nid.uID = 9997
nid.uID = 9997
nid.uFlags = NIF_ICON + NIF_TIP + NIF_MESSAGE
nid.hIcon = Me.hIcon
nid.szTip = "學 VB 找王國榮" + Chr(0)
nid.uCallbackMessage = 訊息編號
Call Shell_NotifyIconA(NIM_ADD, nid)
　
主要的變動有二：(1) uFlags 資料成員必須增加 NIF_MESSAGE (2) 把希望 Shell
傳送
過來的訊息編號設定給 uCallbackMessage 資料成員，例如設定成 99999，則將
來使用
者在工作列的圖示按下滑鼠時(包含單按及雙按)，視窗程序都會收到 99999 的訊
息。

　
但故事還沒結束，收到 Shell 傳來訊息的是「視窗程序」，不是「事件程序」
，所以
想要處理 Shell 傳來的訊息，必須撰寫視窗程序，這下子又要應用到上一期所
介紹的
「Windows 的訊息系統」了。
　
接著讓筆者來說明視窗程序如何處理 Shell 所傳來的訊息，就架構部分，與上
一期介
紹的視窗程序完全相同，而 Msg、wParam、及 lParam 等幾個參數的意義則如下：

　
Msg：將等於 nid.uCallbackMessage 資料成員的設定值。
wParam：將等於 nid.uID 資料成員的設定值。
lParam：將等於滑鼠的訊息，其中最常使用的是 WM_LBUTTONDOWN(按下滑鼠左鈕)
及
WM_LBUTTONDBLCLK(雙按滑鼠左鈕)。
WM_LBUTTONDBLCLK(雙按滑鼠左鈕)。

　
因此視窗程序的架構大致如下：
　
Function WndProcForIcon(ByVal hWnd As Long, ByVal Msg As Long, ByVal
wParam
As Long, ByVal lParam As Long) As Long
If Msg = 訊息編號 Then
If lParam = WM_LBUTTONDOWN Then
... 處理「按下滑鼠」訊息
ElseIf lParam = WM_LBUTTONDBLCLK Then
... 處理「雙按滑鼠」訊息
End If
End If
WndProcForIcon = CallWindowProc(prevWndProcForIcon, hWnd, Msg, wParam,
lPara
m)
End Function
　
此一運作模式並不困難，唯一要特別注意的事情是「訊息編號」(也就是 nid.
uCallba
ckMessage 資料成員與視窗程序的 Msg 參數)，由於 Windows 已經定義了某些訊
息(例
如 WM_LBUTTONDOWN)，而這些訊息都具有特定意義，因此我們選用的「訊息編號
」絕對
不可以與 Windows 已定義的訊息相衝突，而要避免訊息的衝突，程式可以使用
編號在
WM_USER(=&H400=1024) 以後的訊息，因為 WM_USER 以後的訊息編號屬於
Windows 未
定義的訊息。
定義的訊息。
　
此一問題特別困難，建議您仔細閱讀筆者所完成的範例，如果不太能瞭解其中的
意義
，請翻開上一期的「Windows 的訊息系統」，複習一下。
　
附錄 ─ 呼叫本文 API 函數所需之宣告式
　
Option Explicit
' 問題 1、2、3 所需之宣告
Public Const FO_MOVE = &H1
Public Const FO_COPY = &H2
Public Const FO_DELETE = &H3
Public Const FOF_NOCONFIRMATION = &H10
Public Const FOF_NOCONFIRMMKDIR = &H200
Public Const FOF_ALLOWUNDO = &H40
Type SHFILEOPSTRUCT
hWnd As Long
wFunc As Long
pFrom As String
pTo As String
fFlags As Integer
fAborted As Boolean
hNameMaps As Long
hNameMaps As Long
sProgress As String
End Type
Declare Function SHFileOperation Lib "shell32.dll" Alias
"SHFileOperationA"
(lpFileOp As SHFILEOPSTRUCT) As Long
　
' 問題 4 所需之宣告
Public Const GWL_WNDPROC = (-4)
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA"
(ByVal

lpPrevWndFunc As Long, ByVal hWnd As Long, ByVal Msg As Long, ByVal
wParam A
s Long, ByVal lParam As Long) As Long
Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA"
(ByVal hW
nd As Long, ByVal nIndex As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA"
(ByVal hW
nd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public prevWndProc As Long
　
' 問題 5 所需之宣告
Declare Function GetWindowsDirectory Lib "kernel32" Alias
"GetWindowsDirecto
ryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
　
　
' 問題 6 所需之宣告
Declare Function fCreateShellLink Lib "vb5stkit.DLL" (ByVal folder As
String
, ByVal ShortCutName As String, ByVal ExePath As String, ByVal Params As
Str

ing) As Long
　
' 問題 7 所需之宣告
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_SHOW = 5
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA"
(ByVal
hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String,
ByVal lp
Parameters As String, ByVal lpDirectory As String, ByVal nShowCmd As
Long) A
s Long
　
' 問題 8 所需之宣告
Public Const SYNCHRONIZE = &H100000
Public Const INFINITE = &HFFFFFFFF
Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As
Long,
ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As
Long
Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As
Long,
ByVal dwMilliseconds As Long) As Long
ByVal dwMilliseconds As Long) As Long
　
' 問題 9、12 所需之宣告
Public Const EM_GETLINECOUNT = &HBA
Public Const EM_LINESCROLL = &HB6
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hWnd A
s Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
Long
　
' 問題 10 所需之宣告
Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_FIXED = 3
Public Const DRIVE_REMOTE = 4
Public Const DRIVE_CDROM = 5
Public Const DRIVE_RAMDISK = 6
Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA"
(ByVal nD
rive As String) As Long
　
' 問題 11 所需之宣告
Public Const OFS_MAXPATHNAME = 128
Public Const OF_READ = &H0
Type OFSTRUCT
cBytes As Byte
fFixedDisk As Byte
fFixedDisk As Byte
nErrCode As Integer
Reserved1 As Integer
Reserved2 As Integer
szPathName(OFS_MAXPATHNAME) As Byte
End Type
　
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
Type FileTime
dwLowDateTime As Long
dwHighDateTime As Long
End Type
　
Type BY_HANDLE_FILE_INFORMATION
Type BY_HANDLE_FILE_INFORMATION
dwFileAttributes As Long
ftCreationTime As FileTime
ftLastAccessTime As FileTime
ftLastWriteTime As FileTime
dwVolumeSerialNumber As Long
nFileSizeHigh As Long
nFileSizeLow As Long
nNumberOfLinks As Long
nFileIndexHigh As Long
nFileIndexLow As Long
End Type
Type TIME_ZONE_INFORMATION
bias As Long
StandardName(32) As Integer
StandardDate As SYSTEMTIME
StandardBias As Long
DaylightName(32) As Integer
DaylightDate As SYSTEMTIME
DaylightBias As Long
End Type
　
Declare Function GetTimeZoneInformation Lib "kernel32"
(lpTimeZoneInformatio
Declare Function GetTimeZoneInformation Lib "kernel32"
(lpTimeZoneInformatio
n As TIME_ZONE_INFORMATION) As Long
Declare Function OpenFile Lib "kernel32" (ByVal lpFileName As String,
lpReOp
enBuff As OFSTRUCT, ByVal wStyle As Long) As Long
Declare Function GetFileInformationByHandle Lib "kernel32" (ByVal
hFile As L
ong, lpFileInformation As BY_HANDLE_FILE_INFORMATION) As Long
' Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As
Lon
g
Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As
FileTime
, lpSystemTime As SYSTEMTIME) As Long
　
' 問題 13 所需之宣告
Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As
Lon
g
Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal
hObject
As Long) As Long
Declare Function FloodFill Lib "gdi32" (ByVal hdc As Long, ByVal X As
Long,
ByVal Y As Long, ByVal crColor As Long) As Long
　
' 問題 14 所需之宣告
Declare Function GetDiskFreeSpace Lib "kernel32" Alias
"GetDiskFreeSpaceA" (
ByVal lpRootPathName As String, lpSectorsPerCluster As Long,
lpBytesPerSecto
r As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As
Long)
r As Long, lpNumberOfFreeClusters As Long, lpTtoalNumberOfClusters As
Long)
As Long
　
' 問題 15 所需之宣告
Public Const NIM_ADD = 0
Public Const NIM_MODIFY = 1
Public Const NIM_DELETE = 2
Public Const NIF_MESSAGE = 1
Public Const NIF_ICON = 2
Public Const NIF_TIP = 4
Type NOTIFYICONDATA
cbSize As Long
hWnd As Long
uID As Long
uFlags As Long
uCallbackMessage As Long
hIcon As Long
szTip As String * 64
End Type
　
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_USER = &H400
Public Const WM_USER = &H400
Public prevWndProcForIcon As Long
　
Declare Function Shell_NotifyIconA Lib "SHELL32" (ByVal dwMessage As
Long, l
pData As NOTIFYICONDATA) As Integer
　
　
' 問題 4 所需之視窗程序
Function WndProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam
As Long
, ByVal lParam As Long) As Long
If Msg = WM_RBUTTONDOWN Then
' 吃掉這個訊息
Else
WndProc = CallWindowProc(prevWndProc, hWnd, Msg, wParam, lParam)
End If
End Function
　
' 問題 15 所需之視窗程序
Function WndProcForIcon(ByVal hWnd As Long, ByVal Msg As Long, ByVal
wParam
As Long, ByVal lParam As Long) As Long
If Msg = WM_USER Then
If lParam = WM_LBUTTONDOWN Then
MsgBox "按下滑鼠", vbInformation + vbSystemModal
' 問題 15 所需之視窗程序
ElseIf lParam = WM_LBUTTONDBLCLK Then
MsgBox "雙按滑鼠", vbInformation + vbSystemModal
End If
End If
WndProcForIcon = CallWindowProc(prevWndProcForIcon, hWnd, Msg, wParam,
lPara
m)
End Function

--
" The Matrix is everywhere, it's all around us, here even in this room.
You
can see it out your window, or  on your television. You feel it when
you
go to work, or go to church or pay your taxes. It is the world that has
been
pulled over your eyes to blind you from the truth... Unfortunately,
no one
can be told what the Matrix is. You have to see it for yourself."

Morphe

※ 来源:．武汉白云黄鹤站 bbs.whnet.edu.cn．[FROM: 202.114.3.124]

--
我并不是在等待奇迹，因为我知道没有奇迹的。
有的，也只是爱情、意志和勇气。
是这些东西的重叠后，而成为奇迹的。
所以，我从未曾想过放弃。

※ 修改:·Love1976 於 Apr  6 04:25:41 修改本文·[FROM: 202.112.140.138]

--
☆ 来源:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: blo0m.bbs@smth.org]
--
※ 转载:．哈工大紫丁香 bbs.hit.edu.cn．[FROM: 202.118.247.254]

VB 版 (精华区)