Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

AVI File Frame Get Bits to String & Graphic DDT control

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • AVI File Frame Get Bits to String & Graphic DDT control

    First part - Save as rvAVI.bas

    Code:
    '******************************************************************************
    ' rvAvi.bas V 1.1 - Tested on XP  - PbWin 8.01 Compiler
    '
    ' Avi File wrapper. Check the rvAviTst to know how to use the lib. Basically:
    '
    ' hAvi as Long
    ' FileName as String
    ' sFrame as String
    ' FrameNum as Long
    ' .
    ' hAvi = rvAviOpen(FileName)
    ' .
    ' sFrame = rvAviGetFrame(byval hAvi,FrameNum)
    ' Graphic Set Bits sFrame
    ' .
    ' rvAviClose(byval hAvi)
    '
    '                      by RValois, September 2005.
    '
    '                          www.rvalois.com.br 
    '
    '                          [email protected]
    '
    '     This program is distributed in the hope that it will be useful,
    '     but WITHOUT ANY WARRANTY; without even the implied warranty of
    '     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    '
    '                         USE AT YOUR OWN RISK
    '
    '******************************************************************************
    #Include "win32api.inc"
    
    Type AVISTREAMINFOSTRUCT
      fccType               As Dword
      fccHandler            As Dword
      dwFlags               As Dword
      dwCaps                As Dword
      wPriority             As Word
      wLanguage             As Word
      dwScale               As Dword
      dwRate                As Dword
      dwStart               As Dword
      dwLength              As Dword
      dwInitialFrames       As Dword
      dwSuggestedBufferSize As Dword
      dwQuality             As Dword
      dwSampleSize          As Dword
      rcFrame               As RECT
      dwEditCount           As Dword
      dwFormatChangeCount   As Dword
      szName                As Asciiz*64
    End Type
    
    
    Declare Sub      AVIFileInit            Lib "avifil32.dll" Alias "AVIFileInit"            ()
    Declare Sub      AVIFileExit            Lib "avifil32.dll" Alias "AVIFileExit"            ()
    Declare Function AVIStreamOpenFromFile  Lib "avifil32.dll" Alias "AVIStreamOpenFromFile"  ( ByRef pAviVidStream As Long, _
                                                                                                ByRef szFile As Asciiz, _
                                                                                                ByVal fccType As Dword, _
                                                                                                ByVal lParam As Long, _
                                                                                                ByVal uMode As Dword, _
                                                                                                ByVal pclsidHandler As Long) As Long
    
    Declare Function AVIStreamRelease       Lib "avifil32.dll" Alias "AVIStreamRelease"       ( ByVal pAviVidStream As Long) As Long
    
    Declare Function AVIStreamInfo          Lib "avifil32.dll" Alias "AVIStreamInfo"          ( ByVal pAviVidStream As Long, _
                                                                                                ByRef AviStrInfo As AVISTREAMINFOSTRUCT, _
                                                                                                ByVal lSize As Long) As Long
    
    Declare Function AVIStreamReadFormat    Lib "avifil32.dll" Alias "AVIStreamReadFormat"    ( ByVal pAviVidStream As Long, _
                                                                                                ByVal lPos As Long, _
                                                                                                ByRef bmp As BITMAPINFO, _
                                                                                                ByRef pFormatSz As Long) As Long
    
    Declare Function AVIStreamGetFrameOpen  Lib "avifil32.dll" Alias "AVIStreamGetFrameOpen"  ( ByVal pAviVidStream As Long, _
                                                                                                ByRef bmi As BITMAPINFOHEADER) As Long
    Declare Function AVIStreamGetFrameClose Lib "avifil32.dll" Alias "AVIStreamGetFrameClose" ( ByVal pgf As Long) As Long
    
    Declare Function AVIStreamGetFrame      Lib "avifil32.dll" Alias "AVIStreamGetFrame"      ( ByVal pgf As Long, _
                                                                                                ByVal lPos As Long) As Long
    
    
    Type RVAVISTRUCT
      pAviVidStream As Dword
      AviStrmInfo As AVISTREAMINFOSTRUCT
      pgf As Long
    End Type
    
    '******************************************************************************
    Function rvAviGetLength(ByVal hAvi As RVAVISTRUCT Ptr) As Long
    '******************************************************************************
    
      If hAvi Then
        Function = @hAvi.AviStrmInfo.dwLength
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    Function rvAviGetFirstFrameNum(ByVal hAvi As RVAVISTRUCT Ptr) As Long
    '******************************************************************************
    
      If hAvi Then
        Function = @hAvi.AviStrmInfo.dwStart
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    Function rvAviGetSz(ByVal hAvi As RVAVISTRUCT Ptr, w As Long, h As Long) As Long
    '******************************************************************************
    
      If hAvi Then
        w = @hAvi.AviStrmInfo.rcFrame.nright - @hAvi.AviStrmInfo.rcFrame.nleft
        h = @hAvi.AviStrmInfo.rcFrame.nbottom - @hAvi.AviStrmInfo.rcFrame.ntop
        Function = %True
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    Function rvAviGetRate(ByVal hAvi As RVAVISTRUCT Ptr) As Long
    '******************************************************************************
    
      If hAvi Then
        Function = @hAvi.AviStrmInfo.dwRate/@hAvi.AviStrmInfo.dwScale
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    Function rvAviGetTimePerFrame(ByVal hAvi As RVAVISTRUCT Ptr) As Long
    '******************************************************************************
    
      If hAvi Then
        Function = 1000/rvAviGetRate(hAvi)
      Else
        Function = %False
      End If
    
    End Function
    
    '******************************************************************************
    Sub rvAviClose(ByVal hAvi As RVAVISTRUCT Ptr)
    '******************************************************************************
      If hAvi Then
        If @hAvi.pgf Then AVIStreamGetFrameClose(@hAvi.pgf)
        If @hAvi.pAviVidStream Then AviStreamRelease(@hAvi.pAviVidStream)
        HeapFree GetProcessHeap(), 0, hAvi
      End If
      AviFileExit()
    
    End Sub
    
    '******************************************************************************
    Function rvAviOpen(FileName As String) As Long
    '******************************************************************************
      Local bih As BITMAPINFOHEADER
      Local hAvi As RVAVISTRUCT Ptr
    
      hAvi = HeapAlloc(GetProcessHeap() , %HEAP_ZERO_MEMORY, SizeOf(RVAVISTRUCT))
      If hAvi Then
        AviFileInit()
    
        If AVIStreamOpenFromFile(@hAvi.pAviVidStream, ByVal StrPtr(FileName),mmioStringToFOURCC ("vids", 0),0,%OF_READ,%NULL) = 0 Then
          If AVIStreamInfo(@hAvi.pAviVidStream,@hAvi.AviStrmInfo,SizeOf(AVISTREAMINFOSTRUCT)) = 0 Then
    
            bih.biSize = SizeOf(bih)
            bih.biWidth = @hAvi.AviStrmInfo.rcFrame.nright - @hAvi.AviStrmInfo.rcFrame.nleft
            bih.biHeight = @hAvi.AviStrmInfo.rcFrame.nbottom - @hAvi.AviStrmInfo.rcFrame.ntop
            bih.biPlanes = 1
            bih.biBitCount = 32
            bih.biCompression = %BI_RGB
    
            @hAvi.pgf = AVIStreamGetFrameOpen(@hAvi.pAviVidStream, bih)
    
            If @hAvi.pgf Then
              Function = hAvi
              Exit Function
            End If
          End If
        End If
        rvAviClose(hAvi)
      End If
    
      Function = %False
    
    End Function
    
    '******************************************************************************
    Function rvAviGetFrame(ByVal hAvi As RVAVISTRUCT Ptr, ByVal FrameNum As Dword) As String
    '******************************************************************************
      Local pBmpIH  As BITMAPINFOHEADER Ptr
    
      If hAvi Then
        If FrameNum <= @hAvi.AviStrmInfo.dwLength   And FrameNum >= @hAvi.AviStrmInfo.dwStart  Then
          pBmpIH  = AVIStreamGetFrame(@hAvi.pgf, FrameNum)
          If pBmpIH  Then
            Function = Mkl$(@pBmpIH.biWidth) + Mkl$([email protected]) + Peek$ ([email protected], @pBmpIH.biSizeImage)
            Exit Function
          End If
        End If
      End If
    
      Function = ""
    
    End Function
    
    '******************************************************************************
    'END
    '******************************************************************************
         
    
    Second Part - Save as rvAviTst.bas
    
    '******************************************************************************
    '
    ' rvAviTst.bas V 1.0
    ' Tested on XP
    ' PbWin 8.01 Compiler
    '
    ' Uses rvAvi, Avi File wrapper.
    '
    '
    '
    '                      by RValois, September 2005.
    '
    '                          www.rvalois.com.br 
    '
    '                          [email protected]
    '
    '     This program is distributed in the hope that it will be useful,
    '     but WITHOUT ANY WARRANTY; without even the implied warranty of
    '     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    '
    '                         USE AT YOUR OWN RISK
    '
    '******************************************************************************
    
    '******************************************************************************
    '
    ' The rvAvi wrapper returns the avi frame on a string suitable for use on graphics controls.
    ' Like that:
    '
    ' hAvi as Long
    ' FileName as String
    ' sFrame as String
    ' FrameNum as Long
    ' .
    ' hAvi = rvAviOpen(FileName)
    ' .
    ' sFrame = rvAviGetFrame(byval hAvi,FrameNum)  'Now you have the frame bits on a string.
    ' Graphic Set Bits sFrame                      'See? quite easy!
    ' .
    ' rvAviClose(byval hAvi)
    '
    ' This example is intended to show how to use the rvAVI wrapper, basically how to access the avi frame bits,
    ' but yes, we are going to play avi files. Keep in mind though that it is not the best nor the usual way,
    ' but works fine.
    ' If the movie is compressed, you will need, as usual, the necessary AVI codec installed.
    ' I'm hearing you ask, what about avi file writer? And where is the sound?
    ' Well, maybe next time... now I need the avi frame bits only...
    '
    ' Follows the example.
    '
    '******************************************************************************
    
    #Compile Exe
    #Dim All
    
    #Include "win32api.inc"
    #Include "ComDlg32.inc"
    #Include "rvAvi.bas"
    
    %IDC_STOP       = 1000
    %IDC_OPEN       = 1010
    %IDC_LABEL1     = 1020
    %IDC_FRAME      = 1030
    %IDC_GRAPHIC    = 1040
    
    %IDT_TIMER1     = 1
    
    '******************************************************************************
    Sub StopPlay(ByVal hDlg As Dword, ByRef hAvi As Long)
    '******************************************************************************
      'Clean up
      KillTimer(hDlg, %IDT_TIMER1)
      If hAvi Then rvAviClose(hAvi)
      hAvi = %Null
      Control Enable hDlg, %IDC_OPEN
      Graphic Clear %Black
      Control Set Text hDlg, %IDC_FRAME, "0"
      Dialog Set Text hDlg, "rvAviTst "
    
    End Sub
    
    '******************************************************************************
    Function ShowFrame(ByVal hDlg As Dword, ByVal hAvi As Long, ByVal FrameNum As Long) As Long
    '******************************************************************************
      Local sFrame As String      'Frame bits string
    
      If hAvi Then
        Control Set Text hDlg,%IDC_FRAME, Str$(FrameNum)
        sFrame = rvAviGetFrame(ByVal hAvi,FrameNum) ' Get Frame bits string
        If sFrame <> "" Then                        ' Got it ?
          Graphic Set Bits sFrame                   ' Set Frame Bits String to Graphic control
          Function = %True
          Exit Function
        End If
      End If
    
      Function = %False
    
    End Function
    
    '******************************************************************************
    Sub AdjustDlgDim(ByVal hDlg As Dword, ByVal GraphControlW As Long, ByVal GraphControlH As Long)
    '******************************************************************************
      Local wd,hd,wdcl,hdcl,ncWidth, ncHeight As Long
    
      Dialog Get Client hDlg To wdcl, hdcl
      Dialog Get Size hDlg To wd, hd
      If GraphControlW>320 Then
        wd = GraphControlW+(wd-wdcl)+20
        hd = GraphControlH+(hd-hdcl)+50
      Else
        wd = 320+(wd-wdcl)+20
        hd = 240+(hd-hdcl)+50
      End If
      Dialog Set Size hDlg, wd, hd        'Adjust Dialog Size to fit the frame sz
      Desktop Get Client To ncWidth, ncHeight
      Dialog Set Loc hDlg, (ncWidth-wd)\2, (ncHeight-hd)\2 'Center the Dialog on desktop
    
    End Sub
    
    '******************************************************************************
    Sub DoOpen(ByVal hDlg As Dword, ByRef FrameNum As Long, ByRef hAvi As Long)
    '******************************************************************************
      Local AviFileName As String ' Avi File Name
      Static LastDir As String    ' Most recent Dir
      Local w,h,wdcl,hdcl As Long
    
      OpenFileDialog (hDlg, "Open Avi File", AviFileName, LastDir, "Avi File|*.avi", ".avi", %OFN_FILEMUSTEXIST)
      MousePtr 11
      Dialog ReDraw hDlg
      If AviFileName <>"" Then
        hAvi = rvAviOpen(AviFileName) ' Open the Avi file to play
        If hAvi Then
          FrameNum = rvAviGetFirstFrameNum(hAvi) ' First frame may have a delay
          rvAviGetSz(ByVal hAvi,w,h) ' Get the avi frame sz
          AdjustDlgDim(hDlg,w,h)     ' Adjust Dlg dimentions to fit the avi frame
          Dialog Get Client hDlg To wdcl, hdcl
          Control Kill hDlg, %IDC_GRAPHIC
          Control Add Graphic, hDlg, %IDC_GRAPHIC, "", 10+(wdcl-20-w)\2, 40+(hdcl-50-h)\2, w, h, %WS_CHILD Or %WS_VISIBLE Or %SS_OWNERDRAW
          Graphic Attach hDlg, %IDC_GRAPHIC
          Graphic Clear %Black
          Control Disable hDlg , %IDC_OPEN
          Dialog Set Text hDlg , "rvAviTst - " + Right$(AviFileName,-InStr(-1,AviFileName,"\"))
          SetTimer(hDlg , %IDT_TIMER1, rvAviGetTimePerFrame(ByVal hAvi), %NULL)
        Else
          MsgBox "Error: AVI Open"
        End If
      End If
    
      MousePtr 1
    
    End Sub
    
    '******************************************************************************
    CallBack Function ShowDIALOG1Proc()
    '******************************************************************************
      Static FrameNum As Long     ' Frame Num to request.
      Static hAvi As Long         ' Avi handler
    
        Select Case CbMsg
    
            Case %WM_INITDIALOG
              Graphic Attach CbHndl, %IDC_GRAPHIC
              Graphic Clear %Black
    
            Case %WM_COMMAND
              Select Case CbCtl
                Case %IDC_OPEN
                  If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then DoOpen(CbHndl,FrameNum,hAvi)
                Case %IDC_STOP
                  If CbCtlMsg = %BN_CLICKED Or CbCtlMsg = 1 Then StopPlay(CbHndl,hAvi)
              End Select
    
            Case %WM_TIMER
              If ShowFrame(CbHndl,hAvi,FrameNum) Then
                Incr FrameNum
              Else
                StopPlay(CbHndl,hAvi)
              End If
    
            Case %WM_CLOSE
              StopPlay(CbHndl,hAvi)
    
        End Select
    
    End Function
    
    '******************************************************************************
    Function PBMain As Long
    '******************************************************************************
        Local lRslt As Long
        Local hDlg As Dword
    
        Dialog New Pixels, 0, "rvAviTst ", , , 340, 290,%WS_POPUPWINDOW Or %WS_CAPTION To hDlg
        Control Add Label, hDlg, %IDC_LABEL1, "AVIFrame", 10, 12, 50, 20
        Control Add Label, hDlg, %IDC_FRAME, "0", 70, 11, 50, 18,%WS_CHILD Or %WS_VISIBLE Or %SS_SUNKEN Or %SS_RIGHT
        Control Add Button, hDlg, %IDC_OPEN, "Open...", 180, 10, 60, 20, %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %BS_CENTER
        Control Add Button, hDlg, %IDC_STOP, "Stop", 260, 10, 60, 20, %WS_CHILD Or %WS_VISIBLE Or %WS_TABSTOP Or %BS_CENTER
    
        Control Add Graphic, hDlg, %IDC_GRAPHIC, "", 9, 40, 320, 240, %WS_CHILD Or %WS_VISIBLE Or %SS_OWNERDRAW
    
        Dialog Show Modal hDlg, Call ShowDIALOG1Proc To lRslt
    
        Function = lRslt
    
    End Function
    
    '******************************************************************************
    'END
    '******************************************************************************
    ------------------
    http://www.rvalois.com.br/downloads/free/



    [This message has been edited by Roberto Valois (edited September 16, 2005).]
    http://www.rvalois.com.br/downloads/free/
Working...
X