|
-
Aug 4th, 2000, 03:48 PM
#1
Thread Starter
Member
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?
Wisdom is supreme, therefore get wisdom,
though it costs all you have, get understanding.
Proverbs 4:7
-
Aug 4th, 2000, 04:10 PM
#2
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
-
Aug 4th, 2000, 04:17 PM
#3
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
-
Aug 4th, 2000, 07:52 PM
#4
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&)
-
Aug 7th, 2000, 07:54 AM
#5
New Member
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.
-
Aug 7th, 2000, 07:55 AM
#6
New Member
...so glad it supports inline HTML...
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|