VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)
首页 - 经验之谈 - VB问题全功略(18)
发表评论(0)作者:不详, 平台:VB6.0+Win98, 阅读:10477, 日期:2002-01-27
VB问题全功略(18)

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