Outputting a video from Purebasic.

Just starting out? Need help? Post your questions and find answers here.
Post Reply
User avatar
matalog
Enthusiast
Enthusiast
Posts: 305
Joined: Tue Sep 05, 2017 10:07 am

Outputting a video from Purebasic.

Post by matalog »

Are there any tools in PB that would allow a video to be created frame by frame by drawing each image, then encoded and output as a video (any format) ready to play?
Top
BarryG
Addict
Addict
Posts: 4219
Joined: Thu Apr 18, 2019 8:17 am

Re: Outputting a video from Purebasic.

Post by BarryG »

I'd just "IncludeBinary" the free "ffmpeg" app and then use that with RunProgram() to create a video from a set of images, as opposed to trying to write my own video codec from scratch to do it. See here -> https://www.reddit.com/r/ffmpeg/comment ... ng_ffmpeg/
Top
User avatar
idle
Always Here
Always Here
Posts: 6026
Joined: Fri Sep 21, 2007 5:52 am
Location: New Zealand

Re: Outputting a video from Purebasic.

Post by idle »

also it wouldn't be to hard to import what you need and port this example to PB
https://github.com/FFmpeg/FFmpeg/blob/m ... de_video.c
Top
infratec
Always Here
Always Here
Posts: 7662
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: Outputting a video from Purebasic.

Post by infratec »

You can create an animated gif with PB, then convert it to mp4 with ffmpeg.
Top
dige
Addict
Addict
Posts: 1417
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:
Contact dige

Re: Outputting a video from Purebasic.

Post by dige »

I don't know if it still works. I programmed something like this 18 years ago 🙈 with AVIFileOpen..
It is designed as a dll, but maybe it's a good start for you

Code: Select all

Structure AVI_COMPRESS_OPTIONS
    fccType.l 
    fccHandler.l
    dwKeyFrameEvery.l
    dwQuality.l
    dwBytesPerSecond.l
    dwFlags.l
    lpFormat.l
    cbFormat.l
    lpParms.l
    cbParms.l
    dwInterleaveEvery.l
EndStructure
Structure AVI_FILE_INFO
    dwMaxBytesPerSec.l
    dwFlags.l 
    dwCaps.l
    dwStreams.l
    dwSuggestedBufferSize.l
    dwWidth.l
    dwHeight.l 
    dwScale.l 
    dwRate.l
    dwLength.l
    dwEditCount.l
    szFileType.s[16] ; Char[64]
  EndStructure
Structure AVI_STREAM_INFO
  fccType.l
  fccHandler.l
  dwFlags.l
  dwCaps.l
  wPriority.w
  wLanguage.w
  dwScale.l
  dwRate.l
  dwStart.l
  dwLength.l
  dwInitialFrames.l
  dwSuggestedBufferSize.l
  dwQuality.l
  dwSampleSize.l
  rcFrame._RECT
  dwEditCount.l
  dwFormatChangeCount.l
  szName.b[64]
EndStructure

Structure AVI_HANDLES
  pAVIInFile.l
  pAVIOutFile.l
  
  pAVIInStream.l
  pAVIOutStream.l
  pAVIComprStream.l
  
  pGetFrameObj.l
  firstFrame.l
  numFrames.l
  
  sI.AVI_STREAM_INFO
  co.AVI_COMPRESS_OPTIONS
  fi.AVI_FILE_INFO
  
  bih._BITMAPINFOHEADER
  bfh._BITMAPFILEHEADER
  
  hWnd.l
  hBitmap.l
  ImgID.w
  ImgNr.l
  SizeX.l
  SizeY.l
  
  FPS.l
  Duration.l
  
  Outfile.s
  InFile.s
EndStructure
Structure AVI_INFO
  aviWidth.l
  aviHeight.l
  aviFirstFrame.l
  aviLastFrame.l
  aviFPS.b
  hWnd.l
EndStructure
Procedure Version ()
  MessageRequester( "AVIServ Dll v0.93UC", "Easy read and write 24Bit AVI videos" + Chr(13) + "(c) DiG 03/2006-02/2007", 64 )
EndProcedure
ProcedureDLL.b AVI_Init ()
  
  Global Lib_.b, AVI.AVI_HANDLES, INFO.AVI_INFO
  Lib_ = 0
  
  If OpenLibrary  ( Lib_.b , "AVIFIL32.DLL") 
    CallFunction ( Lib_.b,  "AVIFileInit" ) ; AVI Initialisieren
    ;Global AVI.AVI_HANDLES
    
    #AVIERR_OK = 0
    #AVIIF_KEYFRAME  = $10
    
    #ICMF_CHOOSE_KEYFRAME       = $1 ; show KeyFrame box
    #ICMF_CHOOSE_DATARATE       = $2 ; show DataRate box
    #ICMF_CHOOSE_PREVIEW        = $4 ; allow expanded preview dialog
    #ICMF_CHOOSE_ALLCOMPRESSORS = $8
    ;Version ()
    ProcedureReturn #True
  EndIf
  ProcedureReturn #False
EndProcedure
ProcedureDLL.b AVI_Quit ()
  CallFunction( Lib_.b, "AVIFileExit" )
  CloseLibrary( Lib_.b )
EndProcedure

ProcedureDLL.b AVI_Info    ()
  ;Handle von globaler Struktur holen
  *AVI.AVI_HANDLES = @AVI
  
  CompilerIf #PB_Compiler_Unicode
    ; Strukturen mit Infos füllen
    If *AVI\pAVIInFile
      If CallFunction( Lib_.b, "AVIFileInfoW", *AVI\pAVIInFile, *AVI\fi, SizeOf(AVI_FILE_INFO) ) = #AVIERR_OK
        If *AVI\pAVIInStream
          If CallFunction( Lib_.b, "AVIStreamInfoW", *AVI\pAVIInStream, *AVI\sI, SizeOf(AVI_STREAM_INFO) ) = #AVIERR_OK
            ProcedureReturn #True
          EndIf
        EndIf
      EndIf
    EndIf
  CompilerElse  
    ; Strukturen mit Infos füllen
    If *AVI\pAVIInFile
      If CallFunction( Lib_.b, "AVIFileInfo", *AVI\pAVIInFile, *AVI\fi, SizeOf(AVI_FILE_INFO) ) = #AVIERR_OK
        If *AVI\pAVIInStream
          If CallFunction( Lib_.b, "AVIStreamInfo", *AVI\pAVIInStream, *AVI\sI, SizeOf(AVI_STREAM_INFO) ) = #AVIERR_OK
            ProcedureReturn #True
          EndIf
        EndIf
      EndIf
    EndIf
  CompilerEndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.b CreateAVIFileStream ()
  *AVI.AVI_HANDLES = @AVI
  
  Outfile.s = *AVI\Outfile
  If FileSize( Outfile ) > 0 : DeleteFile( Outfile ) : EndIf
  
  ; Create AVIFile and get handle -> pAVIFile
  CompilerIf #PB_Compiler_Unicode
    res = CallFunction( Lib_.b, "AVIFileOpenW", @pAVIOutFile, @Outfile, #OF_WRITE|#OF_CREATE, 0 )
  CompilerElse
    res = CallFunction( Lib_.b, "AVIFileOpen", @pAVIOutFile, @Outfile, #OF_WRITE|#OF_CREATE, 0 )
  CompilerEndIf
  
  If res = #AVIERR_OK
    ;UseImage( AVI\ImgID )
  
    ; InfoHeader erstellen    
    *bih._BITMAPINFOHEADER = *AVI\bih
;     *bih\biBitCount = AVI\Depth
;     If *bih\biBitCount > 24 : *bih\biBitCount = 24 : EndIf
    *bih\biBitCount = 24
    *bih\biCompression = #BI_RGB
    *bih\biPlanes = 1
    *bih\biSize   = SizeOf(_BITMAPINFOHEADER)
    *bih\biWidth  = *AVI\SizeX
    *bih\biHeight = *AVI\SizeY
    *bih\biSizeImage = *bih\biWidth * *bih\biHeight * ( *bih\biBitCount/8 )
    
    *sI.AVI_STREAM_INFO = *AVI\sI
    *sI\fccType = mmioStringToFOURCC_ ("vids", 0)   ; Stream Type Video
    *sI\fccHandler = 0
    *sI\dwFlags = 0
    *sI\dwCaps = 0
    *sI\wPriority = 0
    *sI\wLanguage = 0
    
    *sI\dwScale = 100  ; Zeitscale: wieviele Einheiten 1 Sekunde entsprechen
    If *AVI\fps : *sI\dwRate = *sI\dwScale * *AVI\fps : EndIf
    If *sI\dwRate < 1 : *sI\dwRate = 1 : ElseIf *sI\dwRate > 3000 : *sI\dwRate = 3000 : EndIf
    *AVI\fps = *sI\dwRate / *sI\dwScale
    ; dwRate / dwScale = Frames per Second
    ; dwRate = 1 -> Extrem Slomo
    
    *sI\dwStart = 0
    *sI\dwLength = 0
    *sI\dwInitialFrames = 0
    *sI\dwSuggestedBufferSize = *bih\biSizeImage
    *sI\dwQuality = -1 ; 0...10000 (best)
    *sI\dwSampleSize = 0
    *sI\rcFrame\top = 0
    *sI\rcFrame\bottom = *bih\biHeight
    *sI\rcFrame\left = 0
    *sI\rcFrame\right = *bih\biWidth
    *sI\dwEditCount = 0
    *sI\dwFormatChangeCount = 0
    *sI\szName[0] = 0
    
    CompilerIf #PB_Compiler_Unicode
    ; Create Stream with AVI_STREAM_INO Structur and geht Streamhandle -> pAVIStream
      If CallFunction( Lib_.b, "AVIFileCreateStreamW", pAVIOutFile, @pAVIOutStream, *sI ) = #AVIERR_OK
        *AVI\pAVIOutFile = pAVIOutFile
        *AVI\pAVIOutStream = pAVIOutStream
        ProcedureReturn #True
      EndIf
    CompilerElse  
      If CallFunction( Lib_.b, "AVIFileCreateStream", pAVIOutFile, @pAVIOutStream, *sI ) = #AVIERR_OK
        *AVI\pAVIOutFile = pAVIOutFile
        *AVI\pAVIOutStream = pAVIOutStream
        ProcedureReturn #True
      EndIf
    CompilerEndIf  
  EndIf
  
  ProcedureReturn #False
EndProcedure
Procedure.b SetStreamFormat   ()
  *AVI.AVI_HANDLES = @AVI
  pointer.l  = *AVI\co
  pAVIStream = *AVI\pAVIOutStream
    
  ; Open Compressoroptions dialog und check if Okay or Cancel is pressed
  ;If CallFunction( Lib_.b, "AVISaveOptions", *AVI\hWnd, #ICMF_CHOOSE_KEYFRAME | #ICMF_CHOOSE_DATARATE, 1, @pAVIStream, @pointer ) = #True
  If CallFunction( Lib_.b, "AVISaveOptions", #Null, #Null, 1, @pAVIStream, @pointer ) = #True
  
    ; Create a compressed stream und get new stream handle -> pAVIComprStream
    CallFunction( Lib_.b, "AVIMakeCompressedStream", @pAVIComprStream, pAVIStream, pointer, 0 )
    *AVI\pAVIComprStream   = pAVIComprStream
    
    ; int AVIStreamSetFormat(IntPtr aviStream, Int32 lPos, ref BITMAPINFOHEADER lpFormat, Int32 cbFormat)
    res = CallFunction( Lib_.b, "AVIStreamSetFormat", pAVIComprStream, 1, *AVI\bih, SizeOf(_BITMAPINFOHEADER))
    If res = #AVIERR_OK : ProcedureReturn #True : EndIf
  EndIf
  ProcedureReturn #False
EndProcedure
ProcedureDLL CloseAVIStreams  ()
  
  *AVI.AVI_HANDLES = @AVI
 
  If *AVI\pGetFrameObj
    CallFunction( Lib_.b, "AVIStreamGetFrameClose", pGetFrameObj )
    *AVI\pGetFrameObj = 0
  EndIf
    
  If *AVI\pAVIComprStream
    CallFunction( Lib_.b, "AVISaveOptionsFree", 0, *AVI\co )
    CallFunction( Lib_.b, "AVIStreamRelease", *AVI\pAVIComprStream )
    *AVI\pAVIComprStream = 0  
  EndIf
    
  While *AVI\pAVIOutStream : If Not(CallFunction( Lib_.b, "AVIStreamRelease", *AVI\pAVIOutStream )) : *AVI\pAVIOutStream = 0 :EndIf : Wend
  While *AVI\pAVIInStream : If Not(CallFunction( Lib_.b, "AVIStreamRelease", *AVI\pAVIInStream )) : *AVI\pAVIInStream = 0 : EndIf : Wend
  While *AVI\pAVIOutFile :  If Not(CallFunction( Lib_.b, "AVIFileRelease",   *AVI\pAVIOutFile ))   : *AVI\pAVIOutFile = 0 : EndIf : Wend
  While *AVI\pAVIInFile : If Not(CallFunction( Lib_.b, "AVIFileRelease",   *AVI\pAVIInFile ))    : *AVI\pAVIInFile = 0 : EndIf : Wend

EndProcedure

ProcedureDLL.b AddFrameToAVI    ( hBmp.l, FrameID.l )
  *AVI.AVI_HANDLES = @AVI
  *mem = GlobalAlloc_ (#GMEM_FIXED|#GMEM_ZEROINIT, *AVI\bih\biSizeImage)   
  hdc = CreateCompatibleDC_(GetDC_(0))
  If hdc
    SelectObject_( hdc, hBmp )
    If hdc
      GetDIBits_( hdc, hBmp, 0, *AVI\bih\biHeight, *mem, *AVI\bih, #DIB_RGB_COLORS)
      DeleteDC_( hdc )
      If FrameID < 0 : FrameID = *AVI\ImgNr : *AVI\ImgNr + 1 : Else : *AVI\ImgNr = FrameID : EndIf
      res = CallFunction( Lib_.b, "AVIStreamWrite", *AVI\pAVIComprStream, FrameID, 1, *mem, *AVI\bih\biSizeImage, #AVIIF_KEYFRAME, #Null, #Null )
    EndIf
  EndIf
  GlobalFree_( *mem )
  If res = #AVIERR_OK And hdc : ProcedureReturn #True : Else : ProcedureReturn #False : EndIf
EndProcedure
ProcedureDLL.b GetFrameFromAVI  ( hBmp.l, FrameID.l )
  *AVI.AVI_HANDLES = @AVI
  
  If Not ( *AVI\pGetFrameObj ) And *AVI\pAVIInStream
    
    ;*AVI\pGetFrameObj = CallFunction( Lib_.b, "AVIStreamGetFrameOpen", *AVI\pAVIInStream, 0 ) ; #AVIGETFRAMEF_BESTDISPLAYFMT = 1  
    ; Frame Format vorgeben
      bih._BITMAPINFOHEADER
      bih\biBitCount      = 24
      bih\biClrImportant  = 0
      bih\biClrUsed       = 0
      bih\biCompression   = #BI_RGB
      bih\biWidth         = *AVI\sI\rcFrame\right  - *AVI\sI\rcFrame\left
      bih\biHeight        = *AVI\sI\rcFrame\bottom - *AVI\sI\rcFrame\top
      bih\biPlanes        = 1
      bih\biSize          = 40
      bih\biXPelsPerMeter = 0
      bih\biYPelsPerMeter = 0
      bih\biSizeImage     = bih\biWidth * bih\biHeight * 3
      *AVI\pGetFrameObj = CallFunction( Lib_.b, "AVIStreamGetFrameOpen", *AVI\pAVIInStream, bih )
  EndIf
  
  If FrameID < 0 : FrameID = *AVI\ImgNr : *AVI\ImgNr + 1 : EndIf
  If FrameID < *AVI\numFrames And *AVI\pGetFrameObj

    *bih._BITMAPINFOHEADER = CallFunction( Lib_.b, "AVIStreamGetFrame", *AVI\pGetFrameObj, FrameID )

    If hBmp
      hdc = CreateCompatibleDC_(GetDC_(0))
      If hdc
        SelectObject_( hdc, hBmp )
        SetDIBits_( hdc, hBmp, 0, *bih\biHeight, *bih + SizeOf(_BITMAPINFOHEADER), *bih, #DIB_RGB_COLORS) 
        DeleteDC_(hdc)
        ProcedureReturn #True
      EndIf
    EndIf
    
  EndIf
  ProcedureReturn #False
EndProcedure

ProcedureDLL.l OpenAVIforRead   ( File.s )
  
  ; Handles holen
  *AVI.AVI_HANDLES = @AVI
  *INF.AVI_INFO    = @INFO
  
  #streamtypeVIDEO = $73646976
  #streamtypeAUDIO = $73647561
  
  CompilerIf #PB_Compiler_Unicode
    res = CallFunction( Lib_.b, "AVIFileOpenW", @pAVIFile, @File, #OF_SHARE_DENY_WRITE, 0 )
  CompilerElse
    res = CallFunction( Lib_.b, "AVIFileOpen", @pAVIFile, @File, #OF_SHARE_DENY_WRITE, 0 )
  CompilerEndIf

  If res = #AVIERR_OK
    CallFunction( Lib_.b, "AVIFileGetStream", pAVIFile, @pAVIStream, #streamtypeVIDEO, 0 )
    *AVI\firstFrame   = CallFunction( Lib_.b, "AVIStreamStart", pAVIStream )
    *AVI\numFrames    = CallFunction( Lib_.b, "AVIStreamLength", pAVIStream )
    *AVI\pAVIInFile   = pAVIFile
    *AVI\pAVIInStream = pAVIStream
    
    If AVI_Info () = #True
    
      *INF\aviWidth      = *AVI\fi\dwWidth
      *INF\aviHeight     = *AVI\fi\dwHeight
      *INF\aviFirstFrame = *AVI\firstFrame
      *INF\aviLastFrame  = *AVI\numFrames

      ProcedureReturn @INFO
      
    EndIf
  EndIf
  ProcedureReturn #False
EndProcedure
ProcedureDLL.b OpenAVIforWrite  ( File.s, *INF.AVI_INFO )
  
  *AVI.AVI_HANDLES = @AVI
  *AVI\SizeX   = *INF\aviWidth
  *AVI\SizeY   = *INF\aviHeight
  *AVI\fps     = *INF\aviFPS
  *AVI\hwnd    = *INF\hwnd
  *AVI\Outfile = File.s
  
  If CreateAVIFileStream() And SetStreamFormat ()
    ProcedureReturn #True
  Else
    ProcedureReturn #False
  EndIf
EndProcedure
"Daddy, I'll run faster, then it is not so far..."
Top
User avatar
matalog
Enthusiast
Enthusiast
Posts: 305
Joined: Tue Sep 05, 2017 10:07 am

Re: Outputting a video from Purebasic.

Post by matalog »

Great ideas, thanks guys.
Top
Post Reply

Return to “Coding Questions”