31、某一天的下 (上) 一个星期几是那一天？
参数 : 您相信吗？这个模组的写法比用任何其他的方法快几十倍！参数如下：
1：以那一天为基准日？
2：(Optional) 要找的是星期几？若不指定，预设值为星期六
3：(Optional) 要往前 (过去) 找或往后 (未来) 找？
若不指定，预设值为往后 (未来) 找
程序码
Public Function SpecificWeekday(ByVal D As Date, Optional ByVal WhatDay As VbDayOfWeek = vbSaturday, Optional GetNext As Boolean = True) As Date
SpecificWeekday = (((D - WhatDay + GetNext) \ 7) - GetNext) * 7 + WhatDay
End Function
或许您想知道程序为什么这样写？
您知道吗？在 VB 中，其所有日期函数的基准日 (第0天) 是 1899年12月30日 (星期六)，第一天就是 1899年12月31日 (星期日)，所以 VB 的 WeekDay 函数算法其实就是 (Date - 1) Mod 7 + 1。
返回值
日期
实例 :
我想知道以下日子各是那一天？
上个星期一：SpecificWeekday(Now, vbMonday, False)
下个星期六：SpecificWeekday(Now)
2000年9月9日的下一个星期五：SpecificWeekday("09/09/2000", vbFriday)
32、移除字串中不要的字符
参数 : 1：要检查的字串 [准备移除其中某些字符]
2：要移除的字符 (数字/中英文)
程序码
Function StringCleaner(s As String, Search As String) As String
Dim i As Integer, res As String
res = s
Do While InStr(res, Search)
i = InStr(res, Search)
res = Left(res, i - 1) & Mid(res, i + 1)
Loop
StringCleaner = res
End Function
返回值 移除某些字符后的字串
实例 :
我想移除 Text1 中的字符 "A"
Text1 = StringCleaner(Text1, "A")
33、通往 Internet 的捷径---捷径档的结构
有些软件 Setup 完后, 会在程序集或桌面上产生一个 "捷径" (ShortCut), 直接一点就可以进到特定的网页, 用 VB 要如何做才可以做到? 难吗?
不难!! 其实只要稍为观查一下该捷径的档案内容, 就可以做到了.
捷径档的副档名是 .url, 当然, 如果您直接用记事本去开启 .url 档, 一定会很失望, 因为很多软件的捷径档, 都是存成 Binary 的档案 (不知是否故意的), 不过别担心, 那只是障眼法而已.
捷径档和 VB 的 .Frm 档一样, 不管是 AscII / Binary 都可以.我们自己要产生的, 只要做成一般文字档就可以了, 而捷径档的格式如下 :
[InternetShortcut]
URL=http://网址 (Internet/ Intranet 通用)
然后随便存一个档名, 例如 "润泰网站.url", 只要副档名是 .url 即可.
而且 Win95/Win98 很聪明, 会自动将副档名拿掉. 只 Show 出 "润泰网站"
很简单吧!!! 就算您的机器不能连上 Internet, 您也可以马上感受一下 Intranet 的功能.
[InternetShortcut]
URL=http://Intranet主机/目录
如果您连用 VB 写文字档都懒的话, 直接用记事本编辑也可以体验一下的 !!!
34、Bug：维护 Internet Transfer Control 之 Username 及 Password
由于 Bug，在使用 Internet Transfer Control 时，Username 及 Password 必须设定在 URL 之后，否则无效！以下的程序码是错的：
Inet1.Password = "Chicken_Feet"
Inet1.UserName = "JohnnyW"
Inet1.URL = FTP://ftp.32X.com
Inet1.Text = Inet1.OpenURL
但是如果改成以下之程序，将 URL 放到最前面，就可以正常执行：
Inet1.URL = FTP://ftp.32X.com
Inet1.Password = "Chicken_Feet"
Inet1.UserName = "JohnnyW"
Inet1.Text = Inet1.OpenURL
35、我要如何在程序中开启网页？
在声明区中声明如下 (在 .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
很简单吧!!! 就算您的机器不能连上 Internet, 您也可以马上感受一下 Intranet 的功能.
36、如何让表单一开始就显示在荧幕中央？ （含工作列）
共有二种方法
方法1: VB3/VB4之版本，可于 Form_Load() 程序中加入下列程式码：
Me.Move (Screen.Width-Width)\2, (Screen.Height-Height)\2
方法2:
VB5以上之版本，则直接将 Form 之 StartUpPosition 设成 (2-荧幕中央) 即可
37、如何让表单一开始就显示在荧幕中央？ （不含工作列）
以下之程序在计算时会扣除工作列所占的高度 (或宽度)，如果有启动 Microsoft Office 的快捷列的话，也会扣除快捷列所占的高度 (或宽度)。
Public Const SM_CXFULLSCREEN = 16
Public Const SM_CYFULLSCREEN = 17
#If Win32 Then
Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
#Else
Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
#End If
Public Sub CenterForm(frm As Form)
frm.Left = Screen.TwipsPerPixelX * GetSystemMetrics(SM_CXFULLSCREEN) / 2 - frm.Width / 2
frm.Top = Screen.TwipsPerPixelY * GetSystemMetrics(SM_CYFULLSCREEN) / 2 - frm.Height / 2
End Sub
只要在 Form_Load 中使用 CenterForm Me 即可
38、MDI Form可否跟一般的表单一样设定背景颜色 (BackColor)？
VB3 以前的版本：不行。MDI Form没有此一功能。
VB4 / VB5 / VB6 ：可以直接在属性表中设定！
39、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：椭圆短边的长度的
40、如何让一个 Form 出现在另一个非 MDIForm 的 Form 中？
假设要将 Form2 放在 Form1 中，请在宣告区中宣告：
Declare Function SetParent Lib "user32" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
在 Form2 中的 Form_Load 中加入 SetParent(Me.hWnd, Form1.hWnd) 即可。
但有一点要注意的是，在 Unload Form1 之前一定要先 Unload Form2。
41、如何产生渐层的 Form 背景？
在 Form_Load 中加入以下程序码
Sub Form_Load()
Form1.AutoRedraw = True
'使 Form 物件的自动重绘有效
Form1.DrawStyle = 6
'直线的样式为内实线 (6-vbInsideSolid)
Form1.DrawMode = 13
'copy Pen-由 ForeColor 属性指定的颜色。(13-vbCopyPen)
Form1.DrawWidth = 2
'输出的线宽为 2 像素 (Pixel)
'为绘图或列印建立一自订的座标比例尺
'图形像素为显示器或印表机解析度的最小单位
Form1.ScaleMode = 3
'设定物件座标的量测单位为像素 (3-VbPixels)
Form1.ScaleHeight = (256 * 2)
'设定垂直量测单位值为 512
For i = 0 To 255
Form1.Line (0, Y)-(Form1.Width, Y + 2), RGB(0, 0, i), BF
Y = Y + 2
Next i
'RGB(red, green, blue)
'B : 使一方块用一指定方块对角的座标画出
'F : 指定此方块系以用来画方块的色彩来加以填满 (有B才可用F)
End Sub
42、Set FormName = Nothing
语法：Set objectvar = {[New] objectexpression | Nothing}
Nothing 为选择性引数。停止 objectvar 和任何特定物件的关连。指定 objectvar 为 Nothing，会在没有其它变数引用时，释放所有与先前物件有关的系统和内存资源。
当 objectvar 设定成 FormName 时，会将该 Form 中所有占用内存的物件所占用的内存通通释放。
虽然有人说 VB 在 Form Unload 时会自动释放内存，但是并不是全部!!
就像有人说, VB 程序要 Make EXE 之前最好先结束 VB, 重新载入该 Project 再 Make EXE, 结果执行档会比较小, 为什么 ? 就是少了一些在内存中的垃圾 !!
43、如何移除 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
44、如何制作透明的表单 (Form)？
请在声明区中放入以下声明
Const GWL_EXSTYLE = (-20)
Const WS_EX_TRANSPARENT = &H20&
Const SWP_FRAMECHANGED = &H20
Const SWP_NOMOVE = &H2
Const SWP_NOSIZE = &H1
Const SWP_SHOWME = SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE
Const HWND_NOTOPMOST = -2
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
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
在 Form_Load 使用的范例如下：
Private Sub Form_Load()
SetWindowLong Me.hwnd, GWL_EXSTYLE, WS_EX_TRANSPARENT
SetWindowPos Me.hwnd, HWND_NOTOPMOST, 0&, 0&, 0&, 0&, SWP_SHOWME
Me.Refresh
End Sub
45、在抓取资料库之资料前先计算资料总笔数
Sub Form1_Load()
Dim db As Database
Dim ds As Snapshot
Dim iNum As Integer '总笔数
Dim wsql As String 'SQL字串
wsql = "Select Count (*) from Authors Where AU_ID > 10"
Set db = OpenDatabase("c:\vb\biblio.mdb")
Set ds = db.CreateSnapshot(wsql)
iNum = ds(0)
MsgBox "总笔数为 " + Str$(iNum)
End Sub
怎么样，是不是一样呢，只差在一个是 ADO，一个是 DAO 而已！
46、程序启动时，如何自动判断 Access 资料库是否损毁并自动修复？
若程序使用 Access 资料库开发，当 Access 资料库损毁时，一进入程序，便会出现以下讯息：
Can't open database 'name'. It may not be a database that your application recognizes, or the file may be corrupt. (Error 3049)
若是程序中未加入错误判断，程序便会中断跳出，这会给予使用者极不好的印象，要避免这种情形，甚至不让使用者发现资料库损毁，便要加入以下之程序码加以判断：
Private Sub Form_Load()
Dim db As Database
On Error GoTo error1
Set db = OpenDatabase("c:\test.mdb")
On Error GoTo 0
: '正常程序开始
:Exit Sub
error1:
If Err = 3049 Then '资料库损毁
DBEngine.RepairDatabase "C:\test.mdb"
Resume
Else
MsgBox Err & Error(Err)
End If
47、如何让程序在 Windows 启动时自动执行？
有以下二个方法：
方法1: 直接将快捷方式放到启动群组中。
方法2:
在注册档 HKEY_LOCAL_MACHINE 中找到以下机码
\Software\Microsoft\Windows\CurrentVersion\Run
新增一个字串值，包括二个部份
1. 名称部份：自己取名，可设定为 AP 名称。
2. 资料部份：则是包含 '全路径档案名称' 及 '执行参数'
例如：
Value Name = Notepad
Value Data = c:\windows\notepad.exe
48、如何让程序在新 User Login 时自动执行？
在注册表中 HKEY_CURRENT_USER 找到以下代码
\Software\Microsoft\Windows\CurrentVersion\Run
新增一个字串值，包括二个部份
1. 名称部份：自己取名，可设定为 AP 名称。
2. 资料部份：则是包含 '全路径档案名称' 及 '执行参数'
例如：
Value Name = Notepad
Value Data = c:\windows\notepad.exe
49、已将 TextBox 的 Alignment 属性设为「1-靠右对」(1-RightJustify)，但文字却未向右靠？
欲将 TextBox 内的文字向右靠，除了将 Alignment 属性设为「1-靠右对 」之外，亦 将 MultiLine 属性设为 True。
但是若您希望只有单行，不要多行，则必须判断 User 是否按了 Enter Key，那只好在 TextBox 的 KeyPress 中加入以下程序码，以去除 Enter 的作用：
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = vbKeyReturn Then
KeyAscii = 0
End If
50、在 TextBox 中如何限制只能输入数字？
参考下列程序：
Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < 48 Or KeyAscii > 57 Then
KeyAscii = 0
End If
End Sub
51、我希望 TextBox 中能不接受某些特定字符，例如 '@#$%"，有没有简单一点的写法？
方法有好几种, 以下列举二种：
方法1:
可以使用 IF 或 Select Case 一个个判断, 但如果不接受的字符多时, 较麻烦!
方法2:
将要剔除的字符统统放在一个字串中，只要一个 IF 判断即可 !! 如下：
Private Sub Text1_KeyPress(KeyAscii As Integer)
Dim sTemplate As String
sTemplate = "!@#$%^&*()_+-=" '用来存放不接受的字符
If InStr(1, sTemplate, Chr(KeyAscii)) > 0 Then
KeyAscii = 0
End If
End Sub
52、如何让鼠标进入 TextBox 时自动选定 TextBox 中之整串文字？
这个自动选定反白整串文字的动作，会使得输入的资料完全取代之前在 TextBox 中的所有字符。
Private Sub Text1_GotFocus()
Text1.SelStart = 0
Text1.SelLength = Len(Text1)
End Sub
53、如何让 TextBox 由 Insert 模式变成 Overwrite 模式？
Windows 的 TextBox 一直都只支援 Insert Mode，而不支援 OverStrike(OverWrite) Mode，其实，只要在 Key_Press 事件中加上几行指令，就可以做到 OverStrike 功能 !!
以下的程式码中，只设定 SelLength=1，而 SelStart 若未指定则会一直跟著滑鼠的游标所在处，设定 SelLength=1 会反白游标所在处的下一个字，但是由于您输入的字元会直接取代该反白的字元(都同时在 Key_Press 发生)，所以您并不会看到字符被选定反白 (Marked)，若是游标已在字串的最后面，则会直接忽略这个动作。
以下的程式码中同时也作了以下的错误判断及预防：
1. 当输入的是退格符，也就是 Backspace (character 8)。
2. 当输入的是 return 键 (character 13)。
3. 事先已作了选定动作 (Marked)。
Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii <> 8 And KeyAscii <> 13 And Text1.SelLength = 0 Then
Text1.SelLength = 1
End If
End Sub
54、如何使 TextBox 变成只读，卷动杆可卷动，但是不出现游标，也不可被选定反白？
在 Form 中放一个 TextBox，设定 Locked = True，MultiLine = True，ScrollBar = 2 - Vertical。另外再放一个 CommandButton (或其他任何可接受 Focus 的物件)，此物件可由您自行作其他用途，否则设定 Command1.left = -1000 将其移到 Form 的外面。
程式码如下：
Private Sub Text1_GotFocus()
'马上将 Text1 的 focus 转移到 Command1 或其他物件上
Command1.SetFocus
End Sub
55、文字框可以设定快捷键吗？
不行，要设定快捷键的先决条件，是该物件必须有 Caption 属性，但是 TextBox (文字框) 只有 Text 属性，并无 Caption 属性，所以文字框本身是不能设定快捷键的！完全没办法吗？
但是还是有办法的！人家说山不转路转，文字框本身不能设定快捷键，一般我们在文字框的左方都会放置说明用的 Label，那我们就借用 Label 来做到这个功能，作法如下：
1、将文字框的 TabIndex 设成说明用的 Label 物件的下一个。
2、设定 Label 物件的快捷键，奇怪吗？Label 物件没有 Focus 好像不要快捷键！没错，我们就是要利用 Label 物件不要快捷键的特性来达到我们的要求！
当您输入了 Label 物件的快捷键，由于 Label 物件没有 Focus 不接受快捷键，于是它立刻将 Focus 送到下一个 TabIndex 的物件，也就是 TextBox 文字框了！
56、如何检查软盘驱动器里是否有软盘？
使用：
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
57、如何弹出和关闭光驱托盘？
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
58、如何计算出本月的最后一天
首先为下个月的第一天生成一个顺序数值，然后再减去一天
Private Sub Command1_Click()
Dim dtl As Date
dtl = DateSerial(Year(Now), Month(Now) + 1, 1) - 1
MsgBox dtl
End Sub
59、如何让你的程序在任务列表隐藏
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
评论