Attribute VB_Name = "mod_Screen_SnapShot"
Option Explicit



'--------------------------------------------------------------------------------------------------
   
   Public Type POINTAPI
      x As Long
      y As Long
   End Type
Public Declare Function GetCursorPos Lib "user32.dll" (lpPoint As POINTAPI) As Long

'--------------------------------------------------------------------------------------------------

Public Declare Function GetDC _
                        Lib "user32" ( _
                                     ByVal hwnd As Long _
                                     ) As Long
                                                                  
'--------------------------------------------------------------------------------------------------

Public Declare Function StretchBlt _
                        Lib "gdi32" ( _
                                     ByVal hdc As Long, _
                                     ByVal x As Long, _
                                     ByVal y As Long, _
                                     ByVal nWidth As Long, _
                                     ByVal nHeight As Long, _
                                     ByVal hSrcDC As Long, _
                                     ByVal xSrc As Long, _
                                     ByVal ySrc As Long, _
                                     ByVal nSrcWidth As Long, _
                                     ByVal nSrcHeight As Long, _
                                     ByVal dwRop As Long _
                                     ) As Long

'--------------------------------------------------------------------------------------------------

Public Declare Function GetWindowLong _
                        Lib "user32" _
                        Alias "GetWindowLongA" ( _
                                     ByVal hwnd As Long, _
                                     ByVal nIndex As Long _
                                     ) As Long

'--------------------------------------------------------------------------------------------------

Public Declare Function SetWindowLong _
                        Lib "user32" _
                        Alias "SetWindowLongA" ( _
                                      ByVal hwnd As Long, _
                                      ByVal nIndex As Long, _
                                      ByVal dwNewLong As Long _
                                      ) As Long

'--------------------------------------------------------------------------------------------------

Public Declare Function SetLayeredWindowAttributes _
                        Lib "user32" ( _
                                      ByVal hwnd As Long, _
                                      ByVal crKey As Long, _
                                      ByVal bAlpha As Byte, _
                                      ByVal dwFlags As Long _
                                      ) As Long

'--------------------------------------------------------------------------------------------------

Private Declare Function SetWindowPos _
                         Lib "user32" ( _
                                       ByVal hwnd As Long, _
                                       ByVal hWndInsertAfter As Long, _
                                       ByVal x As Long, _
                                       ByVal y As Long, _
                                       ByVal cx As Long, _
                                       ByVal cy As Long, _
                                       ByVal wFlags As Long _
                                       ) As Long

'--------------------------------------------------------------------------------------------------

Public Declare Function SetTimer Lib "user32" _
    (ByVal hwnd As Long, _
     ByVal nIDEvent As Long, _
     ByVal uElapse As Long, _
     ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" _
    (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
    
'--------------------------------------------------------------------------------------------------


Public Pos_X As Single
Public Pos_Y As Single

Public Const GWL_STYLE = (-16)
Public Const GWL_EXSTYLE = (-20)
Public Const WS_EX_LAYERED = &H80000
Public Const LWA_COLORKEY = &H1
Public Const LWA_ALPHA = &H2

Public Const HWND_TOPMOST = -1
Public Const HWND_NOTOPMOST = -2
Public Const SWP_NOSIZE = &H1
Public Const SWP_NOMOVE = &H2
Public Const SWP_NOACTIVATE = &H10
Public Const SWP_SHOWWINDOW = &H40
Public Const FLAGS = SWP_NOACTIVATE Or SWP_SHOWWINDOW Or SWP_NOMOVE Or SWP_NOSIZE

Public Const LeftMouseClick As Integer = 1
Public Const RightMouseClick As Integer = 2
Public LeftMouseCLICKED As Boolean
Public RightMouseCLICKED As Boolean

Public Line1 As Line
Public Line2 As Line
Public Line3 As Line
Public Line4 As Line

Public Image1 As Image
Public Picture1 As PictureBox
Public Picture2 As PictureBox
Public Picture3 As PictureBox
Public Picture4 As PictureBox
Public Picture5 As PictureBox
Public Picture6 As PictureBox

Public Form_Snapshot As Form
Public Form_Preview As New Form1
Public Form3 As New Form1

Public FullScreen_SnapShot As Boolean
Public Timer_Function As String

'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------
'--------------------------------------------------------------------------------------------------





Public Sub TimerProc(ByVal hwnd As Long, _
                      ByVal lMsg As Long, _
                      ByVal lTimerID As Long, _
                      ByVal lTimer As Long)
                      
Select Case UCase(Timer_Function)
   
   Case "STARTPROGRAM"
      KillTimer Form1.hwnd, 0
      Start_Program
      
   Case "TAKESNAPSHOT"
      KillTimer Form1.hwnd, 0
      PrepareSave
      
   Case "SAVEPICTURE"
      KillTimer Form1.hwnd, 0
      Save_Picture
      
End Select


End Sub
Public Sub TimerProcExit(ByVal hwnd As Long, _
                      ByVal lMsg As Long, _
                      ByVal lTimerID As Long, _
                      ByVal lTimer As Long)
Dim Coord As POINTAPI
On Error Resume Next
GetCursorPos Coord

   If Coord.x < Convert_To((Form1.Left + 25), True, False, False) And Coord.x >= Convert_To(Form1.Left, True, False, False) And Coord.y < Convert_To((Form1.Top + 25), True, False, False) And Coord.y >= Convert_To(Form1.Top, True, False, False) Then
   KillTimer Form_Preview.hwnd, 0
   Unload Form_Preview
   Unload Form3
   Unload Form1
   End If
End Sub



Public Sub Save_Picture()
Dim MsgBoxResponse As Integer
Dim InputBoxLocation As String
Form_Preview.Show
MsgBoxResponse = MsgBox("Would you like to save current SnapShot?", vbInformation + vbYesNo, "Save SnapShot?")

If MsgBoxResponse = vbYes Then
InputBoxLocation = InputBox("Save SnapShot Location", "Save Location", App.Path & "\Picture.jpg")
   If InputBoxLocation = "" Then
   
   If FullScreen_SnapShot = True Then
   SavePicture Form3.Image, App.Path & "\Picture.jpg"
   Else
   SavePicture Picture6.Image, App.Path & "\Picture.jpg"
   End If
   Else

   If FullScreen_SnapShot = True Then
   SavePicture Form3.Image, InputBoxLocation
   Else
   SavePicture Picture6.Image, InputBoxLocation
   End If
   End If
   
Form_Preview.Visible = False
Form1.Show
Form3.Hide
Else
Form_Preview.Visible = False
Form3.Hide
Form1.Show
End If
End Sub



Public Sub Prepare_SnapShot()
    Form3.BorderStyle = 0
    Form3.Caption = ""
    Form_Preview.Show
    Form_Preview.ScaleMode = 3
    Form_Preview.BorderStyle = 0
    Form_Preview.Caption = ""
    Form_Preview.Move 0, 0, Screen.Width, Screen.Height
    Picture1.Move 0, 0, Screen.Width, Screen.Height
    Form_Preview.Hide
    
    Form1.BorderStyle = 0
    Form1.Caption = ""
    

End Sub


Public Sub TakeSnapShot()
Dim wScreen As Long
Dim hScreen As Long
Dim hdcScreen As Long
Dim MsgBoxResponse As Integer
Dim InputBoxLocation As String

   Prepare_SnapShot
   AdjustBorders
   

Take_SnapShot:
      Picture1.AutoRedraw = True
      Picture1.Move 0, 0, Screen.Width, Screen.Height
      wScreen = Screen.Width \ Screen.TwipsPerPixelX
      hScreen = Screen.Height \ Screen.TwipsPerPixelY
      Picture1.ScaleMode = vbPixels
      hdcScreen = GetDC(0)
      StretchBlt Picture1.hdc, 0, 0, wScreen, hScreen, hdcScreen, 0, 0, wScreen, hScreen, vbSrcCopy
      Form_Preview.Move 0, 0, Screen.Width, Screen.Height
      Form_Preview.Show
      Timer_Function = "TakeSnapShot"
      SetTimer Form1.hwnd, 0, 1500, AddressOf TimerProc
End Sub



Public Sub PrepareSave()
      Form3.Show
      Form3.Picture = Picture1.Image
      Picture6.AutoRedraw = True
      Form3.AutoRedraw = True
      Form3.Move 0, 0, Screen.Width, Screen.Height

      If FullScreen_SnapShot = True Then
      Picture6.Visible = False
      Else
      Picture6.Visible = True
      Picture6.Move 0, 0, Form1.Width, Form1.Height
      Picture6.PaintPicture Form3.Image, 0 - Form1.Left, 0 - Form1.Top
      End If
      
      Timer_Function = "SavePicture"
      SetTimer Form1.hwnd, 0, 1500, AddressOf TimerProc

End Sub


Public Sub AdjustBorders()
Select Case FullScreen_SnapShot

Case True
Picture2.Visible = False
Picture3.Visible = False
Picture4.Visible = False
Picture5.Visible = False

Case False
Picture2.Visible = True
Picture3.Visible = True
Picture4.Visible = True
Picture5.Visible = True

End Select


Picture2.Move 0, 0, Screen.Width, Convert_To(Form1.Top, True, False, False) + 1
Picture3.Move 0, 0, Convert_To(Form1.Left, True, False, False) + 1, Screen.Height
Picture4.Move 0, Convert_To(Form1.Top, True, False, False) + Convert_To(Form1.Height, True, False, False) - 1, Screen.Width, Screen.Height
Picture5.Move Convert_To(Form1.Left, True, False, False) + Convert_To(Form1.Width, True, False, False) - 1, 0, Screen.Width, Screen.Height
Form_Preview.Show
Form1.Hide
End Sub

Public Sub FormMouseDown(MouseButton As Integer, MouseX As Single, MouseY As Single)

   Select Case MouseButton
      
      Case RightMouseClick
         RightMouseCLICKED = True
      
      Case LeftMouseClick
      LeftMouseCLICKED = True
      Pos_X = MouseX
      Pos_Y = MouseY
      
   End Select

End Sub



Public Sub FormMouseMove(MouseX As Single, MouseY As Single)
On Error GoTo ReSiZe_FoRm
   Select Case True

      Case RightMouseCLICKED
         Form1.Width = Form1.Width + (MouseX - Form1.Width)
         Form1.Height = Form1.Height + (MouseY - Form1.Height)
         AdjustLines
         
      Case LeftMouseCLICKED
         Form1.Move MouseX + (Form1.Left - Pos_X), MouseY + (Form1.Top - Pos_Y)

   End Select

   Exit Sub

ReSiZe_FoRm:
   Form1.Left = Screen.Width / 2 - 2000
   Form1.Top = Screen.Height / 2 - 2000
   Form1.Width = 4000
   Form1.Height = 4000
   RightMouseCLICKED = False
   LeftMouseCLICKED = False
   AdjustLines
End Sub


Public Sub FormMouseUp()
RightMouseCLICKED = False
LeftMouseCLICKED = False
End Sub


Public Sub FormLoad(Full_Screen_SnapShot As Boolean)
Set Form_Snapshot = Form1
Form3.Show
Form_Preview.Show
Form3.Hide
Form_Preview.Hide

FullScreen_SnapShot = Full_Screen_SnapShot
Timer_Function = "StartProgram"
SetTimer Form1.hwnd, 0, 10, AddressOf TimerProc
End Sub

Public Sub Start_Program()

    SetTimer Form_Preview.hwnd, 0, 10, AddressOf TimerProcExit
    
    SetWindowPos Form1.hwnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
    
    CreateLines
    CreatePictureBox
    Prepare_SnapShot
    AdjustLines
    
    
    Form1.BackColor = vbCyan
    SetWindowLong Form1.hwnd, GWL_EXSTYLE, GetWindowLong(Form1.hwnd, GWL_EXSTYLE) Or WS_EX_LAYERED
    SetLayeredWindowAttributes Form1.hwnd, vbCyan, 0&, LWA_COLORKEY
End Sub


Public Sub CreateLines()
        Set Line1 = Form1.Controls.Add("VB.Line", "Line1")
    Line1.X1 = 0
    Line1.X2 = 10
    Line1.Y1 = 0
    Line1.Y2 = 0
    Line1.Visible = True
        Set Line2 = Form1.Controls.Add("VB.Line", "Line2")
    Line2.X1 = 0
    Line2.X2 = 10
    Line2.Y1 = 0
    Line2.Y2 = 0
    Line2.Visible = True
        Set Line3 = Form1.Controls.Add("VB.Line", "Line3")
    Line3.X1 = 0
    Line3.X2 = 10
    Line3.Y1 = 0
    Line3.Y2 = 0
    Line3.Visible = True
        Set Line4 = Form1.Controls.Add("VB.Line", "Line4")
    Line4.X1 = 0
    Line4.X2 = 10
    Line4.Y1 = 0
    Line4.Y2 = 0
    Line4.Visible = True
    AdjustLines
End Sub





Public Sub CreatePictureBox()
Set Picture1 = Form_Preview.Controls.Add("VB.Picturebox", "Picture1")
With Picture1
.ScaleMode = 3
.Appearance = 0
.BorderStyle = 0
.BackColor = vbBlack
.Left = 0
.Top = 0
.Width = 100
.Height = 100
.Visible = True
.ZOrder 1
End With

Set Picture2 = Form_Preview.Controls.Add("VB.Picturebox", "Picture2")
With Picture2
.ScaleMode = 3
.Appearance = 0
.BorderStyle = 0
.BackColor = vbBlack
.Left = 0
.Top = 0
.Width = 100
.Height = 100
.Visible = True
.ZOrder 0
End With

Set Picture3 = Form_Preview.Controls.Add("VB.Picturebox", "Picture3")
With Picture3
.ScaleMode = 3
.Appearance = 0
.BorderStyle = 0
.BackColor = vbBlack
.Left = 0
.Top = 0
.Width = 100
.Height = 100
.Visible = True
.ZOrder 0
End With

Set Picture4 = Form_Preview.Controls.Add("VB.Picturebox", "Picture4")
With Picture4
.ScaleMode = 3
.Appearance = 0
.BorderStyle = 0
.BackColor = vbBlack
.Left = 0
.Top = 0
.Width = 100
.Height = 100
.Visible = True
.ZOrder 0
End With

Set Picture5 = Form_Preview.Controls.Add("VB.Picturebox", "Picture5")
With Picture5
.ScaleMode = 3
.Appearance = 0
.BorderStyle = 0
.BackColor = vbBlack
.Left = 0
.Top = 0
.Width = 100
.Height = 100
.Visible = True
.ZOrder 0
End With

Set Picture6 = Form3.Controls.Add("VB.Picturebox", "Picture6")
With Picture6
.ScaleMode = 1
.Appearance = 0
.BorderStyle = 0
.BackColor = vbWhite
.Left = 0
.Top = 0
.Width = 100
.Height = 100
.Visible = True
.ZOrder 0
End With
End Sub




Public Sub AdjustLines()

         Line1.X1 = 0
         Line1.X2 = Form1.Width
         Line1.Y1 = 0
         Line1.Y2 = 0
         
         
         Line2.X1 = 0
         Line2.X2 = Form1.Width
         Line2.Y1 = Form1.Height - 10
         Line2.Y2 = Form1.Height - 10
         
         
         Line3.X1 = 0
         Line3.X2 = 0
         Line3.Y1 = 0
         Line3.Y2 = Form1.Height
         
         
         Line4.X1 = Form1.Width - 10
         Line4.X2 = Form1.Width - 10
         Line4.Y1 = Form1.Height
         Line4.Y2 = 0
End Sub




Public Function Convert_To(Convert_Number As Long, Twips_To_Pixel As Boolean, Millimeter_To_Pixel As Boolean, Pixel_To_Millimeter As Boolean, Optional DPI_Number As Long) As Long
If DPI_Number = 0 Then
   DPI_Number = 96
End If

Select Case True
   Case Millimeter_To_Pixel
   Convert_To = (Convert_Number * DPI_Number) / 25.4

   Case Pixel_To_Millimeter
   Convert_To = (Convert_Number * 25.4) / DPI_Number
   
   Case Twips_To_Pixel
   Convert_To = Convert_Number / Screen.TwipsPerPixelY
End Select
End Function
