登录  
 加关注
查看详情
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

面包会有的

... ...

 
 
 

日志

 
 

VB使用大全 - 3  

2007-09-08 14:17:55|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

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

  评论这张
 
阅读(637)| 评论(0)

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2018