Results 1 to 3 of 3

Thread: Help with Screen Saver Module (Resolved)

Threaded View

  1. #1

    Thread Starter
    PowerPoster
    Join Date
    Jun 2001
    Location
    Trafalgar, IN
    Posts
    4,141

    Resolved Help with Screen Saver Module (Resolved)

    I'm trying to make a generic screen saver module to end the screen saver when the mouse is moved or a key on the keyboard is pressed. This is what I have in a module. It works fine for the mouse stuff but doesn't seem to see the keyboard inputs. Am I using the wrong const for the keyboard?
    VB Code:
    1. Option Explicit
    2.  
    3. Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    4. Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    5. Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
    6.  
    7. Dim lpPrevWndProc As Long
    8.  
    9. Public Const WM_KEYDOWN = &H100
    10. Public Const WM_MBUTTONDOWN = &H207
    11. Public Const WM_LBUTTONUP = &H202
    12. Public Const WM_RBUTTONDOWN = &H204
    13. Public Const WM_MOUSEMOVE = &H200
    14.  
    15. Public Const GWL_WNDPROC = -4
    16.  
    17. Private Type POINTAPI
    18.     x As Long
    19.     y As Long
    20. End Type
    21.  
    22. Dim frm As Form
    23.  
    24. Public Function Hook(ByVal f As Form)
    25.     Set frm = f
    26.    
    27.     'This function hooks the window that you would like to subclass
    28.     lpPrevWndProc = SetWindowLong(f.hwnd, GWL_WNDPROC, AddressOf WindowProc)
    29. End Function
    30.  
    31. Public Sub UnHook(ByVal hwnd As Long)
    32.     'This unhooks the window.  We must do this or else
    33.     'an error is thrown when the program unloads.
    34.     Call SetWindowLong(hwnd, GWL_WNDPROC, lpPrevWndProc)
    35. End Sub
    36.  
    37. 'This is the function that receives all messages sent to our form.
    38. Function WindowProc(ByVal hw As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    39.    
    40.     Select Case uMsg
    41.         Case WM_KEYDOWN
    42.             Unload frm
    43.         'Detect if the "enter" button on a mouse was clicked
    44.         Case WM_MBUTTONDOWN
    45.             Unload frm
    46.         'Detects the leftmouse click
    47.         Case WM_LBUTTONUP
    48.             Unload frm
    49.         'Detects the rightmouse click
    50.         Case WM_RBUTTONDOWN
    51.             Unload frm
    52.         Case WM_MOUSEMOVE
    53.             CheckCursor
    54.     End Select
    55.    
    56.     'let the msg get through to the form
    57.     WindowProc = CallWindowProc(lpPrevWndProc, hw, uMsg, wParam, lParam)
    58.  
    59. End Function
    60.  
    61. Private Sub CheckCursor()
    62. Static xx As Integer
    63. Static yy As Integer
    64. Dim Point As POINTAPI
    65.  
    66.     GetCursorPos Point
    67.    
    68.     If xx = 0 And yy = 0 Then
    69.        xx = Point.x
    70.        yy = Point.y
    71.     Else
    72.         If Abs(xx - Point.x) > 5 Or Abs(yy - Point.y) > 5 Then
    73.             Unload frm
    74.         Else
    75.             xx = Point.x
    76.             yy = Point.y
    77.         End If
    78.     End If
    79. End Sub
    Last edited by MarkT; Feb 6th, 2005 at 10:49 AM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width