API调用计算器的例子,实现不同程序的数据交换。此方法同样适用其他OFFICE组件的调用(可能要稍作修改)
基本原理:寻找计算器的EDIT句柄,用SendMessage返回结果,并不算复杂。
模块代码:
Private Declare Function FindWindow Lib "user32" 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
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_SETTEXT = &HC
Function TxtValFrmCal(Ctl As Control, intDecimals As Integer) As Currency
'=======================================================
'功能: 调用计算器并返回结果到指定的控件
'参数: ctl 为需要返回结果的控件名称
' intDecimals 保留小数的位数
'用法: TxtValFrmCal Me.Text1, 3
' ctl 格式须设置为常规数字
'作者: andymark
' QQ : 42503577 Email : ewang11@163.com
'日期: 2008-2-22
'======================================================
Dim CalcHwnd As Long
Dim pResult As String
Dim DblCal As Currency
Dim EditText As String
Dim EditHwnd As Long
Dim Check As Boolean
Dim StrTxt As String
'打开计算器
Shell "calc"
'取计算器窗口句柄
CalcHwnd = FindWindow("SciCalc", vbNullString)
'取计算器显示结果的窗口句柄,通过工具可知道该窗口类名为Edit
EditHwnd = FindWindowEx(CalcHwnd, 0, "Edit", vbNullString)
DoEvents
If IsNumeric(Ctl.Value) And Not IsNull(Ctl.Value) Then
SendMessage EditHwnd, WM_SETTEXT, 0, ByVal CStr(Ctl.Value)
End If
Check = True
'下面主要是检测计算器是否关闭
Do ' 外层循环。
Do While EditHwnd <> 0 ' 内层循环。
CalcHwnd = FindWindow("SciCalc", vbNullString)
EditHwnd = FindWindowEx(CalcHwnd, 0, "Edit", vbNullString)
'判断计算器是否关闭
If EditHwnd = 0 Then ' 如果条件为 True...
Check = False ' 将标志值设置为 False。
Exit Do ' 终止内层循环。
Else
'取计算器的值
EditText = Space(SendMessage(EditHwnd, WM_GETTEXTLENGTH, ByVal 0, ByVal 0))
SendMessage EditHwnd, WM_GETTEXT, ByVal Len(EditText) + 1, ByVal EditText
'临时赋给变量
pResult = EditText
DoEvents '这个起延时作用,否则不能正确返回数值
'判断 pResult的值是否为空,代表是否关闭计算器
If Len(Trim(pResult)) <> 0 Then
If Right((pResult), 1) = "." Then
pResult = Mid(pResult, Len(pResult) - 1)
End If
DblCal = CCur(pResult)
End If
End If
Loop
Loop Until Check = False ' 立即终止外层循环
'控件赋值并按要求四舍五入
' DblCal = CCur(DblCal)
Ctl.Value = RoundToLarger(DblCal, intDecimals)
End Function
Public Function RoundToLarger(dblInput As Currency, intDecimals As Integer) As Currency '四舍五入
Dim strFormatString As String
If dblInput <> 0 Then
strFormatString = "#." & String(intDecimals, "#")
RoundToLarger = Format(dblInput, strFormatString)
Else
RoundToLarger = 0
End If
End Function
窗体代码:
Private Sub Command0_Click()
TxtValFrmCal Me.Text1, 3
End Sub
Private Sub Command5_Click()
TxtValFrmCal Me.Text3, 1
End Sub
Private Sub Command8_Click()
TxtValFrmCal Me.Text6, 2
End Sub