Breadcrumbs

[Bogoh67]

this is not codenstuff's way but anyways
btw all credits(for this tutorial) go to Seven7 on leetcoders.org he's really good
start off by making a new app and adding a button and timer
make the buttons name "StartButton" and the text "Start"
make the timers name "bmptimer" and interval = 100 enabled = false

now im not going to fully explain all the details because it would make it harder to understand BUT
anyways im going to make this easy-to-understand

and the code is

suggestion from Yoursocksrox all credits go to him for this phrase
So here we're creating a AviWriter which Opens a Avi File called Test located in C:\ with 10 frames/second. Then we're adding all the frames and at last we close the writer. And now it's done. In this last part you can do many things, give the user the opportunity to choose file path, changing frame rate, pausing, changing recording area and so on. This tutorial is not written by me I just want to share it!

Code: Select all

Imports System.Drawing.Imaging
Imports System.Runtime.InteropServices

Public Class Form1
    Private screenbimaps(9999999) As Bitmap
    Private currentBitmap As Integer = 0
    Private Sub StartButton_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles StartButton.Click
        If StartButton.Text = "Start" Then
            currentBitmap = 0
            StartButton.Text = "Stop"
            bmpTimer.Enabled = True
        Else
            CreateFile()
            StartButton.Text = "Start"
            bmpTimer.Enabled = False
        End If
    End Sub
    Private Sub bmpTimer_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles bmpTimer.Tick
        If currentBitmap < 100 Then
            Dim w As Integer = Screen.PrimaryScreen.WorkingArea.Width
            Dim h As Integer = Screen.PrimaryScreen.WorkingArea.Height
            Dim bmp As New Bitmap(w, h)
            Using gr As Graphics = Graphics.FromImage(bmp)
                gr.CopyFromScreen(0, 0, 0, 0, bmp.Size)
            End Using
            screenbimaps(currentBitmap) = bmp
            currentBitmap += 1
        Else
            CreateFile()
            StartButton.Text = "Start"
            bmpTimer.Enabled = False
        End If
    End Sub
    Private Sub CreateFile()
        Dim Writer As New AviWriter
        Writer.OpenAVI("C:\test.avi", 10)
        For Frame As Integer = 0 To currentBitmap - 1
            Writer.AddFrame(screenbimaps(Frame))
        Next
        Writer.Close()
    End Sub
End Class

Public Class Avi

    Public Const StreamtypeVIDEO As Integer = 1935960438
    Public Const OF_SHARE_DENY_WRITE As Integer = 32
    Public Const BMP_MAGIC_COOKIE As Integer = 19778



    <StructLayout(LayoutKind.Sequential, Pack:=1)> _
    Public Structure RECTstruc
        Public left As UInt32
        Public top As UInt32
        Public right As UInt32
        Public bottom As UInt32
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)> _
    Public Structure BITMAPINFOHEADERstruc
        Public biSize As UInt32
        Public biWidth As Int32
        Public biHeight As Int32
        Public biPlanes As Int16
        Public biBitCount As Int16
        Public biCompression As UInt32
        Public biSizeImage As UInt32
        Public biXPelsPerMeter As Int32
        Public biYPelsPerMeter As Int32
        Public biClrUsed As UInt32
        Public biClrImportant As UInt32
    End Structure

    <StructLayout(LayoutKind.Sequential, Pack:=1)> _
    Public Structure AVISTREAMINFOstruc
        Public fccType As UInt32
        Public fccHandler As UInt32
        Public dwFlags As UInt32
        Public dwCaps As UInt32
        Public wPriority As UInt16
        Public wLanguage As UInt16
        Public dwScale As UInt32
        Public dwRate As UInt32
        Public dwStart As UInt32
        Public dwLength As UInt32
        Public dwInitialFrames As UInt32
        Public dwSuggestedBufferSize As UInt32
        Public dwQuality As UInt32
        Public dwSampleSize As UInt32
        Public rcFrame As RECTstruc
        Public dwEditCount As UInt32
        Public dwFormatChangeCount As UInt32
        <MarshalAs(UnmanagedType.ByValArray, SizeConst:=64)> _
        Public szName As UInt16()
    End Structure



    'Initialize the AVI library
    <DllImport("avifil32.dll")> _
    Public Shared Sub AVIFileInit()
    End Sub

    'Open an AVI file
    <DllImport("avifil32.dll", PreserveSig:=True)> _
    Public Shared Function AVIFileOpen(ByRef ppfile As Integer, ByVal szFile As [String], ByVal uMode As Integer, ByVal pclsidHandler As Integer) As Integer
    End Function

    'Create a new stream in an open AVI file
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIFileCreateStream(ByVal pfile As Integer, ByRef ppavi As IntPtr, ByRef ptr_streaminfo As AVISTREAMINFOstruc) As Integer
    End Function

    'Set the format for a new stream
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIStreamSetFormat(ByVal aviStream As IntPtr, ByVal lPos As Int32, ByRef lpFormat As BITMAPINFOHEADERstruc, ByVal cbFormat As Int32) As Integer
    End Function

    'Write a sample to a stream
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIStreamWrite(ByVal aviStream As IntPtr, ByVal lStart As Int32, ByVal lSamples As Int32, ByVal lpBuffer As IntPtr, ByVal cbBuffer As Int32, ByVal dwFlags As Int32, _
     ByVal dummy1 As Int32, ByVal dummy2 As Int32) As Integer
    End Function

    'Release an open AVI stream
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIStreamRelease(ByVal aviStream As IntPtr) As Integer
    End Function

    'Release an open AVI file
    <DllImport("avifil32.dll")> _
    Public Shared Function AVIFileRelease(ByVal pfile As Integer) As Integer
    End Function

    'Close the AVI library
    <DllImport("avifil32.dll")> _
    Public Shared Sub AVIFileExit()
    End Sub

End Class
Public Class AviWriter
    Private aviFile As Integer = 0
    Private aviStream As IntPtr = IntPtr.Zero
    Private frameRate As UInt32 = 0
    Private countFrames As Integer = 0
    Private width As Integer = 0
    Private height As Integer = 0
    Private stride As UInt32 = 0
    Private fccType As UInt32 = Avi.StreamtypeVIDEO
    Private fccHandler As UInt32 = 1668707181
    Private strideInt As Integer
    Private strideU As UInteger
    Private heightU As UInteger
    Private widthU As UInteger

    Public Sub OpenAVI(ByVal fileName As String, ByVal frameRate As UInt32)
        Me.frameRate = frameRate

        Avi.AVIFileInit()


        Dim OpeningError As Integer = Avi.AVIFileOpen(aviFile, fileName, 4097, 0)
        If OpeningError <> 0 Then
            Throw New Exception("Error in AVIFileOpen: " + OpeningError.ToString())
        End If
    End Sub
    Public Sub AddFrame(ByVal bmp As Bitmap)

        bmp.RotateFlip(RotateFlipType.RotateNoneFlipY)

        Dim bmpData As BitmapData = bmp.LockBits(New Rectangle(0, 0, bmp.Width, bmp.Height), ImageLockMode.[ReadOnly], PixelFormat.Format24bppRgb)
        If countFrames = 0 Then
            Dim bmpDatStride As UInteger = bmpData.Stride
            Me.stride = DirectCast(bmpDatStride, UInt32)
            Me.width = bmp.Width
            Me.height = bmp.Height
            CreateStream()
        End If
        strideInt = stride
        Dim writeResult As Integer = Avi.AVIStreamWrite(aviStream, countFrames, 1, bmpData.Scan0, DirectCast((strideInt * height), Int32), 0, _
         0, 0)

        If writeResult <> 0 Then
            Throw New Exception("Error in AVIStreamWrite: " + writeResult.ToString())
        End If
        bmp.UnlockBits(bmpData)
        System.Math.Max(System.Threading.Interlocked.Increment(countFrames), countFrames - 1)
    End Sub
    Public Sub Loading()
        MsgBox("Done" & vbNewLine & "Recorded To: " & vbNewLine & "C:\test.avi")
    End Sub
    Public Sub CreateStream()
        Dim strhdr As New Avi.AVISTREAMINFOstruc()
        strhdr.fccType = fccType
        strhdr.fccHandler = fccHandler
        strhdr.dwScale = 1
        strhdr.dwRate = frameRate
        strideU = stride
        heightU = height
        strhdr.dwSuggestedBufferSize = DirectCast((stride * strideU), UInt32)
        strhdr.dwQuality = 10000

        heightU = height
        widthU = width
        strhdr.rcFrame.bottom = DirectCast(heightU, UInt32)
        strhdr.rcFrame.right = DirectCast(widthU, UInt32)
        strhdr.szName = New UInt16(64) {}
        Dim createResult As Integer = Avi.AVIFileCreateStream(aviFile, aviStream, strhdr)
        If createResult <> 0 Then
            Throw New Exception("Error in AVIFileCreateStream: " + createResult.ToString())
        End If
        Loading()
        Dim bi As New Avi.BITMAPINFOHEADERstruc()
        Dim bisize As UInteger = Marshal.SizeOf(bi)
        bi.biSize = DirectCast(bisize, UInt32)
        bi.biWidth = DirectCast(width, Int32)
        bi.biHeight = DirectCast(height, Int32)
        bi.biPlanes = 1
        bi.biBitCount = 24

        strideU = stride
        heightU = height
        bi.biSizeImage = DirectCast((strideU * heightU), UInt32)
        Dim formatResult As Integer = Avi.AVIStreamSetFormat(aviStream, 0, bi, Marshal.SizeOf(bi))
        If formatResult <> 0 Then
            Throw New Exception("Error in AVIStreamSetFormat: " + formatResult.ToString())
        End If
        Loading()
    End Sub
    Public Sub Close()
        If aviStream <> IntPtr.Zero Then
            Avi.AVIStreamRelease(aviStream)
            aviStream = IntPtr.Zero
        End If
        If aviFile <> 0 Then
            Avi.AVIFileRelease(aviFile)
            aviFile = 0
        End If
        Avi.AVIFileExit()
    End Sub
End Class

and because i dont like being enemies with yoursocksrox here
This tutorial is not written by me I just want to share it!


*Edit

requested screenshot

1.JPG

[Usman55]

Can you post a screenshot pplease?

[mandai]

It would be great to see codec support in this.
Would it be more memory efficient by having a list of Bitmap rather than a fixed array of 9999999?

[Bogoh67]

u can try but i dont think it'll work but i think it would be more memory efficient

[NecroPhis]

hmm nice tut thanx