|
 |
推荐文章 |
|
|
|
|
|
|
|
|
|
|
| 作者：蔡可训 日期：2005-8-4 11:35:24 |
|
|
Windows98 系 统 的 许 多 软 件 中 都 包 含 一 个windows 风 格 的about 窗 口， 它 向 用 户 反 映 了 当 前 系 统 的 一 些 基 本 信 息， 其 中 显 示 有 关windows 及 其 应 用 软 件 的 版 本、 版 权 和 系 统 的 工 作 状 态 等 信 息。 笔 者 用VB 6.0 通 过 调 用API 函 数 设 计 应 用 系 统 的ABOUT 窗 口。
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:fpw26foxprow.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 菜 单 项， 通 过 菜 单 项 调 用 它， 效 果 更 好 |
|
|
|
|
|
特别声明： 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载，但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站，我们表示深深的谢意。如果本站转载的文章有版权问题请联系编辑人员，我们尽快予以更正。 |
|
|
|
|
|
责任编辑： 原点 |
投稿作者： 蔡可训 |
|
|
信息来源： 网络 |
录入时间： 2005-8-4 11:35:24 |
|
|
|
| |
|
设为首页
加入收藏
总编信箱
投稿或申请专栏请先 [登 陆]