Messing about with Calculator...

Jaafar Tribak · Sep 6, 2006

Hi all,

I have a button on a userform which simply launches the Windows Calculator exe so the user can use it to do some calculations.

When the user is done and the calculator is closed,I want the computed result on the calculator to be automatically transfered on a label located on the userform .

I know how to halt the execution of the vb code until the calculator is closed using the WaitForSingleObject function but I can't transfer the calculator result onto the userform.

Any thoughts ?.

Regards.

Jaafar Tribak · Sep 8, 2006

Thanks everyone and sorry I didn't get back earlier.

Joe : Although using SendKeys can be unreliable, I brievely tested your code and seems to work fine. I'll look more into it.(late edit: Actually,after moving between the calculator and other windows, the whole computer froze !!.. as you said, very instable !.)

Tom: It didn't occur to me to Set the userform as the calculator's parent ..very nice idea.
Having said that, the drawing\repainting of the calculator is very inconsistent and sometimes fails to show. As you said, the code needs a bit more polishing.

I am currently taking a different approach which in theory is supposed to be "cleaner" than the above...The idea is to use a System Wide Journal Hook to capture the WM_CLOSE message of the calculator.However, I am having a hard time catching this elusive message.Failing this, I'll try using a Mouse\KeyBoard hook instead.

I'll post the code when\if I get there.

Again thank you all for taking an interest in this.

Regards.

Joe Was · Sep 8, 2006

I have been having a problem capuring the calculater close as well, if you do find a solution to the Calculator updating something with its value, please post it.

I was having problems wit RightClick's code and cannot get the zip through our FireWall here, will do it from home, I am sure I put someting in the wrong place. That is why I generally tag my code as to which module it should go in, even though I failed to do it this time.

Legacy 98055 · Sep 8, 2006

I have no problem using timers. In fact, I think this is a good candidate for using a timer...

TimerWatchCalc.zip

In a userform named "CalcLauncher":
Controls: Label3 , Label4, CommandButton1<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Private Sub CommandButton1_Click()
 Call LaunchAndWatchCalculator(Me)
 End Sub

 Friend Sub CalcEditChange(EditText As Double)
 Label3 = EditText
 End Sub

 Friend Sub CalcClosed(Result As Double)
 Label4 = Result
 Me.Repaint
 End Sub

 Private Sub UserForm_Terminate()
 Call StopWatching
 End Sub
</td></tr></table><button onclick='document.all("98200620950437").value=document.all("98200620950437").value.replace(/ \s\s/g,"");document.all("98200620950437").value=document.all("98200620950437").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("98200620950437").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="98200620950437" wrap="virtual">
Option Explicit

Private Sub CommandButton1_Click()
Call LaunchAndWatchCalculator(Me)
End Sub

Friend Sub CalcEditChange(EditText As Double)
Label3 = EditText
End Sub

Friend Sub CalcClosed(Result As Double)
Label4 = Result
Me.Repaint
End Sub

Private Sub UserForm_Terminate()
Call StopWatching
End Sub</textarea>

In a standard module:
<table width="100%" border="1" bgcolor="White" style="filter

rogid:DXImageTransform.Microsoft.Gradient(endColorstr='#C0CFE2', startColorstr='#FFFFFF', gradientType='0');"><tr><TD> Option Explicit

 Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
 Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
 Private Declare Function GetForegroundWindow Lib "user32" () 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 SendMessage Lib "user32" 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" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

 Private Const WM_GETTEXT = &HD
 Private Const WM_GETTEXTLENGTH = &HE
 Private Const CalcCaption As String = "Joe Was Here..."

 Private TimerID As Long
 Private OldValue As Double
 Private CallBackParent As CalcLauncher
 Private CalcHwnd As Long
 Private EditHwnd As Long

 Sub LaunchAndWatchCalculator(cl As CalcLauncher, Optional PollingInterval As Long = 100)
 Shell "calc"
 CalcHwnd = GetForegroundWindow
 SetWindowText CalcHwnd, CalcCaption
 EditHwnd = FindWindowEx(CalcHwnd, 0, "Edit", vbNullString)
 Set CallBackParent = cl
 OldValue = -1
 TimerID = SetTimer(0&, 0&, PollingInterval, AddressOf TimerProc)
 End Sub

 Sub StopWatching()
 KillTimer 0&, TimerID
 Set CallBackParent = Nothing
 End Sub

 Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
 ByVal nIDEvent As Long, ByVal dwTimer As Long)

 On Error Resume Next

 If IsWindow(CalcHwnd) = 0 Or FindWindow(vbNullString, CalcCaption) = 0 Then
 Call CallBackParent.CalcClosed(OldValue)
 Call StopWatching
 Exit Sub
 End If

 Dim EditText As String, ToDouble As Double

 EditText = Space(SendMessage(EditHwnd, WM_GETTEXTLENGTH, ByVal 0, ByVal 0))
 SendMessage EditHwnd, WM_GETTEXT, ByVal Len(EditText) + 1, ByVal EditText

 If IsNumeric(EditText) Then
 ToDouble = CDbl(EditText)
 If OldValue <> ToDouble Then
 'add a comment if you do not want a pseudo change event
 Call CallBackParent.CalcEditChange(ToDouble)
 OldValue = ToDouble
 End If
 End If

 End Sub
</td></tr></table><button onclick='document.all("982006212154500").value=document.all("982006212154500").value.replace(/ \s\s/g,"");document.all("982006212154500").value=document.all("982006212154500").value.replace(/ /g,"");window.clipboardData.setData("Text",document.all("982006212154500").value);'>Copy to Clipboard</BUTTON><textarea style="position:absolute;visibility:hidden" name="982006212154500" wrap="virtual">
Option Explicit

Private Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetForegroundWindow Lib "user32" () 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 SendMessage Lib "user32" 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" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const CalcCaption As String = "Joe Was Here..."

Private TimerID As Long
Private OldValue As Double
Private CallBackParent As CalcLauncher
Private CalcHwnd As Long
Private EditHwnd As Long

Sub LaunchAndWatchCalculator(cl As CalcLauncher, Optional PollingInterval As Long = 100)
Shell "calc"
CalcHwnd = GetForegroundWindow
SetWindowText CalcHwnd, CalcCaption
EditHwnd = FindWindowEx(CalcHwnd, 0, "Edit", vbNullString)
Set CallBackParent = cl
OldValue = -1
TimerID = SetTimer(0&, 0&, PollingInterval, AddressOf TimerProc)
End Sub

Sub StopWatching()
KillTimer 0&, TimerID
Set CallBackParent = Nothing
End Sub

Private Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)

On Error Resume Next

If IsWindow(CalcHwnd) = 0 Or FindWindow(vbNullString, CalcCaption) = 0 Then
Call CallBackParent.CalcClosed(OldValue)
Call StopWatching
Exit Sub
End If

Dim EditText As String, ToDouble As Double

EditText = Space(SendMessage(EditHwnd, WM_GETTEXTLENGTH, ByVal 0, ByVal 0))
SendMessage EditHwnd, WM_GETTEXT, ByVal Len(EditText) + 1, ByVal EditText

If IsNumeric(EditText) Then
ToDouble = CDbl(EditText)
If OldValue <> ToDouble Then
'add a comment if you do not want a pseudo change event
Call CallBackParent.CalcEditChange(ToDouble)
OldValue = ToDouble
End If
End If

End Sub</textarea>

TimerWatchCalc.zip

Jaafar Tribak · Sep 9, 2006

Nice code Tom and it works with no appearent side effects !

Following ( just for the sake of completeness and for the challenge) is ,hopefully, another solution that uses a system wide hook.

Download an example wbk : http://www.savefile.com/files/51832

In a Standard Module :

Code:

Option Explicit

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function CallNextHookEx Lib "user32" _
(ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
 
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 GetForegroundWindow Lib "user32" () As Long

Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long

Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) 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 Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, _
            ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, _
            ByVal dwMilliseconds As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long


Private Type EVENTMSG
    message As Long
    paramL As Long
    paramH As Long
    time As Long
    hwnd As Long
End Type

Private Const GWL_WNDPROC = (-4)
Private Const GWL_HINSTANCE = (-6)
Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WH_JOURNALRECORD = 0
Private Const WM_MOUSEMOVE = &H200
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = &HFFFF

Private hCalc As Long
Private hHook As Long
Private blnIsHooked As Boolean
Private CalcResult As Variant


Private Function JournalProc _
(ByVal idHook As Long, ByVal wParam As Long, ByRef lParam As EVENTMSG) As Long

    Dim strBuffer As String
    Dim lngRetVal, lngLength As Long
    Dim hEdit As Long
    
    'skip run time errors. this is to avoid an error that happens when
    'editing a cell within a callback function which crashes the app !
    On Error Resume Next

    'check if the user has moved the mouse ?
    If lParam.message = WM_MOUSEMOVE Then
    
        'if so, is it over the calculator ?
        If GetForegroundWindow = hCalc Then
        
            'if so retrieve the text in the calculator edit box
            'and place this result in the top form label
            hEdit = FindWindowEx(GetForegroundWindow, 0, "EDIT", vbNullString)
            lngLength = SendMessage(hEdit, WM_GETTEXTLENGTH, ByVal 0, ByVal 0)
            strBuffer = Space(256)
            lngRetVal = SendMessage(hEdit, WM_GETTEXT, ByVal lngLength, ByVal strBuffer)
            CalcResult = Val(Left(strBuffer, lngRetVal))
            userform1.Label3.Caption = CalcResult
            
        End If
        
        'if the calulator is closed place the result in the bottom form label
        If IsWindow(hCalc) = 0 Then
      
            userform1.Label4.Caption = CalcResult
            userform1.Label3.Caption = ""
            'also remove the hook as we no longer need it
            Call RemoveHook
            
        End If
       
    End If
    JournalProc = CallNextHookEx(hHook, idHook, wParam, ByVal lParam)

End Function

  
Private Sub Hook(blnTrue As Boolean)

    Dim lngXlhwnd, lngAppInstance As Long
    
    If blnTrue Then
    
        'get XL window handle
        lngXlhwnd = FindWindow("XLMAIN", Application.Caption)
        
        'get XL instance
        lngAppInstance = GetWindowLong(lngXlhwnd, GWL_HINSTANCE)
        
        'install the systm wide hook and set the flag
        hHook = SetWindowsHookEx _
        (WH_JOURNALRECORD, AddressOf JournalProc, lngAppInstance, 0)
        blnIsHooked = True
        
    Else
    
        'remove the hook and reset the flag
        UnhookWindowsHookEx hHook
        blnIsHooked = False
        
    End If

End Sub

Private Function IsCalculatorRunning() As Boolean

    If FindWindow(vbNullString, "Calculator") <> 0 _
    Then IsCalculatorRunning = True
    
End Function

Private Sub InstallHook()

    '\\do not install a hook more than once
    '\\or it will be impossible to remove it !
    If Not blnIsHooked Then Hook True

End Sub

Private Sub RemoveHook()

    '\\remove the hook if there is one installed
    If blnIsHooked Then Hook False

End Sub

Sub RunCalculator()

    Dim lngPrcssID As Long
    
    '\\first, reset the labels
    userform1.Label3.Caption = ""
    userform1.Label4.Caption = ""
    
    '\\launch calculator if it's not already running
    If Not IsCalculatorRunning Then
        lngPrcssID = Shell("calc")
    End If
    
    '\\store its window handle for later use
    hCalc = FindWindow(vbNullString, "Calculator")

    '\\install a systm wide hook to monitor user actions
    Call InstallHook
    
    '**************************************************************
    '\\this causes the application to crash !!!!!!!!!
    '\\if this happens, try pressing  ** Ctrl+Esc keys ** !!!!!!!
    
    'Call WaitForProcesToEnd(lngPrcssID)
    '\\show the final result after the calculator is closed
    'MsgBox "Final Calculator Value was :  " & CalcResult, vbInformation
    '**************************************************************
End Sub


Private Sub WaitForProcesToEnd(ByVal lngPrcessID)
 
    Dim lphwnd, lngRet As Long
    If lngPrcessID <> 0 Then
        '\\Get a handle to the shelled process.
        lphwnd = OpenProcess(SYNCHRONIZE, 0, lngPrcessID)
        '\\If successful, wait for the application to end and close the handle.
        If lphwnd <> 0 Then
            lngRet = WaitForSingleObject(lphwnd, INFINITE)
            CloseHandle (lphwnd)
        End If
    End If

End Sub
 
Sub ShowForm()

    userform1.Show

End Sub

However, there is more code that runs immediately after the calculator is closed and which uses this final calculator value.

So what is really needed here is to actually hold the execution of my code until the calculator is closed by the user.Then resume the code and use the final calculator value in it.

I have tried using the WaitForSinglrObject API function for this ( see last commented lines inside the RunCalculator Sub but the whole system crashes !! ( careful here, save your work !!)

So in a sense, we've only solved the first part of the problem

...Maybe this API will work if it is propperly incorporated into the Timer solution above

Any luck ?

Regards.

Legacy 98055 · Sep 9, 2006

Can't you use two procedures instead of one?

Jaafar Tribak · Sep 9, 2006

Can't you use two procedures instead of one?

I am trying to automate this process as much as possible without the need of any user intervention to run any subsquent code (or procedure).

Regards.

Legacy 98055 · Sep 9, 2006

The example I gave you raises an event (callback actually) that notifies you when the calculator closes. Use that.

I have a button on a userform which simply launches the Windows Calculator exe

Am I understanding you? I was under the assumption that the calculator is being started by a user action. Is your calculator being started by code in the midst of some procedure?

Jaafar Tribak · Sep 9, 2006

The example I gave you raises an event (callback actually) that notifies you when the calculator closes. Use that.

I have a button on a userform which simply launches the Windows Calculator exe

Click to expand...

Am I understanding you? I was under the assumption that the calculator is being started by a user action. Is your calculator being started by code in the midst of some procedure?

Dear Tom,

let me put this another way:

Your code as well as mine both assume that there is no code immediately after launching the calculator . In your case we have:

Code:

Private Sub CommandButton1_Click() 
       Call LaunchAndWatchCalculator(Me) 
End Sub

now, imagine I wanted to have a MsgBox displaying the calculator return value immediatly after closing the calculator. In the case above it will probably look something like :

Code:

Private Sub CommandButton1_Click() 
       Call LaunchAndWatchCalculator(Me) 
       MsgBox 'The calculator final value here '
End Sub

As you can see, the problem with the above is that the Msgbox code will be executed before the calculator is closed by the user thus not displaying the needed final calculator value.

hence, the need to somehow hold the execution of the code above so the Msgbox doesn't show until the user is done with the calculator.

I am trying not to use a loop, as this would badly impact on performance.

I hope , I am not confusing the matter further.

as always, thanks for your help with this.

Regards.

Jaafar Tribak · Sep 9, 2006

Well, I guess I could always have this msgbox within the callback procedure placed after this callback detects that the calculator is closed and take it from there.

However, I was thinking, it's better and cleaner to have this msgbox and the rest of any susequent code placed outside the callback ie: within the main procedure.

Regards.

Legacy 98055 · Sep 9, 2006

Jaafar. I provided a callback to give you the opportunity to respond to closing the calculator.

Code:

  Friend Sub CalcClosed(Result As Double) 
       Label4 = Result 
       Me.Repaint 
  End Sub

This method is called after the calculator is closed.

Using a timer from Excel when the user is working in another process (Calc.exe) would not be a performance issue, would it? If the user does not close the calculator, simply close it for them and stop the timer. All you would have to do is determine the foreground window. Also, the timer is surely using much less in the way of resources than a message hook.

Messing about with Calculator...

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Excel Facts

Joe Was

MrExcel MVP

Legacy 98055

Guest

Jaafar Tribak

Well-known Member

Legacy 98055

Guest

Jaafar Tribak

Well-known Member

Legacy 98055

Guest

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

Messing about with Calculator...

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Excel Facts

Joe Was

MrExcel MVP

Legacy 98055

Guest

Jaafar Tribak

Well-known Member

Legacy 98055

Guest

Jaafar Tribak

Well-known Member

Legacy 98055

Guest

Jaafar Tribak

Well-known Member

Jaafar Tribak

Well-known Member

Legacy 98055

Guest

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock