Beiträge von Kr_g

Kr_g

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