Private m_AtomID As Long


Private Sub Class_Initialize()
    
    m_AtomID = GlobalAddAtom(CStr(Now))
    
End Sub


Private Sub Class_Terminate()

    Call GlobalDeleteAtom(m_AtomID)

End Sub


Public Property Get Value() As Long

    Value = m_AtomID

End Property

'used by the RegisterHotKey method
Public Enum RegisterHotKeyModifiers
   MOD_ALT = &H1
   MOD_CONTROL = &H2
   MOD_SHIFT = &H4
End Enum

Public Declare Function RegisterHotKey Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal id As Long, _
   ByVal fsModifiers As RegisterHotKeyModifiers, _
   ByVal vk As KeyCodeConstants) As Long
   
Public Declare Function UnregisterHotKey Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal id As Long) As Long

Public Declare Function GlobalAddAtom Lib "kernel32" _
   Alias "GlobalAddAtomA" _
  (ByVal lpString As String) As Long
   
Public Declare Function GlobalDeleteAtom Lib "kernel32" _
   (ByVal nAtom As Long) As Long

Private 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
   
Private Declare Function SetWindowLong Lib "user32" _
   Alias "SetWindowLongA" _
  (ByVal hWnd As Long, ByVal nIndex As Long, _
   ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC As Long = (-4)
Public Const WM_HOTKEY As Long= &H312

Public lpPrevWndProc As Long

'used by the PrintScreen method
Public Declare Function BitBlt Lib "gdi32" _
  (ByVal hDCDest As Long, ByVal XDest As Long, _
   ByVal YDest As Long, ByVal nWidth As Long, _
   ByVal nHeight As Long, ByVal hDCSrc As Long, _
   ByVal XSrc As Long, ByVal YSrc As Long, _
   ByVal dwRop As Long) As Long

Public Declare Function GetDesktopWindow Lib "user32" () As Long

Public Declare Function GetWindowDC Lib "user32" _
   (ByVal hWnd As Long) As Long

Public Declare Function ReleaseDC Lib "user32" _
  (ByVal hWnd As Long, _
   ByVal hdc As Long) As Long
   
   
Public Sub Hook(ByVal gHW As Long)

  'Establish a hook
   lpPrevWndProc = SetWindowLong(gHW, GWL_WNDPROC, AddressOf WindowProc)

End Sub


Public Sub Unhook(ByVal gHW As Long)

  'Reset the message handler
   Call SetWindowLong(gHW, GWL_WNDPROC, lpPrevWndProc)
   
End Sub


Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, _
                    ByVal wParam As Long, ByVal lParam As Long) As Long

   Select Case hWnd
   
      Case frmMain.hWnd
   
         If uMsg = WM_HOTKEY Then
         
           'add code to process the Hotkey
            frmMain.Caption = "Hotkey Pressed
            PrintScreen
         
         End If
         
      Case Else
      
   End Select
   
   
  'Pass message to the original window message handler
   WindowProc = CallWindowProc(lpPrevWndProc, hWnd, uMsg, wParam, lParam)
   
End Function


Private Sub PrintScreen()

  Dim hWndDesk As Long
  Dim hDCDesk As Long

  Dim LeftDesk As Long
  Dim TopDesk As Long
  Dim WidthDesk As Long
  Dim HeightDesk As Long
   
 'define the screen coordinates (upper
 'corner (0,0) and lower corner (Width, Height)
  LeftDesk = 0
  TopDesk = 0
  WidthDesk = Screen.Width \ Screen.TwipsPerPixelX
  HeightDesk = Screen.Height \ Screen.TwipsPerPixelY
   
 'get the desktop handle and display context
  hWndDesk = GetDesktopWindow()
  hDCDesk = GetWindowDC(hWndDesk)
   
 'copy the desktop to the picture box
  Call BitBlt(frmMain.Picture1.hdc, 0, 0, _
             WidthDesk, HeightDesk, hDCDesk, _
             LeftDesk, TopDesk, vbSrcCopy)

  Call ReleaseDC(hWndDesk, hDCDesk)

End Sub

Option Explicit

Private GlobalAtom As CGlobalAtom
Private IsTrapping As Boolean

'command button index consts
Private Const nTrap = 0
Private Const nStop = 1
Private Const nClear = 2

Private Sub Form_Load()

   UpdateInfo
   
End Sub


Private Sub Form_Unload(Cancel As Integer)

   If IsTrapping Then
      Command1(nStop).Value = True
   End If
   
End Sub


Private Sub UpdateInfo()

   Caption = IIf(IsTrapping, "Trapping Print Screen", "Trapping Off")
   
   Command1(0).Enabled = IsTrapping = False
   Command1(1).Enabled = IsTrapping = True
   
End Sub


Private Sub Command1_Click(index As Integer)

   Select Case index
      Case nTrap 'begin trapping
      
         Set GlobalAtom = New CGlobalAtom
         
        'Call procedure to begin capturing messages
         Call Hook(Me.hWnd)
         
        'Trap Print Screen (vbKeySnapshot).
        'API returns 1 if successful, so
        'evaluating to 1 renders true.
         IsTrapping = RegisterHotKey(Me.hWnd, GlobalAtom.Value, 0, vbKeySnapshot) = 1
      
      Case nStop 'end trapping
      
        'API returns 1 if successful, so
        'evaluating to 0 renders False.
         IsTrapping = UnregisterHotKey(Me.hWnd, GlobalAtom.Value) = 0
         
         Call Unhook(Me.hWnd)
         
      Case nClear  'clear the pix and clipboard
      
         Clipboard.Clear
         Picture1.Cls
      
   End Select
   
   UpdateInfo
   
End Sub