Ich versuche einzelne Frames mittels mpeg2lib zu extrahieren und in einer PictureBox darzustellen, bisher leider ohne Erfolg.
Vielleicht hat jemand das schon mal mit VB6 gemacht und kann mir sagen, was ich falsch mache. Danke im Vorraus.
Code
Option Explicit
Private Declare Function OpenMPEG2File Lib "mpeg2lib.dll" Alias "?OpenMPEG2File@@YGHPAD_J1@Z" (ByVal FileName As String, ByVal Offset As Currency, ByVal Size As Currency) As Long
Private Declare Function OpenMPEG2Disk Lib "mpeg2lib.dll" Alias "?OpenMPEG2Disk@@YGHE_J0@Z" (ByVal Drive As Byte, ByVal Offset As Currency, ByVal Size As Currency) As Long
Private Declare Function OpenMPEG2Stream Lib "mpeg2lib.dll" Alias "?OpenMPEG2Stream@@YGHP6GK_JPADKK@ZH0K@Z" (ByVal StreamGetCallback As Long, ByVal SequentialStream As Long, ByVal Size As Currency, ByVal ID As Long) As Long
Private Declare Sub GetMPEG2FrameInfo Lib "mpeg2lib.dll" Alias "?GetMPEG2FrameInfo@@YGXPAUTVideoFrameInfo@@@Z" (ByRef FrameInfo As TVideoFrameInfo)
Private Declare Sub GetMPEG2FileInfo Lib "mpeg2lib.dll" Alias "?GetMPEG2FileInfo@@YGXPAUTVideoFileInfo@@@Z" (ByRef FileInfo As TVideoFileInfo)
Private Declare Sub CloseMPEG2File Lib "mpeg2lib.dll" Alias "?CloseMPEG2File@@YGXXZ" ()
Private Declare Function GetMPEG2Frame Lib "mpeg2lib.dll" Alias "?GetMPEG2Frame@@YGPAEXZ" () As Long ' pbyte
Private Declare Sub MPEG2Seek Lib "mpeg2lib.dll" Alias "?MPEG2Seek@@YGX_J@Z" (ByVal Position As Currency)
Private Declare Sub SetMPEG2PixelFormat Lib "mpeg2lib.dll" Alias "?SetMPEG2PixelFormat@@YGXH@Z" (ByVal Format As enMPEG2LibFormat) ' See formats in MPEG2Dec.h
Private Declare Function WriteDataToFile Lib "mpeg2lib.dll" Alias "?WriteDataToFile@@YG_JPAD_J@Z" (ByVal FileName As String, ByVal Size As Currency) As Currency
Private Declare Sub SetRGBScaleFlag Lib "mpeg2lib.dll" Alias "?SetRGBScaleFlag@@YGXH@Z" (ByVal DoScaling As Long)
Private Declare Sub SkipMPEG2Frames Lib "mpeg2lib.dll" Alias "?SkipMPEG2Frames@@YGXH@Z" (ByVal FrameCount As Long)
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function GetFileSizeEx Lib "kernel32.dll" (ByVal hFile As Long, lpFileSize As Currency) As Boolean
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long
Private Declare Function CreateDIBSection Lib "gdi32.dll" (ByVal hdc As Long, ByRef pBitmapInfo As BITMAPINFO, ByVal un As Long, ByVal lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (ByVal hdcDest As Long, ByVal nXDest As Long, ByVal nYDest As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hdcSrc As Long, ByVal nXSrc As Long, ByVal nYSrc As Long, ByVal dwRop As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SetDIBits Lib "gdi32.dll" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Public Enum enMPEG2LibFormat
mlfNone = 0
mlfRGB24 = 1
mlfGray8 = 2
mlfYUV24Planar = 3
End Enum
Private Type TVideoFrameInfo
Width As Long
Height As Long
FrameRate As Double
AspectRatio As Double
End Type
Private Type TVideoFileInfo
Size As Currency
Position As Currency
Frame As Long
VideoPTS As Long
End Type
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
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0
Private Sub Command1_Click()
Dim Ret, pFrame, Bitmap, DC, FrameSize As Long
Dim FileSize As Currency
Dim FileInfo As TVideoFileInfo
Dim FrameInfo As TVideoFrameInfo
Dim BMPInfo As BITMAPINFO
Ret = CreateFile("test4.m2v", &H80000000, &H1, 0, 3, &H80, 0)
GetFileSizeEx Ret, FileSize
CloseHandle Ret
FileSize = FileSize * 10000
Ret = OpenMPEG2File("test4.m2v", 0, FileSize)
SetMPEG2PixelFormat mlfRGB24
MPEG2Seek 1
GetMPEG2FileInfo FileInfo
GetMPEG2FrameInfo FrameInfo
Picture1.Width = FrameInfo.Width
Picture1.Height = FrameInfo.Height
FrameSize = FrameInfo.Width * FrameInfo.Height * 3
With BMPInfo.bmiHeader
.biBitCount = 24
.biCompression = BI_RGB
.biPlanes = 1
.biSize = Len(BMPInfo.bmiHeader)
.biWidth = FrameInfo.Width
.biHeight = FrameInfo.Height
.biSizeImage = FrameSize
End With
pFrame = GetMPEG2Frame
Bitmap = CreateCompatibleBitmap(Picture1.hdc, FrameInfo.Width, FrameInfo.Height)
DC = CreateCompatibleDC(Picture1.hdc)
Ret = SetDIBits(Picture1.hdc, Bitmap, 0, FrameInfo.Height, pFrame, BMPInfo, 0) '[I]Rückgabewert 0, hier ist wohl der Fehler[/I]
Bitmap = SelectObject(DC, Bitmap)
Ret = BitBlt(Picture1.hdc, 0, 0, FrameInfo.Width, FrameInfo.Height, DC, 0, 0, &HCC0020) '[I]Zeichnet ein schwarzes Bild in die PictureBox[/I]
Picture1.Refresh
DeleteObject (SelectObject(DC, Bitmap))
DeleteDC (DC)
CloseMPEG2File
End Sub
Alles anzeigen