Sendkeys 和 Sendmessage 使用技巧一例
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Function sqrx(ByVal x As Double) As String '计算平方根(比VB DOUBLE 类型精度高)
Dim temp As String, i As Long, j As Long
Shell "Calc.EXE", vbMinimizedNoFocus '运行计算器
temp = x & "y0.5="
For i = 1 To Len(temp)
SendKeys Mid(temp, i, 1), True '向计算器顺序发送按键消息X (X^Y) 0.5=
Next
temp = String(64, Chr(0))
i = FindWindow(vbNullString, "计算器") '窗口句柄
j = FindWindowEx(i, ByVal 0&, "Edit", vbNullString) '编辑框句柄
SendMessage j, &HD, Len(temp), ByVal temp '发送编辑框文本至temp
SendKeys "%{F4}", True '调用ALT+F4关闭计算器窗口
sqrx = temp
End Function
Private Sub Command1_Click()
Dim i As Integer
For i = 17 To 24
Debug.Print "sqrx(" & i & ")=" & sqrx(i)
Next
End Sub
自解,代码写出来大家看看,还有什么更好的改进意见:
Public Function sqrx(dInput)
Dim a, max, min
a = (dInput + 1) / 2
max = a
min = 0
Do Until Abs(a * a - dInput) <= 3E-28 '精度数值,事实上经过测试,精度数值调整到5E-28可以得到同样的答案,但最佳数值在测试中是3E-28
If a * a > dInput Then
max = a
ElseIf a * a < dInput Then
min = a
ElseIf a * a = dInput Then
Exit Do
End If
a = (min + max) / 2
Loop
sqrx = a
End Function