Hey, is there a way to make a VB program run like a screensaver, with a set amount of time before running if the user is idle? help?
Printable View
Hey, is there a way to make a VB program run like a screensaver, with a set amount of time before running if the user is idle? help?
Try this. Add a Timer to the Form, set it's Interval to 1 and run it. When you begin, the Form will be hidden. If there is no activity within 15 min, the Form will be shown.
Code:Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CurPos As POINTAPI
Dim OldX As Single
Dim OldY As Single
Dim StartTime As Date
Function Start()
'Create a StartTime
StartTime = Format(Time, "hh:mm:ss")
End Function
Private Sub Form_Load()
'Hide the Form
Me.Hide
'Give a StartTime when the Form loads
Start
End Sub
Private Sub Timer1_Timer()
'Loop through the keys and see if they were pressed
For I = 32 To 127
If GetAsyncKeyState(I) Then Start
'Do the same for the Mouse Buttons
If GetAsyncKeyState(vbLeftButton) Then Start
If GetAsyncKeyState(vbRightButton) Then Start
Next
'Check if mouse is still
MyPos = GetCursorPos(CurPos)
X = CurPos.X
Y = CurPos.Y
If OldX = X And OldY = Y Then
'The mouse is still
Else
'the Mouse is not still
OldX = X
OldY = Y
'Create a new StartTime
Start
End If
'Subtract the current time with the StartTime
Retval = StartTime - Time
Retval = Format(Retval, "hh:mm:ss")
'If it's been 15 min Display the Fomr
If Retval = "00:15:00" Then
Me.Show
'Create a new StartTime
Start
End If
End Sub
If you really want it to act like a ScreenSaver, this next code will show the Form if there is no activity in 15 min and hide the Form if there is any activity when it's running.
Code:Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Type POINTAPI
X As Long
Y As Long
End Type
Dim CurPos As POINTAPI
Dim OldX As Single
Dim OldY As Single
Dim StartTime As Date
Function Start()
'Create a StartTime
StartTime = Format(Time, "hh:mm:ss")
End Function
Private Sub Form_Load()
'Hide the Form
Me.Hide
'Give a StartTime when the Form loads
Start
End Sub
Private Sub Timer1_Timer()
If Me.Visible = False Then
'Loop through the keys and see if they were pressed
For I = 32 To 127
If GetAsyncKeyState(I) Then Start
'Do the same for the Mouse Buttons
If GetAsyncKeyState(vbLeftButton) Then Start
If GetAsyncKeyState(vbRightButton) Then Start
Next
'Check if mouse is still
MyPos = GetCursorPos(CurPos)
X = CurPos.X
Y = CurPos.Y
If OldX = X And OldY = Y Then
'The mouse is still
Else
'the Mouse is not still
OldX = X
OldY = Y
'Create a new StartTime
Start
End If
'Subtract the current time with the StartTime
Retval = StartTime - Time
Retval = Format(Retval, "hh:mm:ss")
'If it's been 15 min Display the Fomr
If Retval = "00:15:00" Then
Me.Show
'Create a new StartTime
Start
End If
End If
If Me.Visible = True Then
'Loop through the keys and see if they were pressed
For I = 32 To 127
If GetAsyncKeyState(I) Then Me.Visible = False
'Do the same for the Mouse Buttons
If GetAsyncKeyState(vbLeftButton) Then Me.Visible = False
If GetAsyncKeyState(vbRightButton) Then Me.Visible = False
Next
'Check if mouse is still
MyPos = GetCursorPos(CurPos)
X = CurPos.X
Y = CurPos.Y
If OldX = X And OldY = Y Then
'The mouse is still
Else
'the Mouse is not still
OldX = X
OldY = Y
'Hide the Form
Me.Visible = False
End If
End If
End Sub
Here is how to start the screen saver:
Code:Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg _
As Long, ByVal wParam As Long, ByVal lParam As Long) _
As Long
Const WM_SYSCOMMAND = &H112&
Const SC_SCREENSAVE = &HF140&
Dim result As Long
result = SendMessage(Me.hWnd, WM_SYSCOMMAND, SC_SCREENSAVE, 0&)
Look <a href="http://support.microsoft.com/support/kb/articles/Q146/9/07.asp">here</a> for Microsoft's description on it. If you have MSDN, look up "Creating 16-Bit and 32-Bit Screen Savers with Visual Basic" because it is a MUCH more in depth description (and it comes with a sample) than this crappy free one Microsoft provides on the web. :)
...so glad it supports inline HTML...