Basic Univers
; Auteur : Nico

;   Sur le Forum Anglais, une personne avait commencé une traduction d'un code VB
; pour créer ses vidéos AVI mais qui ne marchait pas. J'avais bien essayé à l'époque
; mais je n'y arrivais pas car je ne savais pas comment était codé un fichier BMP.
;   Maintenant que je sais, je m'y suis remis et voici un exemple de code.


#streamtypeVIDEO = $73646976

#Lib = 0

Structure bitmap24
  bmiHeader.BITMAPINFOHEADER
EndStructure

Structure AVISTREAMINFO
  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 AVICOMPRESSOPTIONS
  fccType.l
  fccHandler.l
  dwKeyFrameEvery.l
  dwQuality.l
  dwBytesPerSecond.l
  dwFlags.l
  *lpFormat.l
  cbFormat.l
  *lpParms.l
  cbParms.l
  dwInterleaveEvery.l
EndStructure

NewList bitmap.s()
NewList memoire.l()

Debug SizeOf(bitmap24)
Debug(SizeOf(BITMAPFILEHEADER))

Fichier.s = OpenFileRequester("Sélection multiple des Fichiers Bitmaps", "", "Fichiers BMP|*.bmp", 0, #PB_Requester_MultiSelection)
If Fichier
  Debug  Fichier
  AddElement(bitmap())
  bitmap()= Fichier
  Repeat
    Fichier = NextSelectedFileName()
    If Fichier
      AddElement(bitmap())
      bitmap()= Fichier
      Debug Fichier
    EndIf
  Until Fichier = ""
EndIf

ForEach bitmap()
  If ReadFile(0, bitmap())
    Debug Lof()
    CallDebugger
    FileSeek(SizeOf(BITMAPFILEHEADER))
    bmi.bitmap24
   
    ReadData(@bmi, SizeOf(bitmap24))
    ; Debug "---------------------------------"
    ; Debug bmi\bmiHeader\biSize ;40 c'est la taille de la structure
    ; Debug bmi\bmiHeader\biWidth
    ; Debug bmi\bmiHeader\biHeight
    ; Debug bmi\bmiHeader\biPlanes
    ; Debug bmi\bmiHeader\biBitCount
    ; Debug bmi\bmiHeader\biCompression
    ; Debug bmi\bmiHeader\bisizeimage
    ; Debug bmi\bmiHeader\biXPelsPerMeter
    ; Debug bmi\bmiHeader\biYPelsPerMeter
    ; Debug bmi\bmiHeader\biClrUsed
    ; Debug bmi\bmiHeader\biClrImportant
    ; Debug "---------------------------------"
    If  bmi\bmiHeader\biWidth
      If  bmi\bmiHeader\biHeight
        If  bmi\bmiHeader\biBitCount = 24
          If  bmi\bmiHeader\bisizeimage = 0
            bmi\bmiHeader\bisizeimage = Lof()- 54
          EndIf
            FileSeek(54)
            AddElement(memoire())
            memoire() = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT, bmi\bmiHeader\bisizeimage)
            ReadData(memoire(), bmi\bmiHeader\bisizeimage)
        EndIf
      EndIf
    EndIf
   
    CloseFile(0)
  EndIf
Next
 
If OpenLibrary( #Lib , "AVIFIL32.DLL")
  CallFunction( #Lib,  "AVIFileInit" )
  avifile.s = SaveFileRequester( "Nom du fichier Avi à enregistrer", "", "Video|*.avi", 0 )
  If GetExtensionPart(avifile)=""
    avifile = avifile +".avi"
  EndIf
  Debug avifile
 
  If CallFunction( #Lib, "AVIFileOpen", @pAVIFile.IAVIFILE, @avifile,(#OF_WRITE | #OF_CREATE), 0 )= 0
    strhdr.AVISTREAMINFO
    strhdr\fccType                = #streamtypeVIDEO
    strhdr\fccHandler             = 0
    strhdr\dwScale                = 1
    strhdr\dwRate                 = 4
    strhdr\dwSuggestedBufferSize  = bmi\bmiHeader\biSize
   
    If SetRect_(@strhdr\rcFrame, 0, 0, bmi\bmiHeader\biWidth, bmi\bmiHeader\biHeight) <>0
      If CallFunction( #Lib, "AVIFileCreateStream", pAVIFile, @pAVIStream, @strhdr) = 0
        opts.AVICOMPRESSOPTIONS
        Dim aopts(0)
        aopts(0)=@opts
       
        #ICMF_CHOOSE_KEYFRAME = 1
        #ICMF_CHOOSE_DATARATE = 2
        #AVIERR_OK = 0
        #AVIIF_KEYFRAME= $10
        If CallFunction( #Lib, "AVISaveOptions", 0, #ICMF_CHOOSE_KEYFRAME | #ICMF_CHOOSE_DATARATE, 1, @pAVIStream, @aopts(0)) = 1
          If CallFunction( #Lib, "AVIMakeCompressedStream", @pAVICompressed, pAVIStream, aopts(0), 0)=#AVIERR_OK
            If CallFunction( #Lib, "AVIStreamSetFormat", pAVICompressed, 0, @bmi, SizeOf(bitmap24)) = 0
              ForEach memoire()
                If memoire()
                  If CallFunction( #Lib, "AVIStreamWrite", pAVICompressed, index, 1,  memoire() , bmi\bmiHeader\bisizeimage, #AVIIF_KEYFRAME, 0, 0) = 0
                    index = index + 1
                  EndIf
                EndIf
              Next
            EndIf
            CallFunction( #Lib, "AVIStreamRelease", pAVICompressed)
          EndIf
        EndIf
        CallFunction( #Lib, "AVIStreamRelease", pAVIStream )
      EndIf
    EndIf
    CallFunction( #Lib, "AVIFileRelease", pAVIFile)
  EndIf
  CallFunction( #Lib, "AVIFileExit" )
  CloseLibrary( #Lib )
 
  ForEach memoire()
    GlobalFree_(memoire())
  Next
  MessageRequester("Info", "Nombre de Frames enregistrées: " + Str(index))
EndIf