86、处理加了密码的
Access 资料库
87、如何取消 TextBox
鼠标右键的 PopupMenu 功能
88、如何在 Menu
中加入美美的图案？
89、如何把小图片填满 Form
成为背景图？
90、如何把小图片填满
MDIForm 成为背景图？
86、处理加了密码的 Access 资料库
当 Access 资料库加了密码，直接由 Access
开启资料库时，会出现密码问话框，询问密码。但是若要由 VB 程序中开启，必须更改 VB
程序中开启资料库的指令，否则会出现错误讯息！以下针对各种状况，分别加以说明：
1、 使用 DAO
语法开启资料库：OpenDatabase
若要由程序中开启，语法如下：
Set DB =
OpenDatabase(DatabaseName, False, False, ";Pwd=密码")
实例例如：
Dim db As
Database
Set db = OpenDatabase("C:\db1.mdb", False, False,
";Pwd=1")
若要使用 Data 控制项，设定方法如下：
1、设定 DatabaseName 属性 (资料库名称 /
含路径)
2、设定 Connect 属性，将预设的字串 "Access" 改成 ";Pwd=密码" (不含双引号)
3、设定
RecordSource 属性 (资料集)
2、
使用 ADO
语法开启资料库：
在使用 ADODC 或 DataEnvironment 设定好连线之后，直接利用属性视窗修改
ConnectionString 属性(附属于 ADODC) 或 ConnectionSource 属性(附属于 DataEnvironment 的
Connection 物件)，修改的方法是在属性之后增加以下参数：
;Jet OLEDB:Database
Password=密码
除了 ADODC 及 DataEnvironment 之外， 直接使用 ADO 物件来开启含有密码的 mdb
资料库，设定参数的方法也是相同的。
3、
压缩加了密码的资料库：CompactDatabase
DBEngine.CompactDataBase
"原资料库档名", "新资料库档名", , , ";pwd=密码"
实例例如：
DBEngine.CompactDatabase
"C:\Db1.mdb", "C:\Db2.mdb", , ,
";pwd=1"
4、
修复加了密码的资料库：
RepairDatabase
不必理会资料库设定的密码！
DBEngine.RepairDataBase
"资料库档名"
实例例如：
DBEngine.RepairDataBase
"C:\Db1.mdb"
87、如何取消 TextBox 鼠标右键的
PopupMenu 功能
自从 Microsoft Windows 进入
Windows95 之后，有一个很方便的功能，很多软件都有提供，就是鼠标右键的 PopupMenu
功能，它确实很方便，但是有时却是梦魇，那就是您不需要它的时候，它还是会自动出现！本例中的 TextBox
就是明显的例子。
但是这个梦魇从 VB5.0 以后就可以解决了，因为 VB5.0 提供了 AdressOf
这个运算子，可以做回呼(callback)处理！
请将以下的程序码放在 .bas 模组中，呼叫 Hook 这个 Sub 并传入
TextBox 的 hWnd 当作参数，但是切记您在 Unload Form 之前一定要呼叫 UnHook 这个 Sub，否则会产生一个
General Protection Fault！
Declare Function CallWindowProc Lib
"user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hWnd
As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long
Declare Function SetWindowLong Lib "user32" Alias
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal
dwNewLong As Long) As Long
Public Const GWL_WNDPROC = -4
Public
Const WM_RBUTTONUP = &H205
Public lpPrevWndProc As Long
Private
lngHWnd As Long
Public Sub Hook(hWnd As Long)
lngHWnd =
hWnd
lpPrevWndProc = SetWindowLong(lngHWnd, GWL_WNDPROC, AddressOf
WindowProc)
End Sub
Public Sub UnHook()
Dim lngReturnValue As
Long
lngReturnValue = SetWindowLong(lngHWnd, GWL_WNDPROC,
lpPrevWndProc)
End Sub
Function WindowProc(ByVal hw As Long,
ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As
Long
Select Case uMsg
Case WM_RBUTTONUP
'Do nothing
'Or popup
you own menuCase Else
WindowProc = CallWindowProc(lpPrevWndProc, hw,
uMsg, wParam, lParam)
End Select
End Function
在 Form_Load
事件中加入以下程序码：
Call Hook(Text1.hWnd)
在 Form_Unload
中加入以下程序码：
Call UnHook
88、如何在 Menu
中加入美美的图案？
在模组中加入以下程序码：
Declare
Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Declare
Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long)
As Long
Declare Function GetMenuItemID Lib "user32" (ByVal hMenu As
Long, ByVal nPos As Long) As Long
Declare Function
SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As
Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal
hBitmapChecked As Long) As Long
Public Const MF_BITMAP =
&H4&
Type MENUITEMINFO
cbSize As Long
fMask As
Long
fType As Long
fState As Long
wID As Long
hSubMenu As
Long
hbmpChecked As Long
hbmpUnchecked As Long
dwItemData As
Long
dwTypeData As String
cch As Long
End Type
Declare
Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As
Long
Declare Function GetMenuItemInfo Lib "user32" Alias
"GetMenuItemInfoA" (ByVal hMenu As Long, ByVal un As Long, _
ByVal b As
Boolean, lpMenuItemInfo As MENUITEMINFO) As Boolean
Public Const
MIIM_ID = &H2
Public Const MIIM_TYPE = &H10
Public Const
MFT_STRING = &H0&
在 Form 中加入一个
PictureBox，属性设定为：
AutoSize = True
Picture = .bmp (尺寸大小为 13x13，不可设定为
.ico)
在 Form_Load 中的程序码如下：
Private Sub Form_Load()
'取得程序中
Mennu 的 handle
hMenu& = GetMenu(Form1.hWnd)
'取得第一个 submenu 的
handle
hSubMenu& = GetSubMenu(hMenu&, 0)
'取得 Submenu 第一个选项的
menuId
hID& = GetMenuItemID(hSubMenu&,
0)
'加入图片
SetMenuItemBitmaps hMenu&, hID&, MF_BITMAP,
Picture1.Picture, Picture1.Picture
'在一个 Menu 选项中您一共可以加入二张图片
'一张是
checked 状态用，一张是 unchecked 状态用
End Sub
89、如何把小图片填满 Form 成为背景图？
对于这个问题，我看过很多方法，有的方法很麻烦，要声明一大堆 Type，用一大堆的
API，但是有一个最笨但我认为最好的方法如下： (就好像拼磁砖一样，不用任何 API, 不必声明任何 Type)
在 Form
中放一个 PictureBox，Picture 属性设定为某一张小图，AutoSize 属性性设定 True，完成的模组如下：
Sub
PictureTile(Frm As Form, Pic As PictureBox)
Dim i As Integer
Dim t
As Integer
Frm.AutoRedraw = True
Pic.BorderStyle = 0
For t = 0 To
Frm.Height Step Pic.ScaleHeight
For i = 0 To Frm.Width Step
Pic.ScaleWidth
Frm.PaintPicture Pic.Picture, i, t
Next i
Next
t
End Sub
PictureTile 这个模组共有二个参数，第一个是表单名称，第二个则是 PictureBox
的名称。以下为一应用实例：
Private Sub Form_Load()
PictureTile Me,
Picture1
End Sub
90、如何把小图片填满 MDIForm
成为背景图？
以下这个范例， 要：
1、一个
MDIForm：不必设定任何属性。
2、一个 Form1：不一定是 MDIChild，最好 MDIChild 为 False，但是
AutoRedraw 设成 True。
3、Form1 上面放一个隐藏的 PictureBox：名称为 Picture1，不必设定
Picture 属性。
4、一张图片的完整路径。
'将以下模组放入 MDIForm 的声明区中：
Sub
TileMDIBkgd(MDIForm As Form, bkgdtiler As Form, bkgdfile As String)
If
bkgdfile = "" Then Exit Sub
Dim ScWidth%, ScHeight%
ScWidth% =
Screen.Width / Screen.TwipsPerPixelX
ScHeight% = Screen.Height /
Screen.TwipsPerPixelY
Load bkgdtiler
bkgdtiler.Height =
Screen.Height
bkgdtiler.Width = Screen.Width
bkgdtiler.ScaleMode =
3
bkgdtiler!Picture1.Top = 0
bkgdtiler!Picture1.Left =
0
bkgdtiler!Picture1.Picture =
LoadPicture(bkgdfile)
bkgdtiler!Picture1.ScaleMode = 3
For n% =
0 To ScHeight% Step bkgdtiler!Picture1.ScaleHeight
For o% = 0 To
ScWidth% Step bkgdtiler!Picture1.ScaleWidth
bkgdtiler.PaintPicture
bkgdtiler!Picture1.Picture, o%, n%
Next o%
Next
n%
MDIForm.Picture = bkgdtiler.Image
Unload bkgdtiler
End
Sub
以下为一应用实例：
Private Sub MDIForm_Load()
TileMDIBkgd Me,
Form1, "c:\windows\Tiles.bmp"
End
Sub |