光标处插入字符串
光标处或在选择处插入一个特定的字符:
Text1.SelText = "<br>"
在选择处两头分别加上特定的字符:
Text1.SelText = "<br>" & Text1.SelText & "<br>"
取得 DOS 环境变量 98-9-01
使用 Environ 函数:
Dim x As Integer
Dim Env As String
x = 1
Env = Environ(x)
Do Until Env = ""
Env = Environ(x)
Debug.Print Env
x = x + 1
Loop
定义函数:
Public Function Delay(Mins%, Secs%, Optional ByRef StopFlag) As Long
Dim EndOfDelay
EndOfDelay = DateAdd("n", Mins, Now)
EndOfDelay = DateAdd("s", Secs, EndOfDelay)
Delay = 0
Do While (Now < EndOfDelay)
DoEvents
If Not IsMissing(StopFlag) Then
If StopFlag Then
Delay = 1
StopFlag = False
Exit Do
End If
End If
Loop
End Function
使用例子:
Dim StopTheTimer As Boolean
Private Sub Command1_Click() '开始延时
Dim lRetval&
lRetval = Delay(1, 5, StopTheTimer)
If lRetval = 0 Then
MsgBox "时间到!"
Else
MsgBox "取消延时!"
End If
End Sub
Private Sub Command2_Click() '取消延时
StopTheTimer = True
End Sub
在字符串中使用双引号 98-7-16
使用 Chr$(34) 连接是个办法,用 "" 更简单。
如: MyName = "我的名字是 ""Ken""。"
奇数和偶数校验 98-7-16
If i% And 1 Then
'奇数
Else
'偶数
End If
又 :偶数校验:
bool_IsEven = int_Number MOD 2 = 0
bool_IsEven = int_Number AND 1 = 0
015 生成不同的8 位口令 98-7-01
Function GenPass() As String
i = 0
UseChar = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
word = ""
Randomize
For i = 1 To 8
word = word + Mid(UseChar, Len(UseChar) * Rnd + 1, 1)
Next i
GenPass = word
End Function
014 利用集合过滤重复的值 98-6-07
Dim i As Long
Dim RawData As String
Dim DataValues As New Collection
On Error Resume Next
' 忽略 error 457 - Duplicate key
For i = LBound(arr) To UBound(arr)
RawData = arr(i)
DataValues.Add RawData, RawData
Next
On Error GoTo 0
' 放到 ListBox 中
lstSortedData.Clear
For Each DataValue In DataValues
lstSortedData.AddItem DataValue
Next
不定个数的参数
如果要传递不定个数的参数给过程,该过程应如下定义:
Sub MySub( ParamArray P() ) '参数定义为一个数组
以下的可能的调用:
MySub "ABC"
MySub 1, 3, 9, 988, 776, 234
MySub 123, "abc", Date()
可用以下的方法来读每个参数:
For i = 0 To UBound(P)
' P(i) 为第 i 个参数
Next
混合字符串的长度
在中文环境下,每个字被当做两个 Byte :
Len("汉1") = 2
LenB("汉1") = 4
但在许多情况下,我们希望中文字长度为 2,英文字符为 1。可用以下的函数:
LenB(StrConv("汉1"), vbFormUnicode))
009 取得应用所在的目录 98-7-04
使用 App.Path 可以得到应用所在的目录。不过得注意,当在根目录下时,Path 的返回值最右字符为 “\” ,如“c:\”,而如果不在根目录,则最右字符非 “\”,如“c:\vb5”。所以在使用 Path 做连接时,应使用以下的代码:
Dim FileName as string
Dim fullpath As String
If Right(App.Path, 1) = "\" Then
fullpath = App.Path + FileName
Else
fullpath = App.Path + "\" + FileName
End If
或者:
pth$ = app.Path & IIf(Len(app.Path) > 3, "\", "")
清除字符串中指定的字符
该函数在字符串 s 中清除 Search(注意:如果 s 为 AAABBB,Search 为 AB。如何?) :
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
闰年测试
Function IsLeap(sYear As String) As Integer
If IsDate("02/29/" & sYear) Then
IsLeap = True
Else
IsLeap = False
End If
End Function
Val 与 CDbl
Print Val("12345")
12345
Print Val("12,345")
12
Print CDbl("12,345")
12345
Print CDbl("12345")
12345
计算年龄
Function CalcAge(datEmpDateOfBirth as Variant) as Integer
CalcAge = Int(DateDiff("y",datEmpDateOfBirth,Date())/365.25)
End Function
怎样关闭一个正在运行的程序
你可以使用API函数FindWindow和PostMessage去寻找指定的窗口,并关闭它。下面的例子教给你怎样找到并关掉一个Caption为“Caluclator”的程序。
Dim winHwnd As Long
Dim RetVal As Long
winHwnd = FindWindow(vbNullString, "Calculator")
Debug.Print winHwnd
If winHwnd <> 0 Then
RetVal = PostMessage(winHwnd, WM_CLOSE, 0&, 0&)
If RetVal = 0 Then
MsgBox "置入消息错误!"
End If
Else
MsgBox "Calculator没有打开!"
End If
为了让以上的代码工作,你必须在模块文件中什么以下API函数:
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function PostMessage Lib "user32" Alias _
"PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Public Const WM_CLOSE = &H10
确定我的程序是否在运行?
把以下代码放在第一个窗体的Form_Load事件中:
If App.PrevInstance = True Then
Call MsgBox("这个程序正在运行!",_
vbExclamation)
End
End If
找到鼠标指针的XY坐标?
在很多的作图软件中都有一个小的区域显示当前屏幕上的光标位置,这利用API函数非常容易做到,下面的例子将演示使用代码如何返回当前光标的XY的坐标值。
步骤:
在VB5中建立一个新项目文件,Form1使用默认设置.
选择菜单的“Project/add Module”,建立一个新的模块文件“Moudule1”。
输入以下代码声明API函数。
Option Explicit
Type POINTAPI ' Declare types
x As Long
y As Long
End Type
Declare Function GetCursorPos Lib "user32" _
(lpPoint As POINTAPI) As Long ' Declare API
把焦点移到Form1,添加两个标签对象(Label)和一个计时器对象(Timer1),把计时器的Interval属性设为1,然后双击Form1的任何区域,在代码窗口中输入:
Option Explicit
Dim z As POINTAPI ' 声明变量
Private Sub Timer1_Timer()
GetCursorPos z ' 得到坐标
Label1 = "x: " & z.x ' 得到X坐标
Label2 = "y: " & z.y ' 得到Y坐标
End Sub
总处于屏幕最前方?(Always on top)
如果你想让你的程序处于前方,可以使用以下代码:
Form1.ZOrder
配合计时器使用,每隔一段很小的时间间隔调用这种方法可以使窗体Form1处于屏幕前方,但是用户还是可能使别的窗体在短暂的时间里处于Form1的上方。所以这种方法并不能使窗体真正的实现Always on top,而要真正的Always on top可以使用API函数SetWindowPos,代码如下:
'声明函数:
Declare Function SetWindowPos Lib "user32" _
(ByVal h%, ByVal hb%, ByVal x%, ByVal y%, _
ByVal cx%,ByVal cy%,ByVal f%) As Integer
Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2
'把窗体放在最前面:
res% = SetWindowPos (Form1.hWnd, HWND_TOPMOST, _
0, 0, 0, 0, FLAGS)
'如果res%=0, 就产生错误
'使窗体恢复普通模式:
res% = SetWindowPos (Form1.hWnd, HWND_NOTOPMOST, _
0, 0, 0, 0, FLAGS)
得到当前的屏幕分辨率?
在程序设计中我们经常要改变窗体的大小,而这也依赖于屏幕的分辨率,下面的例子将演示如何得到当前屏幕的分辨率:
ResWidth = Screen.Width \ Screen.TwipsPerPixelX
ResHeight = Screen.Height \ Screen.TwipsPerPixelY
ScreenRes = ResWidth & "x" & ResHeight
ResWidth和ResHeight分别表示屏幕的宽和高,比如这样的结果:
800x600
得到Windows系统的目录?
如果你的程序用到ini文件,那么储存它们最好的地方就是Windows目录,下面的例子向你展示如何得到Windows目录。
声明以下函数:
Public Const MAX_PATH = 260
Declare Function GetWindowsDirectory Lib "kernel32" Alias _
"GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal _
nSize As Long) As Long
代码如下:
Public Function GetWinPath()
Dim strFolder As String
Dim lngResult As Long
strFolder = String(MAX_PATH, 0)
lngResult = GetWindowsDirectory(strFolder, MAX_PATH)
If lngResult <> 0 Then
GetWinPath = Left(strFolder, InStr(strFolder, _
Chr(0)) - 1)
Else
GetWinPath = ""
End If
End Function
请看下面的例子如何使用函数:
Call MsgBox("The Windows directory is " & GetWinPath, _
vbInformation)
得到磁盘序号?
当磁盘被格式化过之后,操作系统就会在它上面留下磁盘的序号。虽然这个序号并不唯一,当对于一个32位的整数来说,很少有机会能看到两个相同�
vb1.rar_其他
版权申诉
113 浏览量
2022-09-24
00:19:54
上传
评论
收藏 5KB RAR 举报
四散
- 粉丝: 54
- 资源: 1万+