1 Replies - 621 Views - Last Post: 16 July 2017 - 10:09 AM Rate Topic: -----

#1 codesdozer   User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 3
  • Joined: 10-July 17

API Timer stops when vbmodal form activates

Posted 10 July 2017 - 11:21 PM

Good day!
I need your help. I made an application with an autologoff feature. I used API timer and its working for mdi child forms. However, when a vbmodal load or activate, the API timer stops.
By the way, here is my code:

Option Explicit

Private Type POINTAPI
x As Integer
y As Integer
End Type

'API for Active idle window
Private Declare Sub GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI)
Private Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer
'API for Inactive idle window
Private Declare Function GetQueueStatus Lib "user32.dll" (ByVal fuFlags As Long) As Long
'API for active window checker
Private Declare Function GetForegroundWindow Lib "user32.dll" () As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As Long) As Long

'API For Inactivity Monitoring SMQ
Private Const QS_KEY = &H1
Private Const QS_MOUSEMOVE = &H2
Private Const QS_MOUSEBUTTON = &H4
Private Const QS_TIMER = &H10
Private Const QS_INPUT = (QS_MOUSE Or QS_KEY)

Private posOld As POINTAPI
Private posNew As POINTAPI

Public gCancelAutoLogOff As Boolean

Public Sub CheckInputIdle(ByVal TimeOut As Long)
    Dim lTimer As Long
    Dim hforewnd As Long
    Dim slength As Long
    Dim wintext As String
    Dim retval As Long
    hforewnd = GetForegroundWindow()
    slength = GetWindowTextLength(hforewnd) + 1
    wintext = Space(slength)
    retval = GetWindowText(hforewnd, wintext, slength)
    wintext = Left(wintext, slength - 1)

    lTimer = Timer

  Do While gCancelAutoLogOff = False

    If wintext = MainForm.Caption Then
         If InputCheck = True Then
            lTimer = Timer
         End If
         If GetQueueStatus(QS_INPUT) Then
            lTimer = Timer
         End If
    End If

    If Timer - lTimer >= TimeOut Then Exit Do


  If gCancelAutoLogOff = False Then
    gCancelAutoLogOff = True
  End If

End Sub

Public Function InputCheck() As Boolean
    Dim a As Integer

   'Get the current mouse cursor coordinates
    Call GetCursorPos(posNew)
    'Compare with old coordinates
    If ((posNew.x <> posOld.x) Or (posNew.y <> posOld.y)) Then
        posOld = posNew
        InputCheck = True
        Exit Function
    End If
'    Check keys state
    For a = 0 To 255
        If (GetAsyncKeyState(a) And &H8001) <> 0 Then
            InputCheck = True
            Exit Function
        End If
    Next a
    InputCheck = False

End Function

I will appreciate all of your suggestions. Thanks in advance :D/>

This post has been edited by modi123_1: 11 July 2017 - 06:36 AM
Reason for edit:: In the future please use the [code] button in the editor.

Is This A Good Question/Topic? 0
  • +

Replies To: API Timer stops when vbmodal form activates

#2 thx1138v2   User is offline

  • New D.I.C Head

Reputation: 1
  • View blog
  • Posts: 4
  • Joined: 09-March 17

Re: API Timer stops when vbmodal form activates

Posted 16 July 2017 - 10:09 AM

Although I see API code, I don't see any code for an actual API timer so I'm guessing you are using a VB timer.

Look at the Windows API SetTimer() and KillTimer() functions. You'll also need a public callback routine in a VB module that the system API timer calls on each timer tick. You can find a lot of sample code on the web.

Make sure your KillTimer() routine is called before closing the program or your API references will hold the program open at worst or cause a memory leak at best.
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1