实现毫秒精度的延时
'Module Code:
Option Explicit
Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long
Declare Function QueryPerformanceCounter Lib "kernel32" _
(lpPerformanceCount As LARGE_INTEGER) As Long
Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
'实现毫秒量级精确延时,(n 毫秒)
Public Sub Wait(ByVal n As Long)
Dim PFrequency As LARGE_INTEGER
Dim Interval As LARGE_INTEGER
Dim Privious As LARGE_INTEGER
Dim Current As LARGE_INTEGER
'获得高精度计数器的频率
QueryPerformanceFrequency PFrequency
'获得高精度运行计数器的值
QueryPerformanceCounter Privious
Current = Privious
Interval.LowPart = (PFrequency.LowPart / 1000) * n
'下面这句可以精确到微秒,好像不太实用,也未必精确到如此地步
'Interval.LowPart = (PFrequency.LowPart / 1000000) * n
Interval.HighPart = 0
'通过比较两次计数器的值差实现高精度延时
Do While (Abs(Current.HighPart * 2 ^ 16) + Current.LowPart) - _
(Abs(Privious.HighPart * 2 ^ 16) + Privious.LowPart) < _
(Abs(Interval.HighPart * 2 ^ 16) + Interval.LowPart)
QueryPerformanceCounter Current
'此句若省略,循环期间其它事就都不能做了
DoEvents
Loop
End Sub
'Form Code:
Option Explicit
Dim l As Long
Private Sub Command1_Click()
l = 0
'对照时钟计时(它并不很精确,这里仅对照而已)
'间隔10毫秒已经很小了
Timer1.Interval = 10
'延时
Wait 5000
'停止计时
Timer1.Interval = 0
MsgBox "你够狠,憋了我5000毫秒才放出来"
End Sub
Private Sub Form_Load()
'共三个控件:一个时钟,一个标签,一个按钮
Command1.Caption = "等待5000毫秒"
Label1.AutoSize = True
Label1.Caption = "这里是时钟计时"
End Sub
Private Sub Timer1_Timer()
l = l + 10
Label1.Caption = l
End Sub
-------------------------------------------------------
VB未公开的三个函数ObjPtr,StrPtr,VarPtr
'Form Code:
'ObjPtr: 返回对象实例私有域的地址
'StrPtr: 返回字符串第一个字的地址
'VarPtr: 返回变量的地址
'使用对象浏览器（Object Browser），你可以发现更多其他对象未公开的细节。
'使用诸如金山游侠之类的游戏修改器可以跟踪到这个变量的地址(查99887766数值)
'需生成EXE,这样容易操作,不会受到VB6干扰
Dim l As Long
Private Sub Command1_Click()
Print "对象实例私有域:", ObjPtr(Command1)
Dim str As String
str = "字符串第一个字的地址:"
Print str, StrPtr(str)
Print "----------------------------------"
Dim ramid As Double
ramid = VarPtr(l)
l = 99887766
Print "变量的内存地址:", VarPtr(l)
Print "转换成十六进制:", Hex(ramid)
Print "变量 l 的值:", l
End Sub
Private Sub Form_Load()
'为了能持久显示,便于查看
Me.AutoRedraw = True
End Sub
'VarPtr用在包含字符串的变量时,可能返回的指针是临时地址(UNICODE转换的缘故)
'StrPtr还是唯一能直观地告诉你空字符串和null字符串的不同的方法。
'对于null字符串(vbNullString)，StrPtr的返回值为0，而对于空字符串，函数的返回值为非零
'详细信息请查阅相关文档
------------------------------------------------------------
'返回阿拉伯数字的中文大写或者普通写法的一个函数
Public Function ChnNumber(Number As Double, _
Optional Capital As Boolean = False, _
Optional Simple As Boolean = False) As String
'返回阿拉伯数字的中文大写或者普通写法
'调用方法例如:Debug.Print ChnNumber(12300.43) '返回:壹萬贰仟叁佰点肆叁
' Debug.Print ChnNumber(12300.43, 1) '返回:一万二千三百点四三
' Debug.Print ChnNumber(12300.43, , 1) '返回:一二三○○点四三
'作者:csdngoodnight
'E-mail:kxufeng@163.com
'Number:阿拉伯数字(12300.43)
'Capital:True为中文大写(壹萬贰仟叁佰点肆叁),默认为False普通(一万二千三百点四三)
'Simple:True为简单排列(壹贰叁零零点肆叁/一二三○○点四三)
If Abs(Number) > CDbl(9.99999999999999E+15) Then
'9999兆9999万9990 or 9999999999999990 or 9.99999999999999E+15
MsgBox "超出这个范围的数字,将会有四舍五入进位情况。" & Space(5) & vbCrLf & _
"难道你...要计算星星的数量?偶帮不了你啦 :(", vbInformation, "老兄:天文数字啊"
'Exit Function
End If
Dim varNumber As Variant
Dim ChnString(1) As String, strClass(1) As String
Dim iNumberLen As Integer, iCapital As Integer
Dim boolZero As Boolean
Dim strTemp As String
Dim i As Integer, j As Integer
strClass(0) = "十百千万亿兆"
strClass(1) = "拾佰仟萬億兆"
ChnString(0) = "○一二三四五六七八九"
ChnString(1) = "零壹贰叁肆伍陆柒捌玖"
varNumber = Split(Format(Number, "0.################"), ".")
iNumberLen = Len(varNumber(0))
If Number < 0 Then
varNumber(0) = Right$((varNumber(0)), iNumberLen - 1)
iNumberLen = iNumberLen - 1
End If
iCapital = Abs(CInt(Capital))
If Simple Then
For i = 1 To iNumberLen
j = CInt(Mid$(varNumber(0), i, 1))
ChnNumber = ChnNumber & Mid$(ChnString(iCapital), j + 1, 1)
Next
If UBound(varNumber) > 0 Then
iNumberLen = Len(varNumber(1))
For i = 1 To iNumberLen
j = CInt(Mid$(varNumber(1), i, 1))
strTemp = strTemp & Mid$(ChnString(iCapital), j + 1, 1)
Next
End If
If Len(strTemp) > 0 Then ChnNumber = ChnNumber & "点" & strTemp
If Number < 0 Then ChnNumber = "[负]" & ChnNumber
Exit Function
End If
If iNumberLen < 2 Then
If iNumberLen = 0 Then varNumber(0) = "0"
ChnNumber = Mid$(ChnString(iCapital), CInt(varNumber(0)) + 1, 1)
Else
For i = 0 To iNumberLen - 1
j = CInt(Mid$(varNumber(0), iNumberLen - i, 1))
strTemp = Mid$(ChnString(iCapital), j + 1, 1)
If j = 0 Then
If boolZero = True Then strTemp = ""
If i Mod 4 = 0 Then
strTemp = ""
boolZero = True
If i > 0 Then
strTemp = Mid$(strClass(iCapital), i / 4 + 3, 1)
If iNumberLen - i > 4 Then
If CInt(Right$(Left$(varNumber(0), iNumberLen - i), 4)) = 0 Then strTemp = ""
End If
End If
End If
If strTemp = "零" And Capital Then boolZero = True
If strTemp = "○" And Not Capital Then boolZero = True
Else
boolZero = False
If i Mod 4 = 0 Then '万亿兆
j = i / 4 Mod 3
If j = 0 Then j = 6 Else j = j + 3 '可能出现的天文数字
If i > 0 Then strTemp = strTemp & Mid$(strClass(iCapital), j, 1)
Else '十百千位
strTemp = strTemp & Mid$(strClass(iCapital), i Mod 4, 1)
End If
End If
ChnNumber = strTemp & ChnNumber
strTemp = ""
Next
End If
'处理小数部分
If UBound(varNumber) > 0 Then
iNumberLen = Len(varNumber(1))
For i = 1 To iNumberLen
j = CInt(Mid$(varNumber(1), i, 1))
strTemp = strTemp & Mid$(ChnString(iCapital), j + 1, 1)
Next
End If
If Len(strTemp) > 0 Then ChnNumber = ChnNumber & "点" & strTemp
If Number < 0 Then ChnNumber = "[负数]" & ChnNumber
End Function
