调 用API 函 数 设 计ABOUT 窗 口

作者：蔡 可 训

windows98 系 统 的 许 多 软 件 中 都 包 含 一 个windows 风 格 的about 窗 口， 它 向 用 户 反 映 了 当 前 系 统 的 一 些 基 本 信 息， 其 中 显 示 有 关windows 及 其 应 用 软 件 的 版 本、 版 权 和 系 统 的 工 作 状 态 等 信 息。 笔 者 用VB 6.0 通 过 调 用API 函 数 设 计 应 用 系 统 的ABOUT 窗 口。 效 果 如 图1。( 略)

1 ． 建 立 含 有 如 下 控 件 的 窗 体：

      控 件     NAME      CAPTION 

      窗 体     FORM1     用VB6.0 设 计ABOUT 窗 口

      命 令 按 钮   COMMAND1 关 于 销 售 管 理 系 统

---- 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