调用API函数设计ABOUT窗口

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