|
|
|
|
| VB问题全功略（22） |
|
［上一页］（22）［下一页］ |
106、如何让您的电脑进入待命状态
(Win98) 或启动屏幕保护程序 (Win95)？
107、如何在程序中模拟按了
Windows95/98 屏幕左下方之【开始键】？
108、如何让表单的标题列变成走马灯？
109、如何求出硬盘大小及剩余空间大小
110、如何新增、移除【文件功能表】的内容？
106、如何让您的电脑进入待命状态 (Win98) 或启动屏幕保护程序 (Win95)？
您的程序使用者会不会开启程序后不结束应用程序，结果就离开座位，久久不回座位？使用以下的方法，您可以做到：
1、在
Windows98 中，您可以在程序中让他的电脑进入待命状态！ (屏幕黑黑一片)
2、在 Windows95
中，您可以启动他电脑中预设的屏幕保护程序！
而要让电脑进入待命状态或启动屏幕保护程序，只要送一个讯息给桌面 (DeskTop
Window) 就可以了！
'在声明区中加入以下声明：
Const WM_SYSCOMMAND =
&H112&
Const SC_SCREENSAVE = &HF140&
Private
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd
As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As
Long
Private Declare Function GetDesktopWindow Lib "user32" () As
Long
Function gf_StartScreenSaver() As Boolean
Dim
hWnd&
On Error Resume Next
hWnd& =
GetDesktopWindow()
Call SendMessage(hWnd&, WM_SYSCOMMAND,
SC_SCREENSAVE, 0&)
gf_StartScreenSaver = (Err.Number = 0)
End
Function
'要使用时直接呼叫 gf_StartScreenSaver 即可！例如：
Private Sub
Command1_Click()
gf_StartScreenSaver
End Sub
107、如何在程序中模拟按了 Windows95/98 屏幕左下方之【开始键】？
或许有人会问：这有什么意义？当然有，随便举个例子，有的程序在执行时会盖住开始任务栏，就算滑鼠移到屏幕下方，任务栏也不会出现，目前这个方法就可以强迫任务栏出现！当然也可以让使用者选择执行【开始工能表】中各群组之程序。
如果您看过了前一个问题
(86-如何让您的电脑进入待命状态 (Win98) 或启动屏幕保护程序
(Win95)？)，您一定会发现这个问题的答案和上一个范例好像！没错！要让程序模拟按了 Windows95/98
屏幕左下方之【开始键】，也只要送一个讯息给桌面 (DeskTop Window)
就可以了！差别只在传入的参数不同而已：
'在声明区中加入以下声明：
Const WM_SYSCOMMAND =
&H112&
Const SC_TASKLIST = &HF130
'-------->只有这里不同而已
Private Declare Function SendMessage Lib
"user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long,
ByVal wParam As Long, lParam As Any) As Long
Private Declare
Function GetDesktopWindow Lib "user32" () As Long
Function
gf_StartButton() As Boolean
Dim hWnd&
On Error Resume
Next
hWnd& = GetDesktopWindow()
Call SendMessage(hWnd&,
WM_SYSCOMMAND, SC_TASKLIST, 0&)
gf_StartButton = (Err.Number =
0)
End Function
'要使用时直接呼叫 gf_StartButton 即可！例如：
Private
Sub Command1_Click()
gf_StartButton
End Sub
108、如何让表单的标题列变成走马灯？
说穿了，这个功能就是标准的做苦工的程序！不过效果还算不错！
Dim C As
String '存放现行视窗的标题列
Dim CO As Integer '存放标题的长度
Dim FS As Long
'存放现行视窗的宽度
Private Sub Form_Load()
Timer1.Interval =
100
Me.Caption = "会移动的标题列"
C = Me.Caption
CO = Len(C) +
1
Me.Caption = ""
If Me.BorderStyle <> 2 Then
FS =
Me.ScaleWidth + 250
Else
FS = Me.ScaleWidth + 500
End If
End
Sub
Private Sub Form_Resize()
If Me.WindowState = 1 Then
FS =
3500
Else
FS = Me.ScaleWidth
End If
End Sub
Private Sub
Timer1_Timer()
On Error GoTo ATH
Static C01 As Integer ' 第一个
Counter
Static CO2 As Integer ' 第二个 Counter
Static A As String ' to
move caption
Dim R As String ' restore caption
Dim T As String
' restore caption
XX:
If CO > 0 Then
C01 = CO
T = Mid(C,
C01, 1)
CO = CO - 1
R = " "
Mid(R, 1) = T
Me.Caption = R &
Me.Caption
Else
A = A & " "
R = " "
Mid(R, 1) =
A
Me.Caption = R & Me.Caption
End If
If CO2 >= FS
Then
CO2 = 0
CO = Len(C)
Me.Caption = ""
GoTo
XX
Else
CO2 = CO2 + 50
End If
Exit Sub
ATH:
End
Sub
109、如何求出硬盘大小及剩余空间大小
在我们安装软体的时候，在安装选项的画面，常常会出现如下的一些叙述：
选择安装项目大小..............................................10,000,000
Bytes
C 硬盘总空间大小..........................................1,847,328,768
Bytes
C 硬盘剩余空间大小...........................................51,707,904
Bytes
后面的二项是我们硬盘的资讯，我们只要使用一个
API，就可以同时抓到这二个资讯！
请在声明区中放入以下声明：
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 Sub
Command1_Click()
Dim SectorsPerCluster As Long '参数二：每个 Cluster 的 Sector
数
Dim BytesPerSector As Long '参数三：每个 Sector 的 Byte 数
Dim
NumberOfFreeClusters As Long '参数四：剩余的 Cluster 数
Dim
TotalNumberOfClusters As Long '参数五：Cluster 总数
Dim FreeBytes As Long
'剩余的 Byte 数
Dim TotalBytes As Long '总 Byte 数
Dim dummy As Long
'传回值
dummy = GetDiskFreeSpace("c:\", SectorsPerCluster, BytesPerSector,
NumberOfFreeClusters, TotalNumberOfClusters)
FreeBytes =
NumberOfFreeClusters * SectorsPerCluster * BytesPerSector
TotalBytes =
TotalNumberOfClusters * SectorsPerCluster * BytesPerSector
剩余空间大小 =
FreeBytes
硬盘大小 = TotalBytes
End Sub
注：在 VB6 以前的各版本
VB，只能使用这种方法来做，但是到了 VB6 已经有了更简单、不 要使用 API 的新作法，就是使用新物件
FileSystemObject，我们将在 《问题 99》再来探讨。
110、如何新增、移除【文件功能表】的内容？
在
Windows95/98 环境中，当您开启一份文件后，Windows 便会将这份文件记录在最近开启的文件记录中 (其实是将它放在
Windows/Recent
目录下)。
下一次您要开启同一份文件时，有三种以上的方法：
1、选择【开始】【文件】，就可以看到【文件功能表】的文件清单，再选择文件名称即可！
2、在文件总管文件所在目录下，直接开启该份文件。
3、在文件总管
Windows/Recent 目录下选择该份文件。
若是您想清除这份文件清单，有二个方法：
1、在文件总管中，将
Windows/Recent 目录下的文件通通删除即可。
2、在任务栏上按滑鼠右键，选择【内容】，出现【任务栏
内容】选单，选择【开始功能表程序集】，在【文件功能表】框中按【清除】按钮即可。
以上是人工的方法及 Windows
内部之作业流程，若是我们的 VB 程序中，要做到这样的功能，也是很简单的，但是它有什么作用呢？有的，举个例子：
今天 User
在操作我们的程序中，产生了几份文件，可能有文字档、Word 文件、Excel 文件...等，当然您可以事先和 User
约定好，产生的文件固定放在某一个目录下， User
再自行到该目录下去作处理，但是，如果您将产生的文件清单，直接放入【文件功能表】的文件清单中，User
根本不 知道文件放在那里，他只要在【文件功能表】中选择即可，是不是很方便！
'请在声明区中加入以下声明：
Private
Declare Sub SHAddToRecentDocs Lib "shell32.dll" (ByVal uFlags As Long,
ByVal pv As String)
'新增 (一次增加一笔)
Private Sub
Command1_Click()
Dim NewFile As String
NewFile =
"c:\doc\880730订购清单.doc" '<----- 要放到【文件功能表】文件清单的文件
Call
SHAddToRecentDocs(2, NewFile)
End Sub
'清除
(一次全部清除)
Private Sub Command2_Click()
Call SHAddToRecentDocs(2,
vbNullString)
End Sub |
|