比较两个文件
比较两个文件 98-7-04
Function CompFile(F1 as string, F2 as string) as boolean
Dim issame as boolean
Open F1 For Binary As #1
Open F2 For Binary As #2

issame = True
If LOF(1) <> LOF(2) Then
issame = False
Else
whole& = LOF(1) \ 10000 'number of whole 10,000 byte chunks
part& = LOF(1) Mod 10000 'remaining bytes at end of file
buffer1$ = String$(10000, 0)
buffer2$ = String$(10000, 0)
start& = 1
For x& = 1 To whole& 'this for-next loop will get 10,000
Get #1, start&, buffer1$ 'byte chunks at a time.
Get #2, start&, buffer2$
If buffer1$ <> buffer2$ Then
issame = False
Exit For
End If
start& = start& + 10000
Next
buffer1$ = String$(part&, 0)
buffer2$ = String$(part&, 0)
Get #1, start&, buffer1$ 'get the remaining bytes at the end
Get #2, start&, buffer2$ 'get the remaining bytes at the end
If buffer1$ <> buffer2$ Then
issame = False
End If
Close
CompFile = issame
End Function

编辑网格控制项的方法

网格控制项是VB For Windows提供的一个强有力的自定义控制项,它以网格的形式提供给用户,使用户可以快速直观地显示或编辑数据库、图片库、数组等大型数据集合。

网格中行和列的每一个交点称为单元格,单元格中可以放入文字或图片,用户可以对其中的内容进行读写操作。网格控制项的属性Col和Row指定了当前单元格在网格中的位置,这是对网格进行操作的前提条件。我们可以通过下面三种方法来指定当前单元格:

(1) 利用程序代码来指定;

(2) 运行期间用方向键的移动来指定;

(3) 运行期间用鼠标左键单击单元格来指定。

用Text属性可以引用或设置当前单元格的内容。

网格控制项共有49个属性(Property),14个事件(Event)和7个方法(Method),上文只介绍了和本文有关的属性,其它内容读者可参阅有关书籍。另需说明一点,在应用程序中使用网格控制项之前,必须用File菜单中的AddFile命令在工具箱中加入Grid.VBX文件。

网格控制项的功能非常强大,但令人遗憾的是,它未提供对单元格的编辑功能。用户只能通过对当前单元格的Text属性编程来读写单元格内容,而且这种方法是对静态数据的读写 ,毫无编辑功能可言。

针对上述问题,笔者提出了两种解决方法,取得了较好的应用效果,现分别介绍如下。

表或查询是否存在
表或查询是否存在
在 VB5 中需要 Microsoft DAO 3.x Object Library。

Public Const NameNotInCollection = 3265
Dim DB As Database

Private Function ExistsTableQuery(TName As String) As Boolean

Dim Test As String
On Error Resume Next

' 该名字在表名中是否存在。
Test = db.TableDefs(TName).Name
If Err <> NameNotInCollection Then
ExistsTableQuery = True
' Reset the error variable:
Err = 0
' 该名字在查询中是否存在。
Test = db.QueryDefs(TName$).Name
If Err <> NameNotInCollection Then
ExistsTableQuery = True
End If
End If
End Function

播放 AVI
播放 AVI
声明：
Declare Function mciSendString Lib "winmm.dll" Alias _
"mciSendStringA" (ByVal lpstrCommand As String, ByVal _
lpstrReturnString As String, ByVal uReturnLength _
As Long, ByVal hwndCallback As Long) As Long
代码：
Dim returnstring As String
FileName As String
returnstring = Space(127)
FileName = "C:\A1.avi"
erg = mciSendString("open " & Chr$(34) & FileName & _
Chr$(34) & " type avivideo alias video", returnstring, _
127, 0)
erg = mciSendString("set video time format ms", _
returnstring, 127, 0)
erg = mciSendString("play video from 0", returnstring, _
127, 0)
'记着关闭！
erg = mciSendString("close video", returnstring, 127, 0)

播放 WAV 文件
播放 WAV 文件
Public Declare Function sndPlaySound& Lib "winmm.dll" Alias"sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
Global Const SND_SYNC = &H0
Global Const SND_ASYNC = &H1
Global Const SND_NODEFAULT = &H2
Global Const SND_LOOP = &H8
Global Const SND_NOSTOP = &H10

Sub PlayWav(SoundName As String)
Dim tmpSoundName As String
Dim wFlags%, X%
tmpSoundName = pathWavFiles & SoundName
wFlags% = SND_ASYNC Or SND_NODEFAULT
X% = sndPlaySound(tmpSoundName, wFlags%)
End Sub

播放背景音乐
播放背景音乐 98-7-04
声明：
Declare Function MCISendString& Lib "MMSYSTEM" (ByVal LPSTRCOMMAND$, ByVal LPSTRRETURNSTR As Any, ByVal WRETURNLEN%, ByVal HCALLBACK%)
开始播放：
R% = MCISendString&("OPEN EXAMPLE.MID TYPE SEQUENCER ALIAS NN", 0&, 0, 0)
R% = MCISendString&("PLAY NN FROM 0", 0&, 0, 0)
R% = MCISendString&("CLOSE ANIMATION", 0&, 0, 0)
停止：
R% = MCISendString&("OPEN EXAMPLE.MID TYPE SEQUENCER ALIAS NN", 0&, 0, 0)
R% = MCISendString&("STOP NN", 0&, 0, 0)
R% = MCISendString&("CLOSE ANIMATION", 0&, 0, 0)
其中EXAMPLE.MID 为播放的文件，NN为自定义名称标志。

捕捉 MouseExit 事件
捕捉 MouseExit 事件 98-6-05
MouseDown、MouseUp、MouseMove。VB 似乎提供了很好的 Mouse 事件。但好象还缺少什么！对！还差 MouseExit（鼠标移出）事件。在 VB 中，我们要捕捉 MouseExit 事件，必须用 API 函数：
Private Declare Function SetCapture Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function ReleaseCapture Lib "user32" () As Long
然后，我们可以在控件（以 Picture1 为例）的 MouseMove 事件上加上以下代码：

With Picture1 'Change this to the name of the control
If Button = 0 Then
If (X < 0) Or (Y < 0) Or (X > .Width) Or (Y > .Height) Then
'Mouse pointer is outside button, so let other controls receive
'mouseevents too:
ReleaseCapture
' 放入鼠标离开的代码
Else
' Mouse pointer is over button, so we'll capture it, thus
' we'll receive mouse messages even if the mouse pointer is
' not over the button
SetCapture .hwnd

' 放入鼠标进入的代码
End If

捕捉屏幕图象
捕捉屏幕图象 98-7-05
声明：
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
Private Declare Function SetClipboardData Lib "user32" (ByVal wFormat As Long, ByVal hMem As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateDC Lib "gdi32" Alias "CreateDCA" (ByVal lpDriverName As String, ByVal lpDeviceName As String, ByVal lpOutput As String, lpInitData As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
函数：
Sub ScrnCap(Lt, Top, Rt, Bot)
rWidth = Rt - Lt
rHeight = Bot - Top
SourceDC = CreateDC("DISPLAY", 0, 0, 0)
DestDC = CreateCompatibleDC(SourceDC)
BHandle = CreateCompatibleBitmap(SourceDC, rWidth, rHeight)
SelectObject DestDC, BHandle
BitBlt DestDC, 0, 0, rWidth, rHeight, SourceDC, Lt, Top, &HCC0020
Wnd = Screen.ActiveForm.hwnd
OpenClipboard Wnd
EmptyClipboard
SetClipboardData 2, BHandle
CloseClipboard
DeleteDC DestDC
ReleaseDC DHandle, SourceDC
End Sub
以下的示例把屏幕图象捕捉后，放到Picture1 中。
Sub Command1_Click()
Form1.Visible = False
ScrnCap 0, 0, 640, 480
Form1.Visible = True
picture1 = Clipboard.GetData()
End Sub

不定个数的参数
不定个数的参数如果要传递不定个数的参数给过程，该过程应如下定义：

Sub MySub( ParamArray P() ) '参数定义为一个数组

以下的可能的调用：

MySub "ABC"
MySub 1, 3, 9, 988, 776, 234
MySub 123, "abc", Date()

可用以下的方法来读每个参数：

For i = 0 To UBound(P)
' P(i) 为第 i 个参数
Next

不用 EOF 以加快记录循环
不用 EOF 以加快记录循环 98-8-22
通常我们使用以下的代码进行记录循环：

Do while not records.eof
combo1.additem records![Full Name]
records.movenext
loop

结果是每个循环中数据库都要进行一次数据结束测试。在大量的记录的情况下， 浪费的时间相当大。 而使用以下的代码， 可以提高近 1/3 的速度：

records.movelast
intRecCount=records.RecordCount
records.movefirst

for intCounter=1 to intRecCount
combo1.additem records![Full Name]
records.movenext
next intCounter