調用API函數設計ABOUT窗口 

江 蘇 省 鎮 江 港 務 局 
蔡 可 訓 
---- windows98 系 統 的 許 多 軟 件 中 都 包 含 一 個windows 風 格 的about 窗 口， 它 向 用 戶 反 映 了 當 前 系 統 的 一 些 基 本 信 息， 其 中 顯 示 有 關windows 及 其 應 用 軟 件 的 版 本、 版 權 和 系 統 的 工 作 狀 態 等 信 息。 筆 者 用VB 6.0 通 過 調 用API 函 數 設 計 應 用 系 統 的ABOUT 窗 口。 效 果 如 圖1。( 略) 
1 ． 建 立 含 有 如 下 控 件 的 窗 體： 
　　　控 件　　 NAME　　　CAPTION 
　　　窗 體　　 FORM1　　 用VB6.0 設 計ABOUT 窗 口
　　　命 令 按 鈕　 COMMAND1 關 于 銷 售 管 理 系 統

2 ． 程 序 清 單： 
---- Private Declare Function GetWindowWord Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Integer 
---- Private Declare Function ShellAbout Lib "shell32.dll" Alias "ShellAboutA" (ByVal hwnd As Long, ByVal szApp As String, ByVal szOtherStuff As String, ByVal hIcon As Long) As Long 

---- Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hinst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long 

---- Private Declare Sub GetSystemInfo Lib "kernel32" (lpSystemInfo As SYSTEM_INFO) Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 

Private Const GWL_EXSTYLE = (-20)
Private Const GWL_STYLE = (-16)
Private Const GWL_WNDPROC = (-4)
Private Const GWL_HINSTANCE = (-6)
Private Type SYSTEM_INFO
　　　　dwOemID As Long
　　　　dwPageSize As Long
　　　　lpMinimumApplicationAddress As Long
　　　　lpMaximumApplicationAddress As Long
　　　　dwActiveProcessorMask As Long
　　　　dwNumberOrfProcessors As Long
　　　　dwProcessorType As Long
　　　　dwAllocationGranularity As Long
　　　　dwReserved As Long
End Type
Private Const SM_CXSCREEN = 0
Private Const SM_CYSCREEN = 1

Private Sub Command1_Click()
Dim hinst As Long
Dim icons As Long
Dim abouts As Long
Dim dispx As String
Dim dispy As String
Dim cps As String
Dim space1 As String
Dim space2 As String
hinst = GetWindowWord(Me.hwnd, GWL_HINSTANCE)
icons = ExtractIcon(hinst, "d:\fpw26\foxprow.exe", 0)
Dim sysinfo As SYSTEM_INFO
Dim cls1 As Long
Dim cls2 As Long
Dim secs As Long
Dim bytes As Long
Dim buffs As String
buff = "C:\"
x = GetDriveType(buffs)
x = GetDiskFreeSpace(buffs, secs, bytes, cls1, cls2)
cls1 = cls1 * secs * bytes
cls2 = cls2 * secs * bytes
space1 = "C驅動器總共容量：
　　" + Format$(cls2/1024, "#, #") + "千字節"
space2 = "C驅動器可用容量：
　　" + Format$(cls1/1024, "#, #") + "千字節"
x = GetSystemMetrics(SM_CXSCREEN)
dispx = "顯示器分辨率：" + Str$(x)
x = GetSystemMetrics(SM_CYSCREEN)
dispy = Str$(x)
Call GetSystemInfo(sysinfo)
Select Case sysinfo.dwProcessorType
Case 386
　　 cpus = "處理器類型:386"
Case 486
　　 cpus = "處理器類型:486"
Case 586
　　 cpus = "處理器類型:586"
End Select
abouts = ShellAbout(Me.hwnd, "演示程序",
　 "銷售管理系統V2.0版權所有[C]1998-1999蔡可訓" 
　　& Chr$(13) & Chr$(10) & space1 & Chr$(13) & Chr$(10)
　　& space2 & Chr$(13) & Chr$(10) & cpus + "　" + dispx +
　　 "*" + dispy , icons)
End Sub

---- 以 上 程 序 在WINDOWS98,VISUAL BASIC 6.0 FOR WINDOWS 環 境 下 運 行 通 過. 用 戶 可 以 將 其 加 入 應 用 系 統 的ABOUT 菜 單 項， 通 過 菜 單 項 調 用 它， 效 果 更 好。