Imports WIA  'wia functions - subs of camera and scanner wizard
Imports System.Net
Imports System.IO
Imports System.Drawing.Imaging  'image codecs in this program
Public Class Form1
    Dim xvid As Integer = 4  'in a bit on form
    Dim yvid As Integer = 23  'down from top of form
    Dim xlab As Integer = 87
    Dim ylab As Integer = 289  'position of time label
    Dim vidbound As New Rectangle(xvid, yvid, 347, 300)
    '345 by 300 is exact size of webcam image with time strip of 15 pixels
    Dim xcop As Integer = 365
    Dim ycop As Integer = 378  'position of current picture
    Dim totalerror As Integer   'even if black and white error will be less than 32 bits
    Dim filepath As String 'path to save pictures
    Dim comp As Long = 60&  '60 gives 90% compression and a good picture
    Dim picnum As Integer  'number of pictures saved
    Dim variation As Integer
    Dim adjvariation As Integer
    Dim none As String = Nothing 'form1 control
    Dim reference As Bitmap = New Bitmap(vidbound.Width, _
                vidbound.Height, Imaging.PixelFormat.Format32bppArgb) 'reference picture
    Dim copyvideo As Bitmap = New Bitmap(vidbound.Width, _
                vidbound.Height, Imaging.PixelFormat.Format32bppArgb) 'current picture
    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick
        Label1.Text = Now.ToLongTimeString & "               " & Now.ToLongDateString
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        filepath = System.IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.MyDocuments, "webcamimage")
        My.Computer.FileSystem.CreateDirectory(filepath)
        'creates a folder webcamimages in my documents on user computer
    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
        variation = TextBox1.Text
        adjvariation = TextBox2.Text
        Dim graph As Graphics = Graphics.FromImage(reference)
        graph.CopyFromScreen(vidbound.Location, New Point(0, 0), vidbound.Size)
        graph.Dispose()
        PictureBox1.Image = reference  'this is the first reference picture
        encodesave()  'compress and save
        picnum = 1  'next picture
        Timer2.Enabled = True 'get current picture
    End Sub

    Private Sub Timer2_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer2.Tick
        Timer2.Enabled = False 'allow time to complete this routine
        Dim vidbound As New Rectangle(xvid, yvid, 347, 300)
        Dim graph As Graphics = Graphics.FromImage(copyvideo)
        graph.CopyFromScreen(vidbound.Location, New Point(0, 0), vidbound.Size)
        graph.Dispose() 'now have copy of video and tme band
        PictureBox2.Image = copyvideo
        'is current picture different from reference
        Dim totalerror As Integer
        Dim reftotal As Integer 'sum of pixel intensities
        Dim coptotal As Integer 'sum of pixel intensities
        For i = 1 To 344 'the width
            For j = 1 To 284 'the height minus the time strip(15 pixels)
                'get values of pixel from reference
                Dim pixelc1 As Color = reference.GetPixel(i, j) 'gets color form of individual pixel
                Dim r1 As Integer = pixelc1.R  'must have integer to prevent overflow
                Dim g1 As Integer = pixelc1.G
                Dim b1 As Integer = pixelc1.B  'get individual color values from color form
                reftotal = reftotal + r1 + g1 + b1
                'get values of pixel from current
                Dim pixelc2 As Color = copyvideo.GetPixel(i, j) 'gets color form of individual pixel
                Dim r2 As Byte = pixelc2.R
                Dim g2 As Byte = pixelc2.G
                Dim b2 As Byte = pixelc2.B  'get individual color values from color form
                coptotal = coptotal + r2 + g2 + b2
                totalerror = totalerror + Math.Abs(r1 - r2) + Math.Abs(g1 - g2) + Math.Abs(b1 - b2)
            Next j
        Next i
        Dim reftotals As String = reftotal
        Label6.Text = reftotals
        Dim coptotals As String = coptotal
        Label7.Text = coptotal
        Dim difference As String = Math.Abs(reftotal - coptotal)
        Label8.Text = difference
        Dim totalerrors As String = totalerror
        Label5.Text = totalerrors
        Dim adjusts As String = Math.Abs(totalerror - difference)
        Label9.Text = adjusts
        If adjusts > adjvariation Or totalerror > variation Then 'if there is significant change
            getnewreference()
            PictureBox1.Image = reference
        End If
        Timer2.Enabled = True 'get the next current picture
    End Sub
    Private Sub getnewreference() 'use current picture as the new reference
        Dim copbound As New Rectangle(xcop, ycop, 347, 300) ' copy video box
        Dim graph As Graphics = Graphics.FromImage(reference)
        graph.CopyFromScreen(copbound.Location, New Point(0, 0), copbound.Size)
        graph.Dispose()
        encodesave()  'compress and save
        picnum = picnum + 1
    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
        If Button2.Text = "pause monitor" Then
            Timer2.Enabled = False
            Button2.Text = "resume monitor"
        Else
            Timer2.Enabled = True
            Button2.Text = "pause monitor"
        End If
    End Sub
    Private Sub encodesave()  'must use new filename for each save !!!!!!!!!!!!!
        Dim picnums As String = picnum 'save the picture get file path first =0
        Dim picnumsave As String = "webimage" + picnums + ".jpg"
        filepath = System.IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.MyDocuments, "webcamimage")
        filepath = System.IO.Path.Combine(filepath, picnumsave)
        Dim jgpEncoder As ImageCodecInfo = GetEncoder(ImageFormat.Jpeg)
        ' Create an Encoder object based on the GUID
        ' for the Quality parameter category.
        Dim myEncoder As System.Drawing.Imaging.Encoder = System.Drawing.Imaging.Encoder.Quality
        ' Create an EncoderParameters object.
        ' An EncoderParameters object has an array of EncoderParameter
        ' objects. In this case, there is only one
        ' EncoderParameter object in the array.
        Dim myEncoderParameters As New EncoderParameters(1)
        Dim myEncoderParameter As New EncoderParameter(myEncoder, comp)
        myEncoderParameters.Param(0) = myEncoderParameter
        reference.Save(filepath, jgpEncoder, myEncoderParameters)
        'must do exactly as codecs1 or get run error
    End Sub
    Private Function GetEncoder(ByVal format As ImageFormat) As ImageCodecInfo
        'this is a generalisation to get the encoder for supported formats
        Dim codecs As ImageCodecInfo() = ImageCodecInfo.GetImageDecoders()
        'has full details of the existing codecs
        Dim codec As ImageCodecInfo
        For Each codec In codecs
            If codec.FormatID = format.Guid Then
                Return codec 'the required encoder
            End If
        Next codec
        Return Nothing 'must have to prevent run error when fomat encoder not available
    End Function

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click
        Timer2.Enabled = False  'disable new pics while changing mode
        Me.BackColor = Color.Black  'set all displays to off
        Button1.Visible = False
        Button2.Visible = False
        Button3.Visible = False  'dont need on screen
        Label2.Visible = False
        Label3.Visible = False
        Label4.Visible = False
        TextBox1.Visible = False
        TextBox2.Visible = False
        Me.ShowInTaskbar = False 'these required to fill screen
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.None
        Me.WindowState = FormWindowState.Maximized
        Me.MaximizeBox = False
        Me.MinimizeBox = False
        xvid = 0
        yvid = 0  'new position of video
        xcop = 361
        ycop = 355  'new position of current
        PictureBox1.Visible = False  'dont want reference in screen save
        Timer3.Enabled = True 'lets move around
        Timer2.Enabled = True 'back to normal moniter
    End Sub

    Private Sub PictureBox2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles PictureBox2.Click
        Timer2.Enabled = False  'disable pics during change
        Timer3.Enabled = False  'dont move anymore
        ' Dim setvid As New Point(4, 23) 'start point of reference
        ' AxVideoPreview1.Location = setvid
        Me.BackColor = Color.Gainsboro 'restore all settings to normal run mode
        Button1.Visible = True
        Button2.Visible = True
        Button3.Visible = True  'put buttons back
        Label2.Visible = True
        Label3.Visible = True
        Label4.Visible = True
        TextBox1.Visible = True
        TextBox2.Visible = True
        Me.ShowInTaskbar = True
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.Sizable
        Me.WindowState = FormWindowState.Normal
        Me.MaximizeBox = True
        Me.MinimizeBox = True
        While yvid <> 1 'get video and current back in position
            Timer3_Tick(Nothing, Nothing) 'seems only way to do it
        End While
        xvid = 4
        yvid = 23  'return to form position
        xcop = 365
        ycop = 378  'return to form position
        Dim setlab As New Point(87, 289)
        Label1.Location = setlab  'return label position
        PictureBox1.Visible = True  'put back on form
        Timer2.Enabled = True 'back to normal moniter
    End Sub

    Private Sub Form1_Paint(ByVal sender As Object, ByVal e As System.Windows.Forms.PaintEventArgs) Handles Me.Paint
        'draw red border around video display where ever it is
        Dim g As Graphics = CreateGraphics()
        g.DrawRectangle(Pens.Red, AxVideoPreview1.Location.X - 1, AxVideoPreview1.Location.Y - 1, 346, 286)
        g.Dispose()
    End Sub

    Private Sub Timer3_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer3.Tick
        Invalidate()
        ylab = ylab + 10
        yvid = yvid + 10
        If yvid > 460 Then
            yvid = 1 'start at top after full screen
            ylab = 289
            ycop = 345 'levels up pictures
        End If
        Dim setlab As New Point(xlab, ylab)
        Label1.Location = setlab 'move time label
        Dim setvid As New Point(xvid + 1, yvid + 1) 'start point of reference
        AxVideoPreview1.Location = setvid  'move video display
        ycop = ycop + 10
        If ycop > 460 Then
            ycop = 8  'start at top
        End If
        Dim setpic As New Point(xcop, ycop)
        PictureBox2.Location = setpic 'move current picture
    End Sub
End Class