VB高手搜集-常见问题总结(1)

如何检查软盘驱动器里是否有软盘

　　使用：
Dim Flag As Boolean
Flag = Fun_FloppyDrive(/"A:/")
If Flag = False Then MsgBox /"A:驱没有准备好，请将磁盘插入驱动器！/", vbCritical

/'-------------------------------
/'函数:检查软驱中是否有盘的存在
/'-------------------------------
Private Function Fun_FloppyDrive(sDrive As String) As Boolean
On Error Resume Next
Fun_FloppyDrive = Dir(sDrive) <> /"/"
End Function

 

　　如何弹出和关闭光驱托盘

Option Explicit
Private 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

Private Sub Command1_Click()
mciExecute /"set cdaudio door open/" /'弹出光驱
Label2.Caption = /"弹 出/"
End Sub

Private Sub Command2_Click()
Label2.Caption = /"关 闭/"
mciExecute /"set cdaudio door closed/" /'合上光驱
Unload Me
End
End Sub

　　如何让你的程序在任务列表隐藏

Private Declare Function RegisterServiceProcess Lib /"kernel32/" (ByVal ProcessID As Long, ByVal ServiceFlags As Long) As Long
Private Declare Function GetCurrentProcessId Lib /"kernel32/" () As Long

/'请你试试 Ctrl+Alt+Del 是不是你的程序隐藏了
Private Sub Command1_Click()
i = RegisterServiceProcess(GetCurrentProcessId, 1)
End Sub

　　如何用程序控制滑鼠游标 (Mouse Cursor) 到指定位置

　　以下这个例子，当 User 在 Text1 中按下 /'Enter/' 键后，滑鼠游标会自动移到 Command2 按钮上方

　　请在声明区中加入以下声明：

　　16 位版本： ( Sub 无传回值 )
Declare Sub SetCursorPos Lib /"User/" (ByVal X As Integer, ByVal Y As Integer)

　　32 位版本： ( Function 有传回值，Integer 改成 Long )
Declare Function SetCursorPos Lib /"user32/" (ByVal x As Long, ByVal y As Long) As Long

　　在 Form1 中加入以下程序码：
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
x% = (Form1.Left + Command2.Left + Command2.Width / 2 + 60) / Screen.TwipsPerPixelX
y% = (Form1.Top + Command2.Top + Command2.Height / 2 + 360) / Screen.TwipsPerPixelY
SetCursorPos x%, y%
End If
End Sub

　　如何让用户自行输入方程式，并计算其结果

　　假设我们要让使用者在“方程式”栏位中自由输入方程式，然后利用方程式进行计算，则引用ScriptControl控件可以很方便地做到。

　　( ScriptControl 控件附属于VB 6.0，如果安装后没有看到此一控件，可在光盘的 //Common//Tools//VB//Script 目录底下找此一控件， 其.文件名为Msscript.ocx。) 假设放在窗体上的ScriptControl控件名称为ScriptControl1，则在“计算”按钮的Click事件中编写如下代码：

Dim Statement As String Statement = /"X=/" + Text1.Text + vbCrLf + _ /"Y=/" + Text2.Text + vbCrLf + _ /"MsgBox /"/"计算结果=/"/" & Y /" ScriptControl1.ExecuteStatement( Statement

 

　　如何让一个 App 永远保持在最上层 ( Always on Top )

　　请在声明区中加入以下声明

Private Declare Function SetWindowPos Lib /"user32/" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Const SWP_NOMOVE = &H2 /'不更动目前视窗位置
Const SWP_NOSIZE = &H1 /'不更动目前视窗大小
Const HWND_TOPMOST = -1 /'设定为最上层
Const HWND_NOTOPMOST = -2 /'取消最上层设定
Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

/'将 APP 视窗设定成永远保持在最上层
SetWindowPos Me.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS

/'取消最上层设定
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS

　　我要如何在程序中开启网页

　　在声明区中声明如下 (在 .bas 档中用 Public, 在 Form 中用 Private)

Private Declare Function ShellExecute Lib /"shell32.dll/" Alias /"ShellExecuteA/" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long

　　在程序中

Intranet：
ShellExecute Me.hWnd, /"open/", /"http://Intranet主机/目录/", /"/", /"/", 5
Internet：
ShellExecute Me.hWnd, /"open/", http://www.ruentex.com.tw, /"/", /"/", 5

　　VB可以产生四角形以外其他形状的 Form 吗

　　这个问题，您一定无法想像有多容易，您可以产生任何形状的 Form，但必须借助 CreateEllipticRgn 及 SetWindowRgn 二个 API ，例如：

Private Declare Function CreateEllipticRgn Lib /"gdi32/" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long

Private Declare Function SetWindowRgn Lib /"user32/" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long

Private Sub Form_Load()
Dim lReturn As Long
Me.Show
lReturn = SetWindowRgn(hWnd, CreateEllipticRgn(10, 10, 340, 150), True)
End Sub

　　CreateEllipticRgn 之四个参数说明如下：
　　X1：椭圆中心点之X轴位置，但以 Form 的实№边界为限。
　　Y1：椭圆中心点之Y轴位置，但以 Form 的实№边界为限。
　　X2：椭圆长边的长度
　　Y2：椭圆短边的长度的

如何移除 Form 右上方之『X』按钮

　　其实 Form 右上方之三个按钮分别对应到 Form 左上方控制盒 (ControlBox) 中的几个选项 (缩到最小 / 放到最大 / 关闭)，而其中的最大化 (MaxButton) 及最小化 (Minbutton) 都可以直接在 Form 的属性中设定，但是 VB 并没有提供设定『X』按钮的功能！要达到这个功能，必须借助 API：

　　由于『X』按钮对应到 ControlBox 的关闭选项，所以我们只要移除系统 Menu (就是ControlBox) 的关闭选项即可！您自己可以先看看您现在使用的 Browser 左上方的系统 Menu，【关闭】选项是在第几个，不是第 6 个！是第 7 个，分隔线也算一个！分隔线才是第 6 个！

　　当我们移除了关闭选项之後，会留下一条很奇怪的分隔线，所以最好连分隔线也一并移除。而 Menu 的 Index 是从 0 开始，分隔线是第 6 个，所以 Index = 5。

　　修正：为了让程序码在 Windows NT 也能运作正常，将各 Integer 型态改成 Long。 89.05.04

　　抓取系统 Menu 的 hwnd
Private Declare Function GetSystemMenu Lib /"user32/" Alias /"GetSystemMenu/" (ByVal hwnd As Long, ByVal bRevert As Long) As Long

　　移除系统 Menu 的 API
Private Declare Function RemoveMenu Lib /"user32/" Alias /"RemoveMenu/" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long

　　第一个参数是系统 Menu 的 hwnd
　　第二个参数是要移除选项的 Index

　　如何用鼠标移动没有标题的 Form，或移动 Form 中的控制项

　　在声明区中放入以下声明：

　　16 位版本： ( Sub 无返回值 )
Private Declare Sub ReleaseCapture Lib /"User/" ()
Private Declare Sub SendMessage Lib /"User/" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, lParam As Long)

　　32 位版本： ( Function 有返回值，Integer 改成 Long )
Private Declare Function ReleaseCapture Lib /"user32/" () 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

　　共用常数：
Const WM_SYSCOMMAND = &H112
Const SC_MOVE = &HF012

　　若要移动 Form，程序码如下：
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Long
i = ReleaseCapture
i = SendMessage(Form1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)
End Sub

　　以上功能也适用于用鼠标在 Form 中移动控制项，程序码如下：
Private Sub Command1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Long
i = ReleaseCapture
i = SendMessage(Command1.hwnd, WM_SYSCOMMAND, SC_MOVE, 0)
End Sub

　　检查文件是否存在

Function FileExists(filename As String) As Integer
Dim i As Integer
On Error Resume Next
i = Len(Dir$(filename))
If Err Or i = 0 Then FileExists = False Else FileExists = True
End Function

　　如何设置对VB数据库连接的动态路径

　　我个人因为经常作一些数据库方面的程序，对于程序间如何与数据库进行接口的问题之烦是深有体会，因为VB在数据库链接的时候，一般是静态，即数 据库存放的路径是固定的，如用VB的DATA，adodc,DataEnvironment 等到作数据库链接时，如果存放数据库的路径被改变的话，就会找不到路经，真是一个特别烦的事。
　　
　　笔者的解决方法是利用app.path 来解决这个问题。

　　一、用data控件进行数据库链接，可以这样：
　　在form_load()过程中放入：
private form_load()
Dim str As String /'定义
str = App.Path
If Right(str, 1) <> /"///" Then
str = str + /"///"
End If
data1.databasename=str & /"//数据库名/"
data1.recordsource=/"数据表名/"
data1.refresh
sub end

　　这几句话的意为，打开当前程序运行的目录下的数据库。
　　
　　你只要保证你的数据库在你程序所在的目录之下就行了。

　　二、利用adodc（ADO Data Control)进行数据库链接：
private form_load ()
Dim str As String /'定义
str = App.Path
If Right(str, 1) <> /"///" Then
str = str + /"///"
End If
str = /"Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=/" & str & /"//tsl.mdb/"
Adodc1.ConnectionString = str
Adodc1.CommandType = adCmdText
Adodc1.RecordSource = /"select * from table3/"
Adodc1.Refresh
end sub

　　三、利用DataEnvironment进行数据库链接
　　
　　可在过程中放入：
On Error Resume Next
If DataEnvironment1.rsCommand1.State <> adStateClosed Then
DataEnvironment1.rsCommand1.Close /'如果打开，则关闭
End If
/'i = InputBox(/"请输入友人编号:/", /"输入/")
/'If i = /"/" Then Exit Sub
DataEnvironment1.Connection1.Open App.Path & /"//userdatabase//tsl.mdb/"
DataEnvironment1.rsCommand1.Open /"select * from table3 where 编号=/'/" & i & /"/'/"
/'Set DataReport2.DataSource = DataEnvironment1
/'DataReport2.DataMember = /"command1/"
/'DataReport2.show
end sub

四、利用ADO(ActiveX Data Objects)进行编程：

　　建立连接：

dim conn as new adodb.connection
dim rs as new adodb.recordset
dim str
str = App.Path
If Right(str, 1) <> /"///" Then
str = str + /"///"
End If
str = /"Provider=Microsoft.Jet.OLEDB.3.51;Persist Security Info=False;Data Source=/" & str & /"//tsl.mdb/"
conn.open str
rs.cursorlocation=aduseclient
rs.open /"数据表名/",conn,adopenkeyset.adlockpessimistic

　　用完之后关闭数据库：
conn.close
set conn=nothing