Video thumbnai 2

[tedsmith]

How would I implement GDI+ (or other method) to make a separate thumbnail of the first frame of an AVI or mpg4 video file? (If this is possible)
Does this put the frame into an image or picture box or create a picture of it's own making?
I need each thumbnail as a separate small piece of data rather than just a shrunk version of the original on a screen.
I want to send say 5 thumbnails showing on a page with a different layout to a remote computer on a LAN so the thumbnails need to be in effect 5 separate small BMPs or some other form that can be shown on a remote image box rather than only create them on the screen.

 

[strongm]

>need to know what frame you want

Indeed. But that's not a coding issue ... (and Ted seems to know exactly which frame he wants - 1 - so presumably he knows that none of his videos have an imageless lead in)

 

[dilettante]

Well at least he has multiple alternatives to choose from now.

 

[strongm]

So he'll probably do something else ...

 

[tedsmith]

strongm to the rescue - again! (Please don't die before me!)
Your code works fine with video card acceleration off. It is the missing links I was looking for.

Yes very often movies have a black first frame as they fade in the scene. I do it to all my own "home movies".
Your code appears to select the 60th frame so avoiding most fade-ins.

By a slight alteration to your code I would think that I should be able to select the suitable picture frame with a slider control before deciding on which one to save. )Or is there perhaps a MCISendString Shuttle command?

The only worry is it only works with acceleration off so, is there a way to set this off in code and set it back on after the thumbnail is stored?

Or alternately get around the acceleration thingy another way?

I use a NVIDIA GeForce FX520 that has a specific adapter settings app but I would want it to work in any computer.

 

[strongm]

>You need to set PictureBox2.AutoRedraw = True

Yep, sorry, forgot to put that requirement into my post.

>Should be able to select the suitable picture frame with a slider control

The MoveToFrame method of my example was written to deal with exactly this sort of requirement. You should be able to select and move to any frame you want.

>only works with acceleration off

Hmm - wasn't able to test with acceleration since the VB I was using yesterday was running on a VM. Will have to investigate.

 

[Unscruffed]

All the resources that I found on the net relating to how to do this, use registry keys found in the "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Video\..." path, but this doesn't work for me at all on Windows XP Pro.

I found the correct key by comparing the registry before and after changing the acceleration setting in the display properties dialog, and only one key was changed at "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\ialm\Device0\Acceleration.Level".

You may need to do a similar thing if you are using Vista or later to find the correct registry path if this one doesn't work. The key name should be the same, which is "Acceleration.Level". Note that if you find several keys with that name, you should use the ones found in the "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet" path, and not the "HKEY_LOCAL_MACHINE\SYSTEM\ControlSetnnn" paths.

Acceleration.Level values:
0 = Full acceleration
1...
2...
3...
4...
5 = No acceleration

Note: When you set full acceleration using Display Properties, Windows actually deletes the key. This is the same as setting the value to zero. So if using a tool like "RegShot", set acceleration to full, take shot 1, then set acceleration to off, and take shot 2.
The RegShot report should show that one key has been created with a value of 5, and that's the key to use.

The following code has been tested and works on XP Pro.

Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32
Private Const CDS_TEST = &H4

Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long
Private Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long

Private Sub SetHarwareAcceleration(Value As Boolean)
    Dim lValue As Long
    Dim oWshShell As Object
    Dim uDevMode As DEVMODE
    lValue = IIf(Value, 0, 5)
    Set oWshShell = CreateObject("WScript.Shell")
    oWshShell.RegWrite "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\ialm\Device0\Acceleration.Level", lValue, "REG_DWORD"
    Set oWshShell = Nothing
    EnumDisplaySettings 0, 0, uDevMode
    ChangeDisplaySettings uDevMode, CDS_TEST
End Sub

Private Sub Form_Load()
    SetHarwareAcceleration False
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    SetHarwareAcceleration True
End Sub

You could of course (and probably should) check if the "Acceleration.Level" key exists first, and if so, store it's value and use that in the "QueryUnload" event.


Heaven doesn't want me, and Hell's afraid I'll take over!

 

[strongm]

Now that's interesting. Works fine with full acceleration enabled on my work PC (running XP)

 

[Unscruffed]

I think that it depends on the hardware and driver. I tested on two PC's, one with an MCI board, the other Asus. Both have onboard graphics and the capture only works with acceleration off in both cases. (All my PC's are XP Pro, XP64, or Server 2003.)

I remember having this same problem years ago with an old Pentium 4, which from memory had a Gigabyte board and Nvidia AGP graphics card.

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[strongm]

But then that's probably because the work PC has a very cheap graphics card that doesn't do video overlay

 

[Unscruffed]

Ahhhh - the good old days of the Commodore C64 and it's big brother, the 128D. We never had these issues back then.

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[dilettante]

So we're back to paying a "preview monkey" to pick a frame for each video again?

 

[strongm]

Yep, so it would appear

 

[dilettante]

Or maybe a bird? Good vision, many are quite clever and trainable. Some will talk back though.

 

[Unscruffed]

My bird never shuts up, and I can't seem to train her to do anything I want!

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[tedsmith]

Ahh - takes me back - I got my first significant programming contract thanks to a Commodore 64 (worth $150k profit in 1986) Used a XT to feed 10 commodores producing large colorful text video for passenger departure displays on our Main railway station platforms. Way ahead of anything else at the time.
I've still got one of the first Australian made XTs and a Commodore 64 under the house. Might be worth something as antiques soon. I remember the XT cost $1,500. It had no hard drive, a floppy only, 256K memory and an orange screen.

Is there anybody left in USA making computer motherboards? That stopped here in 1990.

I don't want to run fowl of animal protection societies so to avoid using monkeys, how about detecting the first frame that contains say 50% video levels and capturing that frame?

I could do this by playing the video as soon as converted then analysing say 9 pixel points on the thumbnail screen like a motion detector then stopping the video - or is there an easier way?

Anyway the monkeys would only be needed when a new video was loaded maybe once a month and I might be able to train kangaroos instead - they have very sharp eyes and there is a plague of them at the moment.

 

[dilettante]

Kangaroos?

Hmm, it is scary enough when you realize that training apes as workers was what led to The Planet of the Apes. Imagine a world where kangaroos "evolved from man.

 

[Unscruffed]

Kangaroos are predictable - it's the emu's you gotta watch. They're just stupid.

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[Unscruffed]

Okay Ted, this should do everything you want.

This is one single form which contains:
2 x CommandButton - names: cmStart, cmAbort
2 x PictureBox - names: pbSource, pbThumb

It should be straight forward to modify to your needs. The testing is done by examining or comparing RGB pixel values in the Timer1_Timer event.

Option Explicit

' **** IMPORTANT! ****
' Note that this code as is won't know if a video file plays all the way through to the end.
' If this happens, the timer will keep testing the last captured frame.
' I've taken a simple approach of using a frame counter variable, and once it reaches
' the maximum value, the thumbnail is saved regardless of whether or not it passes the test.
' This means that there is a limit on the number of frames tested for each file.
' You would need to modify this to suit your own needs if necessary.

' Hardware Acceleration Declarations...
Private Const CCHDEVICENAME As Long = 32
Private Const CCHFORMNAME As Long = 32
Private Const CDS_TEST = &H4

Private Type DEVMODE
    dmDeviceName As String * CCHDEVICENAME
    dmSpecVersion As Integer
    dmDriverVersion As Integer
    dmSize As Integer
    dmDriverExtra As Integer
    dmFields As Long
    dmOrientation As Integer
    dmPaperSize As Integer
    dmPaperLength As Integer
    dmPaperWidth As Integer
    dmScale As Integer
    dmCopies As Integer
    dmDefaultSource As Integer
    dmPrintQuality As Integer
    dmColor As Integer
    dmDuplex As Integer
    dmYResolution As Integer
    dmTTOption As Integer
    dmCollate As Integer
    dmFormName As String * CCHFORMNAME
    dmUnusedPadding As Integer
    dmBitsPerPel As Integer
    dmPelsWidth As Long
    dmPelsHeight As Long
    dmDisplayFlags As Long
    dmDisplayFrequency As Long
End Type

Private Declare Function ChangeDisplaySettings Lib "user32.dll" Alias "ChangeDisplaySettingsA" (ByRef lpDevMode As DEVMODE, ByVal dwFlags As Long) As Long
Private Declare Function EnumDisplaySettings Lib "user32.dll" Alias "EnumDisplaySettingsA" (ByVal lpszDeviceName As String, ByVal iModeNum As Long, ByRef lpDevMode As DEVMODE) As Long

Private mRegAccelKey As String  ' <= Registry key (full path) for the Hardware Acceleration value.
Private mAccelValue As Long     ' <= Original Hardware Acceleration value.

' GetDIBits Declarations...
Private Const BI_RGB As Long = 0
Private Const DIB_RGB_COLORS As Long = 0

Private Type BITMAPINFOHEADER
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Private Type RGBQUAD
    Blue As Byte
    Green As Byte
    Red As Byte
    Alpha As Byte
End Type

Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFOHEADER, ByVal wUsage As Long) As Long

Private mBmpHdr As BITMAPINFOHEADER
Private mOldBits() As RGBQUAD   ' <= Previous frame bits (you only need this if you're comparing frame to frame).
Private mTmpBits() As RGBQUAD   ' <= Current frame bits.
Private mCount As Long          ' <= Upper bound of the 2 arrays above.
Private mFirstFrame As Boolean  ' <= (See Timer1_Timer event.)

' MCI Playback Declarations...
Private Const SRCCOPY = &HCC0020

Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long

' Blitting Declarations...
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As Long) As Long

' General Variables...
Private mVideoPath As String
Private mThumbFile As String
Private mThumbWidth As Long
Private mThumbHeight As Long
Private mFrameCount As Long
Private mFrameMax As Long
Private mWshShell As Object
Private mFileList As Collection
Private mAbort As Boolean

' Form_Load '
Private Sub Form_Load()
    ' START SETUP:
        ' mVideoPath:
            ' Set the path to the video files (make sure it ends with a backslack)...
            mVideoPath = Replace(App.Path & "\", "\\", "\")
        ' mRegAccelKey:
            ' You would need to find the correct registry key for each target OS and do an OS test here.
            ' This key is correct for XP Pro SP3.
            mRegAccelKey = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\ialm\Device0\Acceleration.Level"
        ' mThumbWidth:
            ' Set the desired thumbnail width in pixels...
            mThumbWidth = 128
        ' mThumbHeight:
            ' Set the desired thumbnail height in pixels...
            mThumbHeight = 96
        ' Timer1.Interval:
            ' You can set the test interval as necessary. For example, if the Timer1_Timer routine takes
            ' 5ms to run, then setting the interval to 35 would  give a test rate of around 25 frames
            ' per second. ( 1000 / (35+5) = 25 ).
            ' If doing comparison between frames, you should calculate this value so that you are testing
            ' at the same or slower frame rate than the source video.
            Timer1.Interval = 35
        ' mFrameMax:
            ' Set the maximum number of frames to test...
            mFrameMax = 250 ' <= (10 seconds if everything is 25fps).
    ' END SETUP.
    Set mWshShell = CreateObject("WScript.Shell")
    Me.ScaleMode = vbPixels
    With cmStart
        .Caption = "Start"
        .Move 5, 5, 80, 30
        .Enabled = True
    End With
    With cmAbort
        .Caption = "Abort"
        .Move 90, 5, 80, 30
        .Enabled = False
    End With
    With pbSource
        .ScaleMode = vbPixels
        .BackColor = vbApplicationWorkspace
        .BorderStyle = 0
        .Move 5, 40, mThumbWidth, mThumbHeight
    End With
    With pbThumb
        .AutoRedraw = True
        .ScaleMode = vbPixels
        .BackColor = vbApplicationWorkspace
        .BorderStyle = 0
        .Move mThumbWidth + 10, 40, mThumbWidth, mThumbHeight
    End With
    With mBmpHdr
        .biSize = 40
        .biWidth = mThumbWidth
        .biHeight = -mThumbHeight
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = BI_RGB
        .biSizeImage = (mThumbWidth * .biBitCount * 4)
    End With
    mCount = (mThumbWidth * mThumbHeight - 1)
    ReDim mOldBits(mCount)
    ReDim mTmpBits(mCount)
    ' Get the current Harware Acceleration value...
    GetHarwareAcceleration
    ' Disable Harware Acceleration if not disabled already...
    If mAccelValue <> 5 Then
        SetHarwareAcceleration 5
    End If
End Sub

' Form_QueryUnload '
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    ' Restore Harware Acceleration value if necessary...
    If mAccelValue <> 5 Then
        SetHarwareAcceleration mAccelValue
    End If
    Set mWshShell = Nothing
    Set mFileList = Nothing
End Sub

' cmStart_Click '
Private Sub cmStart_Click()
    cmStart.Enabled = False
    cmAbort.Enabled = True
    mAbort = False
    ' Clear the video file list...
    Set mFileList = New Collection
    ' Add video files to the list using their extensions...
    AddFiles "avi"
    AddFiles "flv"
    AddFiles "mp4"
    ' Start processing...
    ProcessNextFile
End Sub

' cmAbort_Click '
Private Sub cmAbort_Click()
    mAbort = True
    cmAbort.Enabled = False
End Sub

' AddFiles '
Private Sub AddFiles(Extension As String)
    Dim sFilename As String
    sFilename = Dir$(mVideoPath & "*." & Extension)
    Do While Len(sFilename)
        mFileList.Add mVideoPath & sFilename
        sFilename = Dir$
    Loop
End Sub

' ProcessNextFile '
Private Sub ProcessNextFile()
    Dim sFilename As String
    pbSource.Cls
    pbThumb.Cls
    DoEvents
    ' Sanity check...
    CloseVideo
    If (mFileList.Count > 0) And (Not mAbort) Then
        ' Reset the FirstFrame flag...
        mFirstFrame = True
        ' Get the next file in the list...
        sFilename = mFileList(1)
        mFileList.Remove 1
        mThumbFile = Left$(sFilename, InStrRev(sFilename, ".") - 1) & "_Thumbnail.bmp"
        ' Open and play video. Note that the filename needs to be quoted if it contains spaces...
        mciSendString "open """ & sFilename & """ type mpegvideo alias avi parent " & pbSource.hWnd & " style child", 0, 0, 0
        mciSendString "put avi client at 0 0 " & mThumbWidth & " " & mThumbHeight, 0, 0, 0
        ' No need for "from frame to frame" anymore, just play from the start...
        mciSendString "play avi", 0, 0, 0
        Timer1 = True
    Else
        cmStart.Enabled = True
        cmAbort.Enabled = False
    End If
End Sub

' Timer1_Timer '
Private Sub Timer1_Timer()
    Dim i As Long
    Dim lFrameWnd As Long
    Dim sResult As String
    Timer1 = False ' <= Stop the timer.
    pbThumb.Cls
    ' Check if aborted...
    If mAbort Then
        CloseVideo
        pbSource.Cls
        pbThumb.Cls
        cmStart.Enabled = True
        Exit Sub
    End If
    sResult = Space(16)
    mciSendString "status avi window handle", sResult, 16, 0
    lFrameWnd = Val(sResult)
    If lFrameWnd Then
        With pbThumb
            ' Grab current frame to pbThumb...
            BitBlt .hDC, 0, 0, mThumbWidth, mThumbHeight, GetDC(lFrameWnd), 0, 0, SRCCOPY
            ' Store the current frame RGBA bits in the mTmpBits array...
            GetDIBits .hDC, .Image.Handle, 0, mThumbHeight, mTmpBits(0), mBmpHdr, DIB_RGB_COLORS
        End With
        ' mFirstFrame:
        ' If you are doing comparison (using both mOldBits and mTmpBits arrays), you need to
        ' fill the mOldBits array with the first frame before you can do any testing...
        If mFirstFrame Then
            ' This is the first frame grabbed, so copy it to the mOldBits array and don't test.
            mOldBits = mTmpBits
            ' Set the FirstFrame flag to false...
            mFirstFrame = False
            ' Reset the frame counter variable...
            mFrameCount = 1
            ' Restart the timer for the next test, and exit.
            Timer1 = True
            Exit Sub
        Else
            ' Increment the frame counter...
            mFrameCount = (mFrameCount + 1)
        End If
        ' Here is where you can do any checking you desire...
        ' In this example, I simply test for a pixel with 50% or more red and green.
        ' You can increase the Step value here to speed up the code, although this
        ' shouldn't be necessary with modern PC's and thumbnail size images.
        ' Eg: Step 1 = test every pixel, Step 5 = test every 5th pixel, etc.
        For i = 0 To mCount Step 1
            With mTmpBits(i)
                If .Red > 128 And .Green > 128 Then ' <= THE EXAMPLE TEST CODE.
                    ' Once your test succeeds, save the thumbnail and exit...
                    SaveThumbnail
                    Exit Sub
                End If
            End With
            DoEvents
        Next
        ' Check if we have reached the frame limit for this file...
        If mFrameCount >= mFrameMax Then
            ' If you wanted to, you could save a default thumb here. or a picture that
            ' reads "image not available" etc.
            ' In this example, I just save the current frame regardless.
            SaveThumbnail
        Else
            ' The test failed, so here you can copy the current bits to the mOldBits array.
            ' You can use this to compare the current frame (mTmpBits) with the last frame you
            ' checked (mOldBits) in the next test. (Eg: if you were testing for motion detection.)
            mOldBits = mTmpBits
            ' Restart the timer for the next test...
            Timer1 = True
        End If
    End If
End Sub

' CloseVideo '
Private Sub CloseVideo()
    mciSendString "stop avi", 0, 0, 0
    mciSendString "close avi", 0, 0, 0
End Sub

' SaveThumbnail '
Private Sub SaveThumbnail()
    CloseVideo
    SavePicture pbThumb.Image, mThumbFile
    ProcessNextFile
End Sub

' GetHarwareAcceleration '
Private Sub GetHarwareAcceleration()
    Dim vTmp As Variant
    On Error Resume Next
    vTmp = mWshShell.RegRead(mRegAccelKey)
    If Err Then
        mAccelValue = 0
    Else
        mAccelValue = Val(vTmp)
    End If
    On Error GoTo 0
End Sub

' SetHarwareAcceleration '
Private Sub SetHarwareAcceleration(Value As Long)
    Dim uDevMode As DEVMODE
    mWshShell.RegWrite mRegAccelKey, Value, "REG_DWORD"
    EnumDisplaySettings 0, 0, uDevMode
    ChangeDisplaySettings uDevMode, CDS_TEST
End Sub

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[Unscruffed]

Oops - I forgot that the form also contains a Timer named Timer1.
But I'm sure that you already figured that out.

Heaven doesn't want me, and Hell's afraid I'll take over!

 

[tedsmith]

Thanks.
Amazing! Your code is nearly as long as my entire application!

Talk to anybody, without a substantial bullbar on their car, who has hit a Kangaroo at 120kph and they will certainly say Kangaroos are unpredictable. (A 6ft red usually demolishes a bullbar as well)
You can see your headlight reflection in their eyes from way off. They graze on the roadside and suddenly just as you get to them they leap out in front of you!