|
|
|
|
| VB问题全功略（53） |
|
［上一页］（53）［下一页］ |
261、您知道
VB6.0 的阵列最多可以包含几个元素吗？
262、如何抓取应用程序的图标
(Icon) 并存文件备用？
263、如何直接使用 VB
来打印 MS Access 的 Report？
264、如何打开
Windows 的创建快捷方式窗口
265、如何取得短文件名
261、您知道 VB6.0 的阵列最多可以包含几个元素吗？
其实这个问题和 问题：您知道每一个表单 (Form) 最多可以放多少个控制项吗？
一样，第一个条件就是决定于您机器中的系统资源有多少而定！
如果今天我们假设系统资源充足而不考虑系统资源的话，根据 Microsoft
的官方说法，一个阵列最多可到 2 的 31 次方，也就是 2147483648，不过如果您真的用到 2147483648
的话，您一定会得到一个「记忆体不足」的错误讯息！因为连 Windows NT 在一个 Process 中也只能支援到 4GB
的记忆体而已！
262、如何抓取应用程序的图标 (Icon) 并存文件备用？
有些应用程序的图标非常的漂亮，不禁让人想将它们据为己有，您是否常常想将它们抓下来私用呢？
一般可以抓出图标
(Icon) 的文件大概就是 .EXE 文件 .ICO 文件及 .DLL 文件三种，但是 .DLL
文件不一定会有图标！
我看过很多范例程序教人家如何从 .EXE 文件及 .DLL
文件中抓出图标，但是也常常在讨论区中看到有人在问，要如何将这些抓出的图标再存成 .ICO 文件？其实，在抓出图标之后，只要使用
SavePicture 陈述式就可以将这个图标再存成 .ICO 的图标文件了！
在含有图标的 .EXE 文件 及 .DLL
文件中不一定只包含一个图标而已，例如：C:\Windows\System\Shell32.dll 中就含有 72
个图标之多！
在以下的范例中，您开启文件之后，程序会告诉您，在该文件中共有几个图标，它会 Show
出其中的第一个图标(索引值是0)，其他的图标您可以利用卷动轴来卷动浏览。
以下列出详细的程序码：
所需控制项说明：
Dlg：开文件存文件问话框
CommandDialog
CmdSave：另存图标按钮
CmdOpen：开启文件按钮
Picture1：显示图标
Label1：显示图标总数用
Label2：显示目前在
Picture1 中的图标在原文件中的索引值
Label3：显示目前在 Picture1 中的图标原文件名称
Scroll1：改变显示在
Picture1 中的图标索引值
Dim lIcon As Long
Dim sSourcePgm As
String
Dim sDestFile As String
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 DrawIcon Lib "user32" (ByVal hdc As Long,
ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private
Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As
Long
Private Sub CmdSave_Click() '另存图标
On Error Resume
Next
With Dlg '存文件问话框
.filename = sDestFile
.CancelError =
True
.Action = 2
If Err Then
Err.Clear
Exit Sub
End
If
sDestFile = .filename
SavePicture Picture1.Image, sDestFile
'将抓出的图标存文件
End With
End Sub
Private Sub CmdOpen_Click()
'开启文件
Dim a%
On Error Resume Next
With Dlg
'开文件问话框
.filename = sSourcePgm
.CancelError = True
.DialogTitle =
"请选择包含图标的 DLL 或 EXE 文件"
.Filter = "Icon Resources
(*.ico;*.exe;*.dll)|*.ico;*.exe;*.dll|All files|*.*"
.Action = 1
If
Err Then
Err.Clear
Exit Sub
End If
sSourcePgm =
.filename
Label3.Caption = .filename
DestroyIcon
lIcon
Do
lIcon = ExtractIcon(App.hInstance, sSourcePgm, a)
If
lIcon = 0 Then Exit Do
a = a + 1
DestroyIcon lIcon
Loop
If a =
0 Then
MsgBox "在这个文件中没有任何图标！"
End If
Label1.Caption = "在这个文件中共有 "
& a & " 个图标"
VScroll1.Max = IIf(a = 0, 0, a -
1)
VScroll1.Value = 0
VScroll1_Change
End With
End
Sub
Private Sub Form_Load()
CmdOpen_Click
End
Sub
Private Sub VScroll1_Change()
Label2.Caption = "正在浏览的图标索引值：
" & VScroll1.Value
DestroyIcon lIcon
Picture1.Cls
lIcon =
ExtractIcon(App.hInstance, sSourcePgm,
VScroll1.Value)
Picture1.AutoSize = True
Picture1.AutoRedraw =
True
DrawIcon Picture1.hdc, 0, 0, lIcon
Picture1.Refresh
End Sub
263、如何直接使用 VB 来打印 MS Access 的 Report？
在 Visual Basic 中，Access 2.0 可以使用 DDE 来操控，而
Access 97 及更新的版本，则可以使用 OLE Automation 来操控。不过我想，现在大部份的人使用的，都是某一个 32 位版本的
Access。
要在 Visual Basic 中来操控 Access，您首先要在 VB
的【工程】【设定引用项目】问话框中设定引用项目：
Access 7.0 设定的是 "Microsoft Access for
Windows 95"
Access 8.0 设定的是 "Microsoft Access 8.0 Object
Library"
引用项目设定完成之后，您就可以在您开发的应程序中，基于 Access application
来建立物件变量！只要使用一些简单的指令，您就可以用来开启资料库、执行 Access 报表及关闭资料库...等。
Dim ac As
Access.Application
Set ac = New
Access.Application
'指定要开启的资料库路径
ac.OpenCurrentDatabase("c:\foo\foo.mdb")
'只要使用
DoCmd 物件的 OpenReport method 就可以将报表送到打印机
ac.DoCmd.OpenReport
"MyReport"
'关闭资料库
ac.CloseCurrentDatabase
很简单吧！就是上面这么简单的程序码！只是要记得，您设计的这些可以独立执行的报表，它需要出现什么样的提示讯息或问话框...等！
264、如何打开 Windows 的创建快捷方式窗口
以下的代码演示了如何利用 Win95 的 Wizard 在指定的目录中建立快捷方式。
Dim X As Integer
X
= Shell("C:\WINDOWS\rundll32.exe AppWiz.Cpl,NewLinkHere " & App.Path
& "\", 1)
265、如何取得短文件名
如果要传递文件到老的不支持长文件名的应用，以下的函数可以派上用场：
Declare Function GetShortPathName
Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String,
ByVal lpszShortPath As String, ByVal cchBuffer As Long) As
Long
Function ShortName(LongPath As String) As String
Dim
ShortPath As String
Const MAX_PATH = 260
Dim ret&
ShortPath =
Space$(MAX_PATH)
ret& = GetShortPathName(LongPath, ShortPath,
MAX_PATH)
If ret& Then
ShortName = Left$(ShortPath,
ret&)
End If
End Function |
|