VB语言

本类阅读TOP10
·Visual Basic 安装程序的制作!!
·VB中使用EXCEL输出
·一个简单的MP3播放器
·VB程序实现WindowsXP效果的界面!!
·VB打造超酷个性化菜单（六）
·透明位图
·平铺与拉伸MDI窗口的背景图 ~!~
·对《VB程序实现WindowsXP效果的界面》一文的补遗
·从Windows资源管理器中拖动文件
·VB打造超酷个性化菜单（一）

→ 分类导航
VC语言Delphi
VB语言ASP
PerlJava
Script数据库
其他语言游戏开发
文件格式网站制作
软件工程.NET开发
调 用API 函 数 设 计ABOUT 窗 口

作者：未知 来源：月光软件站 加入时间：2005-2-28　月光软件站

 

调 用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 菜 单 项， 通 过 菜 单 项 调 用 它， 效 果 更 好。

　

相关文章：

相关软件：