INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

Video thumbnai

Video thumbnai

(OP)
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.

RE: Video thumbnai

(OP)
On second thoughts I would rather have it generate a separate small file containing an thumbnail image of the first movie frame.
This file would be always set to the remote workstation with the original movie file so when the remote user was faced with the choice of selecting a movie they would automatically see this thumbnail file instead of the movie. Eg MyMovie.avi would also have MyMovie.tbb in the same folder. This would save the remote app to have thumbnail generating capability every time it was used.
(a bit like the thumbs.db file for Windows Explorer but in a separate tiny file for each movie)

Like in the Adobe video editor DVD menu generator, it would also be nice to be able to select a frame in from the start so that movies that have a fade up from black don't just show a black thumbnail.

Hoping this is not too difficult for vb6!

RE: Video thumbnai

(OP)
I tried feeding the avi to a picbox1 using mcisendstring
then transferring it to another picbox2 with BltBit but the picture box has to be the same size as the video (autosize doesn't work) so I cant use it on different size videos. (using GDI32)
then shrinking using paintpicture but it seems I only get the top corner of the pic the same size.
Once I execute Picture2.picture=Picture1.picture once, MCIsendstring curiously keeps sending the right hand half of the pic to the second box box even though I have no code running to do this and seems to overrides paintpicture even when the movie is paused.

RE: Video thumbnai

>BltBit

Try StretchBlt instead (which we have previously mentioned to you)

RE: Video thumbnai

I've had some luck playing around with this. I just took the... "easy road" wink of retrieving thumbnails via Shell Automation objects.

Video thumbnails are accessible as one of the ExtendedProperty values of ShellFolderItem objects. The tough part is that these are returned as PROPVARIANT values, and in particular the SCID_THUMBNAILSTREAM (an argument you pass to ExtendedProperty) returns one with a VT_STREAM making it a bit troublesome in that VB6 cannot convert it to a standard Variant.

CODE

'Based on Windows SDK header file propkey.h:
Private Const SCID_THUMBNAILSTREAM As String = "{F29F85E0-4FF9-1068-AB91-08002B27B3D9},27" 

That can be done by calling PropVariantToVariant() and that gives you a Variant IStream object as an IUnknown.

This particular stream is designed for consumption by GDI+/WindowsCodecs, and isn't a simple PNG or JPEG in a stream. But GdipCreateBitmapFromStream() can read it just fine, and from there you are on your way.


The first issue is that this isn't speedy. I'm not sure what Shell32 is going through to get thethumbnails even though I had assumed they were retrieved using typical OLE Storage & Streams mechanisms. It almost seems too slow for that though.

The second issue is that depending on the video encoding format and codecs you have installed you might get nice results or a junk image back. I was almost ready to give it up until I realized I had VB6.exe in ffdshow's blacklist on my development PC. But testing the compiled EXE and allowing ffdshow use returned good images from everything but some DIVX formats.


I don't see a problem with quality, given the proper codec support. There also doesn't seem to be any problem with all-black thumbnails even with videos that have quite a few frames of black lead-in. Of course manually choosing a frame to capture as a thumbnail does have advantages... as long as somebody wants to sit through that process.

RE: Video thumbnai

(OP)
Thanks dil** - I'd have to think long about that one!
Can you point me to a simple code example of how to put that all together?

Can you explain why when I have two picture boxes that are half the size of the original movie, when I use MCIsendstring to play to the first box (and get the top left quarter of the picture, then execute Picture2.picture=Picture1.picture once, I get the right half of the movie showing in the second box even when they are separated?
If I halt the app in the IDE, the video continues to run the way Windows Media Player control does.
But why does the right half of the movie keep running and not a copy of the left half in the first box?

RE: Video thumbnai

I couldn't find a single example anywhere on the Web. The closest I came were some .Net code fragments where the made use of the Framework's hobo-handouts and thus didn't need to deal with the gory details of how things really work. That of course made even those snippets useless to a VB6 programmer, even if they had (a.) actually worked and (b.) been complete. All that I saw were non-working code accompanied by unanswered pleas for help.

I sometimes wonder if the world wouldn't be at the Star Trek transporter and food replicator level of technology now if Microsoft hadn't killed VB and diverted their resources into .Net! wink


Sounds like the old Windows Multimedia renders into a Device Context and your PictureBox controls end up sharing the same one, possibly due in part to their AutoRedraw settings. Since I don't understand what's going on there I guess I'm not sure why one stops and the other continues once you have "halted" the program (IDE Pause button?).

RE: Video thumbnai

Demo code posted at Shell Video Thumbnail Images.

May not be what you want though since you said you want to manually choose the frame to use.

RE: Video thumbnai

(OP)
What I meant is that the two half size boxes continue to show the moving video.
The left hand box shows the cropped left side of the video with the right hand box showing the right hand half of the video. Since I initially set the second box .picture = first box .picture, I thought they should show the same picture!
When I use MCIsendstring to pause the video, both boxes pause.http://www.tek-tips.com/viewthread.cfm?qid=1730397

Looks like MCISendstring overrides any attempt to use GDI

RE: Video thumbnai

Well I had the idea that underneath it wasn't using GDI at all and just renders into the window, so that would make some sense.

RE: Video thumbnai

I think VfW is just emulated using DirectShow in modern versions of Windows, which means About Video Rendering in DirectShow should apply, even though you have no control over the process when using the old APIs.

RE: Video thumbnai

(OP)
Another holy mystery?

I was able to use StretchBlt to create a thumbnail of a graphic but no luck with a video frame showing in a Picturebox (using MCISendstring to fill the picturebox)
so I came to the conclusion that I didn't really need a reduced size thumbnail but rather a graphic with the same pixels as the first video frame frame. I can show it in a reduced size imagebox in the final ap.

Even though GetFormat shows the 'picture" of the video to be a Bitmap, MCISendString really seems to send the picture to the screen underneath because if you set the initial picturebox smaller than the video frame so the frame is cropped then set another Picturebox or Imagebox to the first picturebox.picture and place them where the remaining parts of the picture would be, they fill in the missing parts of the picture exactly in the right place they would have been if the first box was big enough. It looks like you are looking through an old fashioned multi-pane glass window at the video running underneath!

Playing the movie shows all a moving picture in all three windows without any code updating the boxes pictures. In this case VN6 controls seem only used to reveal an underlying picture of a movie and not contain a picture of their own as intuition would suggest. GetFormat shows the picture to be a bitmap or a device independent bitmap.

Therefore Savepicture of this frame from any of the picture boxes or clipboard or form with a movie does not work giving only a white frame. I also cant get the video picture to feed to StretchBlt either if I wanted to reduce it.

Does this mean that the picture is not really in the box and the boxes are only revealing what is underneath? I understand MCISendString is using DirectDraw.

So how do I save this underlying "picture" or feed it to StretchBlt?
This would solve my problem.
This is the simple code without StretchBlt that I used with 6 command buttons and a picturebox

CODE

Option Explicit
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
Dim filename As String
 
Private Sub LOADIT_Click()
CommonDialog1.ShowOpen
filename = Chr(34) & CommonDialog1.filename & Chr(34)
End Sub

Private Sub OPENIT_Click()
mciSendString "close avi", 0, 0, 0
filename = "c:\BusStation\Messages\Test.avi"
mciSendString "open " & filename & " type mpegvideo alias avi parent " & Picture1.hWnd & " style child", 0, 0, 0
End Sub

Private Sub PAUSEIT_Click()
mciSendString "pause AVI", 0, 0, 0
End Sub

Private Sub PLAYIT_Click()
mciSendString "play avi", 0, 0, 0
End Sub

Private Sub SAVEIT_Click()
SavePicture Picture1.Image, Left(filename, (Len(filename) - 3)) & "bmp"
'****** This doesn't work
'Saves a blank picture instead

End Sub

Private Sub STOPIT_Click()
mciSendString "stop AVI", 0, 0, 0
End Sub 

RE: Video thumbnai

Quote:

Does this mean that the picture is not really in the box and the boxes are only revealing what is underneath? I understand MCISendString is using DirectDraw.
I think it is rendering into a private child window added to the PictureBox

Quote:

So how do I save this underlying "picture" or feed it to StretchBlt?
No idea. Not sure you can.

I think normally you would grab a frame using a capture filter T'ed with the preview graph.

RE: Video thumbnai

I don't think you can capture any video frame in that way if hardware acceleration is enabled.

If you are looking at creating thumbnail files, then you can use ffmpeg to extract any frame you want with a simple shell command:

ffmpeg.exe -i "D:\video file.flv" -an -ss 00:00:00 -an -r 1 -vframes 1 -y -s 320x240 "D:\video file thumbnail.bmp"

Most of it is straight forward. The 00:00:00 id hour:minute:second of where to grab from, 320x240 is the output image size.
You can grab to bmp, jpg or png.

When I do this kind of thing, I usually write the command out to a temp bat file, then run it using the VB Shell command and the OpenProcess, WaitForSingleObject and CloseHandle API's.

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

RE: Video thumbnai

I'm not sure that works for him either.

He seems to be creating a full-time job for a thumnail monkey to sit and have throusands of videos played at him each day, batting at a "feed me" lever when some desired image appears.

RE: Video thumbnai

(OP)
Thanks.
I will try ffmpeg.exe.

Sorry I didn't explain the reason for the thumbnail which is much more simple that the "monkey" concept!

I envisage a public advertising info display (like in a shop window) that the shop owner can select from a menu of 15 prearranged messages. These messages are pre-stored as files. Any message can be Custom richtext, SWF, JPG or a short movie file.

I want to provide a screen with fifteen 1/6 size thumbnail of each message to make it easier to select the message they want to use. They just click on the thumbnail to show it on the external screen.

I can easily generate a thumbnail from the full size files for all the other types except Movies. WindowsMediaPlayer only allows 1 thumbnail at a time.

That's why I want the movie thumbnails in an imagebox or picturebox.

Hopefully ffmpeg.exe will be the answer, creating and storing the movie thumbnails as BMP files when the original is imported.

RE: Video thumbnai

But the trick is knowing how far "in" to grab a frame, isn't it? So somebody will need to view each video and decide where to do a capture.

Otherwise you could just use the ones that the Windows Shell will fetch for you.

RE: Video thumbnai

<ahem> .. Given the now slightly clarified requirements, I think you'll find it is all possible with a picturebox and mciSendString ... here's some example code (which requires a form with two picture boxes and a command button called Main):

CODE

Option Explicit

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
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

Private Const SRCCOPY = &HCC0020

Private Type RECT
        Left As Long
        Top As Long
        Right As Long
        Bottom As Long
End Type

Private Boundingbox As RECT
 
Private Sub Main_Click()
    ThumbnailFrame 60, "c:\downloads\video1.avi", "C:\Downloads\test.bmp" ' By default MCI is working in frames rather than time
End Sub

Private Sub ThumbnailFrame(frame As Long, strVideoFile As String, strThumbname As String)
    GetVideo strVideoFile
    MoveToFrame frame ' actually, this will be nearest keyframe under default settings 
    ThumbNail strThumbname
End Sub

Private Sub GetVideo(strFilename As String)
    
mciSendString "close avi", 0, 0, 0
mciSendString "open " & strFilename & " type mpegvideo alias avi parent " & Picture1.hwnd & " style child", 0, 0, 0
mciSendString "put avi client at " & RECTtoStr(Boundingbox), 0, 0, 0 ' Scale it

End Sub

Private Sub MoveToFrame(frame As Long)
    mciSendString "play avi from " & frame & " to " & frame, 0, 0, 0
End Sub

Private Sub ThumbNail(strFilename)
    Dim framehwnd As Long
   
    Dim result As String
    Dim chars As Long
    result = Space(255)
    chars = 255
    
    mciSendString "status avi window handle", result, chars, 0& ' get handle to window displaying frame buffer
    framehwnd = Val(result)
    
    If framehwnd Then
        With Boundingbox
            BitBlt Picture2.hdc, .Top, .Left, .Right, .Bottom, GetDC(framehwnd), 0, 0, SRCCOPY ' since we resized the input we do not need stretchblt
        End With
    End If
    
    SavePicture Picture2.Image, strFilename
End Sub

Private Sub Form_Load()
    ' Some simple initialisation
    'filename = "C:\Downloads\video1.avi"
    With Boundingbox
        .Left = 0
        .Top = 0
        .Right = 100
        .Bottom = 100
    End With
    Picture2.BorderStyle = 0
    Picture2.Move Picture1.Left + Picture1.Width, Picture1.Top, 100 * Screen.TwipsPerPixelX, 100 * Screen.TwipsPerPixelY
End Sub

Private Function RECTtoStr(srcRect As RECT) As String
    RECTtoStr = srcRect.Left & " " & srcRect.Top & " " & srcRect.Right & " " & srcRect.Bottom
End Function 

RE: Video thumbnai

But once again you need to know what frame you want. Just hard-coding a guess wouldn't be much better than Shell's guess.

However this would be another way to avoid running a 3rd party utility.

RE: Video thumbnai

I tested strongm's code with the following results:

1. You need to set PictureBox2.AutoRedraw = True (otherwise I get a blank bitmap in the default ButtonFace color.)
2. It only works with hardware acceleration disabled (otherwise I get a blank bitmap that's all black.)

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

RE: Video thumbnai

>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)

RE: Video thumbnai

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

RE: Video thumbnai

So he'll probably do something else ... bigsmile

RE: Video thumbnai

(OP)
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.

RE: Video thumbnai

>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.

RE: Video thumbnai

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.

CODE --> vb

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!

RE: Video thumbnai

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

RE: Video thumbnai

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!

RE: Video thumbnai

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

RE: Video thumbnai

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

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

RE: Video thumbnai

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

RE: Video thumbnai

Yep, so it would appear

RE: Video thumbnai

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

RE: Video thumbnai

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!

RE: Video thumbnai

(OP)
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.

RE: Video thumbnai

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."

RE: Video thumbnai

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!

RE: Video thumbnai

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.

CODE --> VB

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!

RE: Video thumbnai

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!

RE: Video thumbnai

(OP)
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!

RE: Video thumbnai

Yeah, but 99% of those are city slickers who have no idea of how to drive on rural roads. I've travelled the whole country extensively escorting oversize trucks, and the one thing you learn really quick is that roos nearly always take off straight ahead when they get startled. So if they're facing the road, you can bet that they'll hop out straight in front of you. If they're facing away from the road, I don't even slow down, and I've never even come close to hitting one - they're predictable. They'll usually get up to speed before changing direction.

Emu's on the other hand are a totally different story. They run all over the place and always follow the leader. There's no way to know what they'll do. I've had heaps of close calls, the closest probably on the Mitchell Hwy a few kilometres out of Barringun. Came within about a metre of wiping out 3 of the stupid things.

But the best damage I've seen was to a new (at the time) Holden Statesman around 2006. The city slicker decided to put one wheel either side of some roadkill - BIG mistake with a car like that!

The roadkill was a huge wombat - it tore the whole cross-member out and took the bottom half of the transmission with it! All up over $8,000 damage!

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

RE: Video thumbnai

(OP)
My wife did that in the middle of the Nullabor Plains. It was only a small beast and luckily the lowest part of the middle of the car was the towbar tongue but it splattered the entire front of our camper trailer a lovely shade of red. Took days for the smell to fade.
On wombats, I thought they were endangered but at one part of W.A, I counted 25 dead ones on the roadside in 20km so there must be a plague of them there.

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close