Capturing frames from MediaPlayer

[webnetworks]

Hi,

Is it possible to capture an image from a live videostream at a preset rate, e.g. every 5 seconds?

If so, how to establish this...

Thanks in advance.


Jeroen van den Bergh

[Cakkie]

Here's some code that captures the current frame of mediaplayer. The only drawback here is that it requires mediaplayer to be visible (just make mediaplayer always on top). It gets the frame and copies the image to a picturebox.

' add this code to a form with a button and a picturebox
'
' API functions
private Declare Function GetWindow Lib "user32" (byval hwnd as Long, byval wCmd as Long) as Long
private Declare Function GetWindowDC Lib "user32" (byval hwnd as Long) as Long
private Declare Function GetDesktopWindow Lib "user32" () as Long
private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (byval hwnd as Long, byval lpString as string, byval cch as Long) as Long
private Const GW_CHILD = 5
private Const GW_HWNDNEXT = 2
private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (byval hwnd as Long) as Long
private Const SRCCOPY = &HCC0020
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 GetWindowRect Lib "user32" (byval hwnd as Long, lpRect as RECT) as Long
private Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type

' actual code starts here, you just need aal of the above
private Sub Command1_Click()

Dim hwnd as Long
Dim strText as string
Dim Length as Long
Dim MovieHwnd as Long
Dim MovieDC as Long

' get the desktop window
hwnd = GetDesktopWindow()
' get the first child window
hwnd = GetWindow(hwnd, GW_CHILD)

' loop through all windows
Do Until hwnd = 0
Length = GetWindowTextLength(hwnd)
strText = Space(Length + 1)
' get the caption of the window
Call GetWindowText(hwnd, strText, Length + 1)
If Length <> 0 then
strText = Left(strText, Length)
If InStr(1, strText, "Media Player", vbTextCompare) > 0 then
' we found mediaplayer, let's search his childs
hwnd = GetWindow(hwnd, GW_CHILD)
GoTo SkipGetWindow
End If
If InStr(1, strText, "ActiveMovie Window", vbTextCompare) > 0 then
' we found a moviewindow
MovieHwnd = hwnd
End If
End If
hwnd = GetWindow(hwnd, GW_HWNDNEXT)
SkipGetWindow:
Loop

Dim MovieRect as RECT

' get the dimentions of the window
GetWindowRect MovieHwnd, MovieRect

' get the devicecontext
MovieDC = GetWindowDC(MovieHwnd)
' copie the picture
Call BitBlt(me.Picture1.hDC, 0, 0, MovieRect.Right - MovieRect.Left, MovieRect.Bottom - MovieRect.Top, MovieDC, 0, 0, SRCCOPY)

End Sub




Tom Cannaerts
slisse@planetinternet.be

Programming today is a race between software engineers striving to build bigger and better idot-proof programs, and the universe trying to produce bigger and better idiots. So far, the universe is winning -- Rich Cook

[webnetworks]

Thanks,

Perhaps it's even easier then explained. The MediaPlayer is running in the application as an ActiveX. So does that change a lot to your code?

Jeroen van den Bergh

[Cakkie]

That makes it way easier. The ActiveMovie control has a property hWnd. In the previous example, I used a lot of code to find that window, now we already have it, so the code looks like this:

private Declare Function GetWindowDC Lib "user32" (byval hwnd 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 Const SRCCOPY = &HCC0020
private Declare Function GetWindowRect Lib "user32" (byval hwnd as Long, lpRect as RECT) as Long
private Type RECT
Left as Long
Top as Long
Right as Long
Bottom as Long
End Type

' actual code starts here, you just need aal of the above
private Sub Command1_Click()

Dim MovieRect as RECT
Dim MovieHwnd as Long

' We have the window handle
MovieHwnd = ActiveMovie1.hWnd

' get the dimentions of the window
GetWindowRect MovieHwnd, MovieRect

' get the devicecontext
MovieDC = GetWindowDC(MovieHwnd)

' copie the picture
Call BitBlt(me.Picture1.hDC, 0, 0, MovieRect.Right - MovieRect.Left, MovieRect.Bottom - MovieRect.Top, MovieDC, 0, 0, SRCCOPY)

End Sub





Tom Cannaerts
slisse@planetinternet.be

Programming today is a race between software engineers striving to build bigger and better idot-proof programs, and the universe trying to produce bigger and better idiots. So far, the universe is winning -- Rich Cook

[webnetworks]

Thanks a lot Tom. It's working!!!


Regards,

Jeroen van den Bergh

[webnetworks]

Okay,

The application has been running on my workstation for over 48 hours without major problems. Now when I start the same application on my Server, the capture of the MediaPlayer screen does not work.

Both Server en Workstation have MediaPlayer 7 installed, all required DLL's and OCX's are copied correctly and still it doesn't work.

The strange thing is that when I move my cursor over the MediaPlayer part on the server, the cursor disappears behind the object, while my cursor moves over the object on my workstation.

What can be wrong????

And the other question is: The application need to be the topmost window to capture the content of the MediaPlayer object correctly. Is there a way to capture the content without being the topmost window, i.e. is it possible to capture data while running the application minimized?


Thanks,

Jeroen van den Bergh