［上一页］（62）［下一页］

当我们要打印报表时，如果打印机是本机的打印机的话，当然马上就会将报表打印出来，反正打印机就只有您一个人在使用而已！但是如果是在一个人数很多的公司或企业时，往往就必须很多人来分享某一部打印机了，而且打印机也不一定就放在举目可及之处！

当您将报表丢到网络打印机之后，由于不一定看得到打印机，您必须特别到摆放打印机的地方去拿报表，这时候您最关心的，就是报表印了没有，如果还没有的话，那还有几份还没打印的报表排在您的报表之前呢？

下面这一段程序，可以让您知道某一台网络打印机尚有几份等待打印的报表？在您的程序丢出报表的同时，您可以告诉您的 User，他的报表排在第几份！

'在 .bas 文件中加入以下声明及模组：

'Constants Definition
Public Const CCHDEVICENAME = 32
Public Const CCHFORMNAME = 32
Public Const PRINTER_ACCESS_ADMINISTER = &H4
Public Const PRINTER_ACCESS_USE = &H8

'Types Definition
Public Type DEVMODE
dmDeviceName As String * CCHDEVICENAME
dmSpecVersion As Integer
dmDriverVersion As Integer
dmSize As Integer
dmDriverExtra As Integer
dmFields As Long
dmOrientation As Integer
dmPaperSize As Integer
dmPaperLength As Integer
dmPaperWidth As Integer
dmScale As Integer
dmCopies As Integer
dmDefaultSource As Integer
dmPrintQuality As Integer
dmColor As Integer
dmDuplex As Integer
dmYResolution As Integer
dmTTOption As Integer
dmCollate As Integer
dmFormName As String * CCHFORMNAME
dmUnusedPadding As Integer
dmBitsPerPel As Long
dmPelsWidth As Long
dmPelsHeight As Long
dmDisplayFlags As Long
dmDisplayFrequency As Long
End Type

Public Type PRINTER_DEFAULTS
pDatatype As String
pDevMode As DEVMODE
DesiredAccess As Long
End Type

'API Declarations
Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, pDefault As PRINTER_DEFAULTS) As Long
Public Declare Function EnumJobs Lib "winspool.drv" Alias "EnumJobsA" (ByVal HPrinter As Long, ByVal FirstJob As Long, ByVal NoJobs As Long, ByVal Level As Long, pJob As Byte, ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long

Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

'取得指定的打印机，目前有多少 Jobs (最大值为 128)
'打印机的名称可以是 mapping 的网络路径名称，例如： "\\myserver\myprinter"
Function GetPrinterQueue(PrinterName As String) As Long
Dim PrinterStruct As PRINTER_DEFAULTS
Dim HPrinter As Long
Dim ret As Boolean
Dim JobStruct(0 To 127) As Byte
Dim pcbNeeded As Long
Dim pcReturned As Long
Dim TempByte As Byte

'设定 Printer structure 初值
PrinterStruct.pDatatype = vbNullString
PrinterStruct.pDevMode.dmSize = Len(PrinterStruct.pDevMode)
PrinterStruct.DesiredAccess = PRINTER_ACCESS_USE
'取得打印机的 Handle
ret = OpenPrinter(PrinterName, HPrinter, PrinterStruct)
'取得打印机的 active jobs
ret = EnumJobs(HPrinter, 0, 127, 1, TempByte, 0, pcbNeeded, pcReturned)
If pcbNeeded = 0 Then
GetPrinterQueue = 0
Else
ret = EnumJobs(HPrinter, 0, 127, 1, JobStruct(0), pcbNeeded, pcbNeeded, pcReturned)
GetPrinterQueue = pcReturned
End If
'关闭打印机
ret = CloseHandle(HPrinter)
End Function

'在表单中放一个 CommandButton，程序码如下：

Private Sub Command1_Click()
'测试预设打印机的 Queue (Printer.DeviceName)
Msgbox "打印机中尚有 " & GetPrinterQueue(Printer.DeviceName) & " 份报表", 64, "讯息"
End Sub

'好了，试试看吧！

307、如何每天下载 Internet 上某一个网页中的图片来更换桌面的图案？

有些处理图片的软件，尤其是可以处理桌面图片的软件，会提供您每天自动到 Internet 上的某一个网址，去下载它的网站所提供，每天更换的图片，来更改桌面的底图，这是一个很炫的功能，而我们用 VB 也可以很容易的做到这样的功能，您相信吗？

这个主题会运用到之前我们提过的几个功能：

问题: 如何让程序在 Windows 启动时自动执行？
问题: 如何从 Internet 上下载某一个网页的内容？
问题: 如何移除或更改桌面背景的底色图案 (Wallpaper)？

让我们直接来练习吧！

'请在 .BAS 中加入以下声明：

Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, ByVal lpvParam As Any, ByVal fuWinIni As Long) As Long

Const SPI_SETDESKWALLPAPER = 20
Const SPIF_UPDATEINIFILE = &H1
Const SPIF_SENDWININICHANGE = &H2

'请在表单中放入一个 TextBox 及一个 Internet Transfer Control

Private Sub Form_Load()
Dim Pos As Integer
Dim Pos2 As Integer
Dim Bilden() As Byte
Dim NrString As String

Text1.Text = Inet1.OpenURL("http://www.vbeden.com/") 'Download the page.
Pos = InStr(1, Text1.Text, "/preblem/61-80")
Pos2 = InStr(Pos, Text1.Text, ".gif")
NrString = Mid(Text1.Text, Pos, Pos2 - Pos)
Text1.Text = "http://www.vbeden.com" + NrString + ".gif" ' Debug filename
Bilden() = Inet1.OpenURL("http://www.vbeden.com" + NrString + ".gif", icByteArray) ' Download picture.

Open "C:\dilbert.gif" For Binary Access Write As #1 ' Save the file.
Put #1, , Bilden()
Close #1

Picture1.Picture = LoadPicture("c:\dilbert.gif") 'Reload it To PictureBox
SavePicture Picture1.Picture, "c:\dilbert.bmp" 'Converted To bmp..

Call SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, "c:\dilbert.bmp", SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) 'Change the wallpaper.
Unload Me ' Exit program
End Sub

至于其中的网址及图片的文件名，请自行更改。若是您直接使用以上的程序码的话，也可以，您每天都可以看到一篇漫画 !!

308、如何呼叫系统的控制面板？

在 Windows 的系统中，从很多地方，您有很多方式去叫出系统的控制面板，例如从【我的电脑】、【资源管理器】或是【开始】功能表中的【设置】选项中都可以看到控制面板。

使用 VB 您也可以在程序中叫出控制面板来使用！而且程序码很简单，只要一行就可以了，如下：

Private Sub Command1_Click()
Shell "rundll32.exe shell32.dll,Control_RunDLL", vbNormalFocus
End Sub

上面的程序码，不管您是使用 Windows 95/98/NT 都可以适用的！

309、如何完全模拟系统的控制面板？

在上一个主题：如何呼叫系统的控制面板？中，我们告诉您如何直接叫用系统的控制面板，但是，如果您只是想要叫用控制面板中的某一个单一功能设定画面的话，您也可以做到的！

其实，控制面板的那么多的功能，是分别叫用您电脑中的一些扩展文件名为 .CPL 的文件，这些文件在 Windows 95/98/NT 中存放的位置有一些不同，分别说明如下：

Windows 95/98：文件位置在 c:\windows\system
Windows NT：文件位置在 c:\winnt\system32

下面的程序码以 Windows98 为例来说明，如果您是在 Windows NT 中，请自行稍微修改。在表单上放一个 CommandButton 及一个 FileListBox，程序码如下：

Private Sub Form_Load()
File1.Pattern = "*.CPL"
File1.FileName = "C:\WINdows\SYSTEM" '若是 NT 的话请改这里
End Sub

Private Sub Command1_Click()
Shell "rundll32.exe shell32.dll,Control_RunDLL " & File1.FileName, vbNormalFocus
End Sub

好了，别惊讶，程序码就是这么短而已！请先在 FileListBox 中选择一个文件，每一个文件分别代表控制面板中的某一个功能设定程序，然后按下 Command1 就可以执行了！

310、如何设定 MsgBox 在若干时间之后若无回应则自动关闭？

在我们的印象中，VB 所提供的 MsgBox 是一个强制回应的视窗，您一定要按了其中的某一个 CommandButton 之后，它才会关闭！但是在某些软体中，我们会看到，明明是使用系统的 MsgBox，可是您如果不理它，几秒钟之后，它就自行关闭了！别人是如何做到的呢？这个问题偶而会出现在讨论区中，有的人会回答：

只要自己做一个类似 MsgBox 的视窗，就可以自己用 Timer 来控制这个视窗何时要关闭了！

但是，其实不用这么麻烦的，只要使用系统的 MsgBox 再加一个 Timer 就可以控制了！

我们都知道 MsgBox 可以设定成很多不同的样子，可以有很多不同的图示，不同的按钮，其中控制按钮的部份，可以设定的常数如下：

常数 值 说明
vbOKOnly 0 只显示 OK 按钮。
VbOKCancel 1 显示 OK 及 Cancel 按钮。
VbAbortRetryIgnore 2 显示 Abort、 Retry 及 Ignore 按钮。
VbYesNoCancel 3 显示 Yes、No 及 Cancel 按钮。
VbYesNo 4 显示 Yes 及 No 按钮。
VbRetryCancel 5 显示 Retry 及 Cancel 按钮。

为什么要特别提到 MsgBox 的常数呢？因为下面我们要告诉您的方法，还是有一点点限制的！当您设定的常数是 VbAbortRetryIgnore 或 VbYesNo 时，下面的方法也是没用的！

'在表单的声明区中加入以下的声明

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Const WM_CLOSE = &H10
Private Const MsgTitle As String = "Test Message"

'在表单中加入一个 CommandButton 及一个 Timer 控制项，加入以下程序码：

Private Sub Command1_Click()
Dim nRet As Long
Timer1.Interval = 3000
Timer1.Enabled = True
nRet = MsgBox("若您不回应的话，3 秒后此 MsgBox 会自动关闭", 64, MsgTitle)
Timer1.Enabled = False
End Sub

Private Sub Timer1_Timer()
Dim hWnd As Long
hWnd = FindWindow(vbNullString, MsgTitle)
Call SendMessage(hWnd, WM_CLOSE, 0, ByVal 0&)
End Sub

好了，很简单吧！您执行程序时，当 MsgBox 出现 3 秒之后，就会自动关闭了！

注意：此方法的限制说明：

1、当常数设定为 VbAbortRetryIgnore 或 VbYesNo 时，无效！
2、在 Design Time 时，无效，必须 Make EXE 之后才有效！

［上一页］（62）［下一页］