PureBasic Forums - English

Code: Select all

#WM_USER = $400
#WM_CAP_START = #WM_USER

#WM_CAP_GET_CAPSTREAMPTR = #WM_CAP_START + 1

#WM_CAP_SET_CALLBACK_ERROR = #WM_CAP_START + 2
#WM_CAP_SET_CALLBACK_STATUS = #WM_CAP_START + 3
#WM_CAP_SET_CALLBACK_YIELD = #WM_CAP_START + 4
#WM_CAP_SET_CALLBACK_FRAME = #WM_CAP_START + 5
#WM_CAP_SET_CALLBACK_VIDEOSTREAM = #WM_CAP_START + 6
#WM_CAP_SET_CALLBACK_WAVESTREAM = #WM_CAP_START + 7
#WM_CAP_GET_USER_DATA = #WM_CAP_START + 8
#WM_CAP_SET_USER_DATA = #WM_CAP_START + 9
    
#WM_CAP_DRIVER_CONNECT = #WM_CAP_START + 10
#WM_CAP_DRIVER_DISCONNECT = #WM_CAP_START + 11
#WM_CAP_DRIVER_GET_NAME = #WM_CAP_START + 12
#WM_CAP_DRIVER_GET_VERSION = #WM_CAP_START + 13
#WM_CAP_DRIVER_GET_CAPS = #WM_CAP_START + 14

#WM_CAP_FILE_SET_CAPTURE_FILE = #WM_CAP_START + 20
#WM_CAP_FILE_GET_CAPTURE_FILE = #WM_CAP_START + 21
#WM_CAP_FILE_ALLOCATE = #WM_CAP_START + 22
#WM_CAP_FILE_SAVEAS = #WM_CAP_START + 23
#WM_CAP_FILE_SET_INFOCHUNK = #WM_CAP_START + 24
#WM_CAP_FILE_SAVEDIB = #WM_CAP_START + 25

#WM_CAP_EDIT_COPY = #WM_CAP_START + 30

#WM_CAP_SET_AUDIOFORMAT = #WM_CAP_START + 35
#WM_CAP_GET_AUDIOFORMAT = #WM_CAP_START + 36

#WM_CAP_DLG_VIDEOFORMAT = #WM_CAP_START + 41
#WM_CAP_DLG_VIDEOSOURCE = #WM_CAP_START + 42
#WM_CAP_DLG_VIDEODISPLAY = #WM_CAP_START + 43
#WM_CAP_GET_VIDEOFORMAT = #WM_CAP_START + 44
#WM_CAP_SET_VIDEOFORMAT = #WM_CAP_START + 45
#WM_CAP_DLG_VIDEOCOMPRESSION = #WM_CAP_START + 46

#WM_CAP_SET_PREVIEW = #WM_CAP_START + 50
#WM_CAP_SET_OVERLAY = #WM_CAP_START + 51
#WM_CAP_SET_PREVIEWRATE = #WM_CAP_START + 52
#WM_CAP_SET_SCALE = #WM_CAP_START + 53
#WM_CAP_GET_STATUS = #WM_CAP_START + 54
#WM_CAP_SET_SCROLL = #WM_CAP_START + 55

#WM_CAP_GRAB_FRAME = #WM_CAP_START + 60
#WM_CAP_GRAB_FRAME_NOSTOP = #WM_CAP_START + 61

#WM_CAP_SEQUENCE = #WM_CAP_START + 62
#WM_CAP_SEQUENCE_NOFILE = #WM_CAP_START + 63
#WM_CAP_SET_SEQUENCE_SETUP = #WM_CAP_START + 64
#WM_CAP_GET_SEQUENCE_SETUP = #WM_CAP_START + 65
#WM_CAP_SET_MCI_DEVICE = #WM_CAP_START + 66
#WM_CAP_GET_MCI_DEVICE = #WM_CAP_START + 67
#WM_CAP_STOP = #WM_CAP_START + 68
#WM_CAP_ABORT = #WM_CAP_START + 69

#WM_CAP_SINGLE_FRAME_OPEN = #WM_CAP_START + 70
#WM_CAP_SINGLE_FRAME_CLOSE = #WM_CAP_START + 71
#WM_CAP_SINGLE_FRAME = #WM_CAP_START + 72

#WM_CAP_PAL_OPEN = #WM_CAP_START + 80
#WM_CAP_PAL_SAVE = #WM_CAP_START + 81
#WM_CAP_PAL_PASTE = #WM_CAP_START + 82
#WM_CAP_PAL_AUTOCREATE = #WM_CAP_START + 83
#WM_CAP_PAL_MANUALCREATE = #WM_CAP_START + 84

#WM_CAP_SET_CALLBACK_CAPCONTROL = #WM_CAP_START + 85
Global gkill

Structure VFWPOINT ;'strange name to avoid collision with other POINT UDTs
        x.i
        y.i
EndStructure

Structure CAPDRIVERCAPS
    wDeviceIndex.i                    ; Driver index in system.ini
    fHasOverlay.i                     ; Can device overlay?
    fHasDlgVideoSource.i              ; Has Video source dlg?
    fHasDlgVideoFormat.i              ; Has Format dlg?
    fHasDlgVideoDisplay.i             ; Has External out dlg?
    fCaptureInitialized.i             ; Driver ready to capture?
    fDriverSuppliesPalettes.i         ; Can driver make palettes?
    hVideoIn.i                        ; Driver In channel
    hVideoOut.i                       ; Driver Out channel
    hVideoExtIn.i                     ; Driver Ext In channel
    hVideoExtOut.i                    ; Driver Ext Out channel
EndStructure

Structure CAPSTATUS
    uiImageWidth.i                    ; Width of the image
    uiImageHeight.i                   ; Height of the image
    fLiveWindow.i                     ; Now Previewing video?
    fOverlayWindow.i                  ; Now Overlaying video?
    fScale.i                          ; Scale image to client?
    ptScroll.VFWPOINT                    ; Scroll position
    fUsingDefaultPalette.i            ; Using default driver palette?
    fAudioHardware.i                  ; Audio hardware present?
    fCapFileExists.i                  ; Does capture file exist?
    dwCurrentVideoFrame.i             ; # of video frames cap'td
    dwCurrentVideoFramesDropped.i     ; # of video frames dropped
    dwCurrentWaveSamples.i            ; # of wave samples cap'td
    dwCurrentTimeElapsedMS.i          ; Elapsed capture duration
    hPalCurrent.i                     ; Current palette in use
    fCapturingNow.i                   ; Capture in progress?
    dwReturn.i                        ; Error value after any operation
    wNumVideoAllocated.i              ; Actual number of video buffers
    wNumAudioAllocated.i              ; Actual number of audio buffers
EndStructure

#AVSTREAMMASTER_AUDIO = 0             ;; Audio master (VFW 1.0, 1.1) */
#AVSTREAMMASTER_NONE = 1              ;; No master */

Structure CAPTUREPARMS
    dwRequestMicroSecPerFrame.i       ; Requested capture rate
    fMakeUserHitOKToCapture.i         ; Show "Hit OK to cap" dlg?
    wPercentDropForError.i            ; Give error msg if > (10% default)
    fYield.i                          ; Capture via background task?
    dwIndexSize.i                     ; Max index size in frames (32K default)
    wChunkGranularity.i               ; Junk chunk granularity (2K default)
    fUsingDOSMemory.i                 ; Use DOS buffers? (obsolete)
    wNumVideoRequested.i              ; # video buffers, If 0, autocalc
    fCaptureAudio.i                   ; Capture audio?
    wNumAudioRequested.i              ; # audio buffers, If 0, autocalc
    vKeyAbort.i                       ; Virtual key causing abort
    fAbortLeftMouse.i                 ; Abort on left mouse?
    fAbortRightMouse.i                ; Abort on right mouse?
    fLimitEnabled.i                   ; Use wTimeLimit?
    wTimeLimit.i                      ; Seconds to capture
    fMCIControl.i                     ; Use MCI video source?
    fStepMCIDevice.i                  ; Step MCI device?
    dwMCIStartTime.i                  ; Time to start in MS
    dwMCIStopTime.i                   ; Time to stop in MS
    fStepCaptureAt2x.i                ; Perform spatial averaging 2x
    wStepCaptureAverageFrames.i       ; Temporal average n Frames
    dwAudioBufferSize.i               ; Size of audio bufs (0 = default)
    fDisableWriteCache.i              ; Attempt to disable write cache
    AVStreamMaster.i                  ; Which stream controls length?
EndStructure
                         

Structure CAPINFOCHUNK
    fccInfoID.i                       ; Chunk ID, "ICOP" for copyright
    lpData.i                          ; pointer to data
    cbData.i                          ; size of lpData
EndStructure

Structure VIDEOHDR
    lpData.i                          ; address of video buffer
    dwBufferLength.i                  ; size, in bytes, of the Data buffer
    dwBytesUsed.i                     ; see below
    dwTimeCaptured.i                  ; see below
    dwUser.i                          ; user-specific data
    dwFlags.i                         ; see below
    dwReserved.i[3]                   ; reserved; do not use
EndStructure

;Capture Procedure Declares
Import "avicap32.lib"
CapCreateCaptureWindow.i(name.s, style.i, x.i, y.i, width.i, height.i, hWndParent.i, nId.i) As "_capCreateCaptureWindowA@32"
CapGetDriverDescription.i(index.i, name.i, cbName.i, ver.i, cbVer.i) As "_capGetDriverDescriptionA@20"
EndImport

;======if the compiler can't find the lib use this and call close library at the end of your code 
; Prototype.i ProtCapCreateCaptureWindow(name.s, style.i, x.i, y.i, width.i, height.i, hWndParent.i, nId.i)
; Prototype.i ProtCapGetDriverDescription(index.i, name.i, cbName.i, ver.i, cbVer.i)
; 
; If OpenLibrary(0, "avicap32.dll")
;    Global CapCreateCaptureWindow.ProtCapCreateCaptureWindow = GetFunction(0, "capCreateCaptureWindowA")
;    Global CapGetDriverDescription.ProtCapGetDriverDescription = GetFunction(0, "capGetDriverDescriptionA")
; EndIf

;======================================================


; Import "msvfw32.lib"
;   GetOpenFileNamePreview.i(filestruct.OPENFILENAME) As "_GetOpenFileNamePreview"
;   GetSaveFileNamePreview.i(filestruct.OPENFILENAME) As "_GetSaveFileNamePreview"
; EndImport

; ------------------------------------------------------------------
; IDs for status and error callbacks
; ------------------------------------------------------------------

#IDS_CAP_BEGIN = 300              ; "Capture Start" */
#IDS_CAP_END = 301                ; "Capture End" */

#IDS_CAP_INFO = 401               ; "%s" */
#IDS_CAP_OUTOFMEM = 402           ; "Out of memory" */
#IDS_CAP_FILEEXISTS = 403         ; "File '%s' exists -- overwrite it?" */
#IDS_CAP_ERRORPALOPEN = 404       ; "Error opening palette '%s'" */
#IDS_CAP_ERRORPALSAVE = 405       ; "Error saving palette '%s'" */
#IDS_CAP_ERRORDIBSAVE = 406       ; "Error saving frame '%s'" */
#IDS_CAP_DEFAVIEXT = 407          ; "avi" */
#IDS_CAP_DEFPALEXT = 408          ; "pal" */
#IDS_CAP_CANTOPEN = 409           ; "Cannot open '%s'" */
#IDS_CAP_SEQ_MSGSTART = 410       ; "Select OK to start capture\nof video sequence\nto %s." */
#IDS_CAP_SEQ_MSGSTOP = 411        ; "Hit ESCAPE or click to end capture" */
                
#IDS_CAP_VIDEDITERR = 412         ; "An error occurred while trying to run VidEdit." */
#IDS_CAP_READONLYFILE = 413       ; "The file '%s' is a read-only file." */
#IDS_CAP_WRITEERROR = 414         ; "Unable to write to file '%s'.\nDisk may be full." */
#IDS_CAP_NODISKSPACE = 415        ; "There is no space to create a capture file on the specified device." */
#IDS_CAP_SETFILESIZE = 416        ; "Set File Size" */
#IDS_CAP_SAVEASPERCENT = 417      ; "SaveAs: %2ld%%  Hit Escape to abort." */
                
#IDS_CAP_DRIVER_ERROR = 418       ; Driver specific error message */

#IDS_CAP_WAVE_OPEN_ERROR = 419    ; "Error: Cannot open the wave input device.\nCheck sample size, frequency, and channels." */
#IDS_CAP_WAVE_ALLOC_ERROR = 420   ; "Error: Out of memory for wave buffers." */
#IDS_CAP_WAVE_PREPARE_ERROR = 421 ; "Error: Cannot prepare wave buffers." */
#IDS_CAP_WAVE_ADD_ERROR = 422     ; "Error: Cannot add wave buffers." */
#IDS_CAP_WAVE_SIZE_ERROR = 423    ; "Error: Bad wave size." */
                
#IDS_CAP_VIDEO_OPEN_ERROR = 424   ; "Error: Cannot open the video input device." */
#IDS_CAP_VIDEO_ALLOC_ERROR = 425  ; "Error: Out of memory for video buffers." */
#IDS_CAP_VIDEO_PREPARE_ERROR = 426 ; "Error: Cannot prepare video buffers." */
#IDS_CAP_VIDEO_ADD_ERROR = 427    ; "Error: Cannot add video buffers." */
#IDS_CAP_VIDEO_SIZE_ERROR = 428   ; "Error: Bad video size." */
                
#IDS_CAP_FILE_OPEN_ERROR = 429    ; "Error: Cannot open capture file." */
#IDS_CAP_FILE_WRITE_ERROR = 430   ; "Error: Cannot write to capture file.  Disk may be full." */
#IDS_CAP_RECORDING_ERROR = 431    ; "Error: Cannot write to capture file.  Data rate too high or disk full." */
#IDS_CAP_RECORDING_ERROR2 = 432   ; "Error while recording" */
#IDS_CAP_AVI_INIT_ERROR = 433     ; "Error: Unable to initialize for capture." */
#IDS_CAP_NO_FRAME_CAP_ERROR = 434 ; "Warning: No frames captured.\nConfirm that vertical sync interrupts\nare configured and enabled." */
#IDS_CAP_NO_PALETTE_WARN = 435    ; "Warning: Using default palette." */
#IDS_CAP_MCI_CONTROL_ERROR = 436  ; "Error: Unable to access MCI device." */
#IDS_CAP_MCI_CANT_STEP_ERROR = 437 ; "Error: Unable to step MCI device." */
#IDS_CAP_NO_AUDIO_CAP_ERROR = 438 ; "Error: No audio data captured.\nCheck audio card settings." */
#IDS_CAP_AVI_DRAWDIB_ERROR = 439  ; "Error: Unable to draw this data format." */
#IDS_CAP_COMPRESSOR_ERROR = 440   ; "Error: Unable to initialize compressor." */
#IDS_CAP_AUDIO_DROP_ERROR = 441   ; "Error: Audio data was lost during capture, reduce capture rate." */
                
; status string IDs */
#IDS_CAP_STAT_LIVE_MODE = 500      ; "Live window" */
#IDS_CAP_STAT_OVERLAY_MODE = 501   ; "Overlay window" */
#IDS_CAP_STAT_CAP_INIT = 502       ; "Setting up for capture - Please wait" */
#IDS_CAP_STAT_CAP_FINI = 503       ; "Finished capture, now writing frame %ld" */
#IDS_CAP_STAT_PALETTE_BUILD = 504  ; "Building palette map" */
#IDS_CAP_STAT_OPTPAL_BUILD = 505   ; "Computing optimal palette" */
#IDS_CAP_STAT_I_FRAMES = 506       ; "%d frames" */
#IDS_CAP_STAT_L_FRAMES = 507       ; "%ld frames" */
#IDS_CAP_STAT_CAP_L_FRAMES = 508   ; "Captured %ld frames" */
#IDS_CAP_STAT_CAP_AUDIO = 509      ; "Capturing audio" */
#IDS_CAP_STAT_VIDEOCURRENT = 510   ; "Captured %ld frames (%ld dropped) %d.%03d sec." */
#IDS_CAP_STAT_VIDEOAUDIO = 511     ; "Captured %d.%03d sec.  %ld frames (%ld dropped) (%d.%03d fps).  %ld audio bytes (%d,%03d sps)" */
#IDS_CAP_STAT_VIDEOONLY = 512      ; "Captured %d.%03d sec.  %ld frames (%ld dropped) (%d.%03d fps)" */

;Translations of C- "Message Cracker" Macros to VB (declared in vfw.h)

Procedure capSetCallbackOnError(hCapWnd.i,lpProc.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_ERROR,0,lpProc)
EndProcedure
Procedure capSetCallbackOnStatus(hCapWnd.i,lpProc.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_STATUS, 0, lpProc)
EndProcedure
Procedure capSetCallbackOnYield( hCapWnd.i,  lpProc.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_YIELD, 0, lpProc)
EndProcedure
Procedure capSetCallbackOnFrame( hCapWnd.i,  lpProc.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_FRAME, 0, lpProc)
EndProcedure
Procedure capSetCallbackOnVideoStream( hCapWnd.i,  lpProc.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_VIDEOSTREAM, 0, lpProc)
EndProcedure
Procedure capSetCallbackOnWaveStream( hCapWnd.i,  lpProc.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_WAVESTREAM, 0, lpProc)
EndProcedure
Procedure capSetCallbackOnCapControl( hCapWnd.i,  lpProc.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_CALLBACK_CAPCONTROL, 0, lpProc)
EndProcedure
Procedure capSetUserData( hCapWnd.i,  lUser.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_USER_DATA, 0, lUser)
EndProcedure
Procedure capGetUserData( hCapWnd.i)
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_USER_DATA, 0, 0)
EndProcedure
Procedure capDriverConnect( hCapWnd.i,i.i=0) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DRIVER_CONNECT, i, 0)
EndProcedure
Procedure capDriverDisconnect( hCapWnd.i) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DRIVER_DISCONNECT, 0, 0)
EndProcedure
Procedure.s capDriverGetName(hCapWnd.i)
   szBuffer.s = Space(128)
   SendMessage_(hCapWnd, #WM_CAP_DRIVER_GET_NAME, 128, @szBuffer)
   ProcedureReturn szBuffer
EndProcedure
Procedure.s capDriverGetVersion(hCapWnd.i)
   szBuffer.s = Space(128)
   retVal = SendMessage_(hCapWnd, #WM_CAP_DRIVER_GET_VERSION, 128, @szBuffer)
   ProcedureReturn szbuffer 
EndProcedure
Procedure capDriverGetCaps(hCapWnd.i,*lpCaps) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DRIVER_GET_CAPS,SizeOf(CAPDRIVERCAPS), *lpCaps)
EndProcedure
Procedure capFileSetCaptureFile(hCapWnd.i,FilePath.s) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_FILE_SET_CAPTURE_FILE,0,@FilePath)
EndProcedure
Procedure.s capFileGetCaptureFile(hCapWnd.i) 
   szBuffer.s = Space(128)
   SendMessage_(hCapWnd, #WM_CAP_FILE_GET_CAPTURE_FILE, 128, @szBuffer)
   ProcedureReturn szBuffer
EndProcedure
Procedure capFileAlloc(hCapWnd.i,dwSize.i) 
   ProcedureReturn  SendMessage_(hCapWnd, #WM_CAP_FILE_ALLOCATE, 0, dwSize)
EndProcedure
Procedure capFileSaveAs(hCapWnd.i,FilePath.s) 
   ProcedureReturn SendMessage_(hCapWnd,#WM_CAP_FILE_SAVEAS, 0, @FilePath)
EndProcedure
Procedure capFileSetInfoChunk(hCapWnd.i,*InfChunk.CAPINFOCHUNK) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_FILE_SET_INFOCHUNK, 0, *InfChunk)
EndProcedure
Procedure capFileSaveDIB(hCapWnd.i,FilePath.s) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_FILE_SAVEDIB, 0, @FilePath)
EndProcedure
Procedure capEditCopy( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_EDIT_COPY, 0, 0)
EndProcedure
Procedure capSetAudioFormat(hCapWnd.i, *wavFormat.WAVEFORMATEX,  WavFormatSize.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_AUDIOFORMAT, WavFormatSize, *wavFormat)
EndProcedure
Procedure capSetAudioFormatAsArray(hCapWnd.i, *wavFormat, WavFormatSize.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_AUDIOFORMAT, WavFormatSize, *wavFormat)
EndProcedure
Procedure capGetAudioFormat( hCapWnd.i, *wavFormat.WAVEFORMATEX,  WavFormatSize.i)
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_AUDIOFORMAT, WavFormatSize, *wavFormat)
EndProcedure
Procedure capGetAudioFormatAsArray( hCapWnd.i,  *wavFormat,  WavFormatSize.i)
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_AUDIOFORMAT,WavFormatSize, *wavFormat)
EndProcedure
Procedure capGetAudioFormatSize(hCapWnd.i)
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_AUDIOFORMAT, 0, 0)
EndProcedure
Procedure capDlgVideoFormat(hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DLG_VIDEOFORMAT, 0, 0)
EndProcedure
Procedure capDlgVideoSource(hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DLG_VIDEOSOURCE, 0, 0)
EndProcedure
Procedure capDlgVideoDisplay(hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DLG_VIDEODISPLAY, 0, 0)
EndProcedure
Procedure capDlgVideoCompression( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_DLG_VIDEOCOMPRESSION, 0, 0)
EndProcedure
Procedure capGetVideoFormat(hCapWnd.i, *BmpFormat.BITMAPINFO,  CapFormatSize.i)
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_VIDEOFORMAT, CapFormatSize, *BmpFormat)
EndProcedure
Procedure capGetVideoFormatSize(hCapWnd.i, *BmpFormat.BITMAPINFO,  CapFormatSize.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_VIDEOFORMAT, CapFormatSize, *BmpFormat)
EndProcedure
Procedure capSetVideoFormat( hCapWnd.i, *BmpFormat.BITMAPINFO,  CapFormatSize.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_VIDEOFORMAT, CapFormatSize, *BmpFormat)
EndProcedure
Procedure capPreview(hCapWnd.i,true) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_PREVIEW,true,0) ;'convert the VB Boolean to a C BOOL with the - sign
EndProcedure
Procedure capPreviewRate( hCapWnd.i, wMS.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_PREVIEWRATE, wMS, 0)
EndProcedure
Procedure capOverlay( hCapWnd.i,true) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_OVERLAY,true, 0)
EndProcedure
Procedure capPreviewScale(hCapWnd.i,true) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_SCALE,true, 0)
EndProcedure
Procedure capGetStatus(hCapWnd.i,*capStat.CAPSTATUS) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_STATUS, SizeOf(capstatus), *capStat)
EndProcedure
Procedure capSetScrollPos(hCapWnd.i,*pt.VFWPOINT) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_SCROLL, 0, *pt)
EndProcedure
Procedure capGrabFrame(hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GRAB_FRAME, 0, 0)
EndProcedure
Procedure capGrabFrameNoStop( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GRAB_FRAME_NOSTOP, 0, 0)
EndProcedure
Procedure capCaptureSequence( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SEQUENCE, 0, 0)
EndProcedure
Procedure capCaptureSequenceNoFile( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SEQUENCE_NOFILE, 0, 0)
EndProcedure
Procedure capCaptureStop( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_STOP, 0, 0)
EndProcedure
Procedure capCaptureAbort( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_ABORT, 0, 0)
EndProcedure
Procedure capCaptureSingleFrameOpen( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SINGLE_FRAME_OPEN, 0, 0)
EndProcedure
Procedure capCaptureSingleFrameClose( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SINGLE_FRAME_CLOSE, 0, 0)
EndProcedure
Procedure capCaptureSingleFrame( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SINGLE_FRAME, 0, 0)
EndProcedure
Procedure capCaptureGetSetup( hCapWnd.i, *capParms.CAPTUREPARMS) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_GET_SEQUENCE_SETUP, SizeOf(CAPTUREPARMS), *capParms)
EndProcedure
Procedure capCaptureSetSetup( hCapWnd.i, *capParms.CAPTUREPARMS) 
    ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_SEQUENCE_SETUP, SizeOf(CAPTUREPARMS), *capParms)
EndProcedure
Procedure capSetMCIDeviceName( hCapWnd.i,DeviceName.s) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_SET_MCI_DEVICE, 0, @DeviceName)
EndProcedure
Procedure.s capGetMCIDeviceName( hCapWnd.i)
   szBuffer.s = Space(128)
   SendMessage_(hCapWnd, #WM_CAP_GET_MCI_DEVICE, dwSize, @szBuffer)
   ProcedureReturn szBuffer
EndProcedure
Procedure capPaletteOpen(hCapWnd.i,FilePath.s) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_PAL_OPEN, 0, @FilePath)
EndProcedure
Procedure capPaletteSave( hCapWnd.i,FilePath.s) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_PAL_SAVE, 0, @FilePath)
EndProcedure
Procedure capPalettePaste( hCapWnd.i) 
   ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_PAL_PASTE, 0, 0)
EndProcedure
Procedure capPaletteAuto( hCapWnd.i,  iFrames.i,  iColors.i) 
   If iColors > 256
     ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_PAL_AUTOCREATE, iFrames, iColors)
   Else 
     ProcedureReturn 0
   EndIf   
EndProcedure
Procedure capPaletteManual(hCapWnd.i,true,iColors.i) 
   If iColors > 256
      ProcedureReturn SendMessage_(hCapWnd, #WM_CAP_PAL_MANUALCREATE, true, iColors)
   Else 
     ProcedureReturn 0
   EndIf     
EndProcedure

Code: Select all

;d'un code écrit en c++ par son auteur Chiew Heng Wah
;fixed by ADAmor Ziltch 2014

#streamtypeAUDIO      = $73647561
#streamtypeVIDEO      = 1935960438
#ICMF_CHOOSE_KEYFRAME = 1
#ICMF_CHOOSE_DATARATE = 2
#AVIERR_OK            = 0
#AVIIF_KEYFRAME       = $10
#BmpFile              = 20
#AviFile              = 30

#AVISTREAMINFO_DISABLED = $1
#AVISTREAMINFO_FORMATCHANGES = $10000
#AVISTREAMREAD_CONVENIENT = -1
#AVSTREAMMASTER_AUDIO = 0
#AVSTREAMMASTER_NONE = 1
#AVICOMPRESSF_DATARATE = $2
#AVICOMPRESSF_INTERLEAVE = $1
#AVICOMPRESSF_KEYFRAMES = $4
#AVICOMPRESSF_VALID = $8


Global sgAvi32Lib.s = "C:\WINDOWS\system32\avifil32.dll"
Global      sgPat.s = ""
Global    igIndex.i = 0
Global      bgVal.b = 0
Global  sgAviFile.s = ""

Structure bitmap24
  bmiHeader.BITMAPINFOHEADER
EndStructure

Structure msvc
  a.b
  b.b
  c.b
  d.b
EndStructure

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

Global bi.BITMAPINFOHEADER
Global Opts.AVI_COMPRESS_OPTIONS
Global pFile.IAVIFILE
Global pStream
Global strhdr.AVI_STREAM_INFO

; ==== VB Syntax ====
; AVIFileInit()
; AVISaveOptions(ByVal hwnd As IntPtr, ByVal flags As UInt32, ByVal nStreams As Integer, ByRef ptr_ptr_avi As IntPtr, ByRef ao As Integer) As Integer 'AVI_COMPRESS_OPTIONS)
; AVISaveVA(ByVal szfile As String, ByVal pclsidhandler As Long, ByVal lpfncallback As Long, ByVal nstreams As Long, ByRef ppavistream As Long, ByRef ppcompoptions As Long) As Long
; AVIMakeCompressedStream(ByRef ppsCompressed As Long, ByRef psSource As Long, ByRef lpOptions As AVI_COMPRESS_OPTIONS, ByVal pclsidHandler As Long) As Long
; AVIFileOpen(ByRef ppfile As Int32, ByVal szFile As String, ByVal uMode As Int32, ByVal pclsidHandler As Int32) As Int32
; AVIFileGetStream(ByVal pfile As Int32, ByRef ppavi As IntPtr, ByVal fccType As Int32, ByVal lParam As Int32) As Int32
; AVIStreamStart(ByVal pavi As Int32) As Int32
; AVIStreamLength(ByVal pavi As Int32) As Int32
; AVIStreamInfo(ByVal pAVIStream As Int32, ByRef psi As AVISTREAM_INFO, ByVal lSize As Int32) As Int32
; AVIStreamGetFrameOpen(ByVal pAVIStream As IntPtr, ByRef bih As BITMAPINFOHEADER) As Int32
; AVIStreamGetFrame(ByVal pGetFrameObj As Int32, ByVal lPos As Int32) As Int32
; AVIFileCreateStream(ByVal pfile As Int32, ByRef ppavi As IntPtr, ByRef ptr_streaminfo As AVISTREAM_INFO) As Int32
; AVIStreamSetFormat(ByVal aviStream As IntPtr, ByVal lPos As Int32, ByRef lpFormat As BITMAPINFOHEADER, ByVal cbFormat As Int32) As Int32
; AVIStreamWrite(ByVal aviStream As IntPtr, ByVal lStart As Int32, ByVal lSamples As Int32, ByVal lpBuffer As IntPtr, ByVal cbBuffer As Int32, ByVal dwFlags As Int32, ByVal dummy1 As Int32, ByVal dummy2 As Int32) As Integer
; AVIStreamGetFrameClose(ByVal pGetFrameObj As Integer) As Integer
; AVIStreamRelease(ByVal aviStream As IntPtr) As Integer
; AVIFileRelease(ByVal pfile As Integer) As Integer
; AVIFileExit()

Prototype AVIFileInit()
Prototype AVISaveOptions(iHwnd.i,iFlags.i,iNstreams.i,ptrAvi,iOpts.i)
Prototype AVISaveVA(sFileSave.s,iPclsidhandler.i,iLpfncallback,iNstreams.i,iPpavistream.i,iPpcompoptions.i)
Prototype AVIMakeCompressedStream(iPpsCompressed.i,iPsSource.i,LpOptions.i,iPclsidHandler.i)
Prototype AVIFileOpen(iPfile.i,sFileOpen.s,iUmode.i,iPclsidHandler.i)
Prototype AVIFileGetStream(ipfileStream.i,ptr_avi,iFccType.i,iLParam.i)
Prototype AVIStreamStart(iPavi.i)
Prototype AVIStreamLength(iPavi.i)
Prototype AVIStreamInfo(iPaviStream.i,psi.i,iLsize.i)
Prototype AVIStreamGetFrameOpen(ptrAviStream,BitmapHeader)
Prototype AVIStreamGetFrame(iPGetFrameObj.i,iLpos.i)
Prototype AVIFileCreateStream(ptrAviFile,ptrAviStream,ptrStreamInfo)
Prototype AVIStreamSetFormat(ptrAviStream,iLpos.i,LpFormat,iCbFormat.i)
Prototype AVIStreamWrite(ptrAviStream,iLstart.i,iLsamples.i,ptrLpBuffer,iCbBuffer.i,iDwFlags.i,iDummy1.i,iDummy2.i)
Prototype AVIStreamGetFrameClose(iPGetFrameObj.i)
Prototype AVIStreamRelease(ptrAviStream)
Prototype AVIFileRelease(iPfile.i)
Prototype AVIFileExit()

Global AVIFileInit.AVIFileInit
Global AVISaveOptions.AVISaveOptions
Global AVISaveVA.AVISaveVA
Global AVIMakeCompressedStream.AVIMakeCompressedStream
Global AVIFileOpen.AVIFileOpen
Global AVIFileGetStream.AVIFileGetStream
Global AVIStreamStart.AVIStreamStart
Global AVIStreamLength.AVIStreamLength
Global AVIStreamInfo.AVIStreamInfo
Global AVIStreamGetFrameOpen.AVIStreamGetFrameOpen
Global AVIStreamGetFrame.AVIStreamGetFrame
Global AVIFileCreateStream.AVIFileCreateStream
Global AVIStreamSetFormat.AVIStreamSetFormat
Global AVIStreamWrite.AVIStreamWrite
Global AVIStreamGetFrameClose.AVIStreamGetFrameClose
Global AVIStreamRelease.AVIStreamRelease
Global AVIFileRelease.AVIFileRelease
Global AVIFileExit.AVIFileExit

AviLib = OpenLibrary(#PB_Any,sgAvi32Lib)
Window_Main=0


If AviLib
  AVIFileInit =  GetFunction(AviLib,"AVIFileInit")
  AVISaveOptions = GetFunction(AviLib,"AVISaveOptions")
  AVISaveVA = GetFunction(AviLib,"AVISaveVA")
  AVIMakeCompressedStream = GetFunction(AviLib,"AVIMakeCompressedStream")
  AVIFileOpen = GetFunction(AviLib,"AVIFileOpen")
  AVIFileGetStream = GetFunction(AviLib,"AVIFileGetStream")
  AVIStreamStart = GetFunction(AviLib,"AVIStreamStart")
  AVIStreamLength = GetFunction(AviLib,"AVIStreamLength")
  AVIStreamInfo = GetFunction(AviLib,"AVIStreamInfo")
  AVIStreamGetFrameOpen = GetFunction(AviLib,"AVIStreamGetFrameOpen")
  AVIStreamGetFrame = GetFunction(AviLib,"AVIStreamGetFrame")
  AVIFileCreateStream = GetFunction(AviLib,"AVIFileCreateStream")
  AVIStreamSetFormat = GetFunction(AviLib,"AVIStreamSetFormat")
  AVIStreamWrite = GetFunction(AviLib,"AVIStreamWrite")
  AVIStreamGetFrameClose = GetFunction(AviLib,"AVIStreamGetFrameClose")
  AVIStreamRelease = GetFunction(AviLib,"AVIStreamRelease")
  AVIFileRelease = GetFunction(AviLib,"AVIFileRelease")
  AVIFileExit = GetFunction(AviLib,"AVIFileExit")
  
  NewList  bitmap.s()
  NewList Memory.l()
  
  sgPat = "Image Files (*.BMP *.bmp)|*.BMP;*.bmp"
  Images.s = OpenFileRequester("Select multiple Bitmap Images", "", sgPat, 0, #PB_Requester_MultiSelection)
  
  If Images    
    AddElement(bitmap())    
    bitmap() = Images
    
    Repeat      
      Images = NextSelectedFileName()
      If Images        
        AddElement(bitmap())
        bitmap() = Images
      EndIf      
    Until Images = ""
    
  EndIf
  
  
  ; ----- this routine copies the data directly but the AVI functions need data in BGR not RGB
  ; ----- so the red and blue colors get swaped in avi
  ForEach bitmap()  
    
    If ReadFile(#BmpFile, bitmap())
      
      FileSeek(#BmpFile, SizeOf(BITMAPFILEHEADER))
      bmi.bitmap24
      ReadData(#BmpFile, @bmi, SizeOf(bitmap24))
      
      If bmi\bmiHeader\biWidth        
        If bmi\bmiHeader\biHeight          
          If bmi\bmiHeader\biBitCount            
            If bmi\bmiHeader\bisizeimage = 0              
              bmi\bmiHeader\bisizeimage = (Lof(#BmpFile) - 1078);54)
            EndIf
            
            FileSeek(#BmpFile,1078)
            AddElement(Memory())
            Memory() = GlobalAlloc_(#GMEM_FIXED|#GMEM_ZEROINIT, bmi\bmiHeader\bisizeimage)
            ReadData(#BmpFile,Memory(), bmi\bmiHeader\bisizeimage)
          EndIf
        EndIf
      EndIf
      
      CloseFile(#BmpFile)
    EndIf
  Next
  
  AVIFileInit()
  
  ;    sgPat = "AVI Movie File (*.AVI *.avi)|*.AVI;*.avi"
  ;sgAviFile = SaveFileRequester("Enter AVI File Name", "", sgPat, 0)
  sgAviFile = "Test1.avi"
  
  ;If(GetExtensionPart(sgAviFile) = "") : sgAviFile = sgAviFile + ".avi" : EndIf
  
  If AVIFileOpen(@pFile,sgAviFile,(#OF_WRITE|#OF_CREATE),0) = 0
    
    
     
    
    strhdr\fccType               = #streamtypeVIDEO
    strhdr\fccHandler\a          = $6D
    strhdr\fccHandler\b          = $73
    strhdr\fccHandler\c          = $76
    strhdr\fccHandler\d          = $63
    strhdr\dwScale               = 1
    strhdr\dwRate                = 4 ;##Frames per second(1 to 30)
    strhdr\dwSuggestedBufferSize = (3 * (bmi\bmiHeader\biHeight * bmi\bmiHeader\biWidth))
    strhdr\rcFrame\top           = 0
    strhdr\rcFrame\left          = 0
    
    pStream=0
    
    If SetRect_(strhdr\rcFrame,0,0,bmi\bmiHeader\biWidth,bmi\bmiHeader\biHeight) <> 0
      
      If AVIFileCreateStream(pFile,@pStream,@strhdr) = 0
        
        Dim Opts(1)
        Opts(0) = @Opts
        WindHwnd =0
        
        If AVISaveOptions(WindHwnd, #ICMF_CHOOSE_KEYFRAME | #ICMF_CHOOSE_DATARATE, 1, @pStream, @opts(0)) = 1
          
          If AVIMakeCompressedStream(@pAVICompressed, pStream, opts(0), 0) = #AVIERR_OK
            
            If AVIStreamSetFormat(pAVICompressed, 0, @bmi, SizeOf(bitmap24)) = 0
              
              ForEach Memory()                
                If Memory()                  
                  If AVIStreamWrite(pAVICompressed, igIndex, 1, Memory(), bmi\bmiHeader\bisizeimage, #AVIIF_KEYFRAME, 0, 0) = 0                    
                    igIndex = igIndex + 1 
                    Debug "Wrote frame "+Str(igIndex)
                  Else                    
                    MessageRequester("Attention","AVI Stream Write call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)                    
                  EndIf                  
                EndIf               
              Next
              
            Else              
              MessageRequester("Attention","AVI Stream Set Format call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)              
            EndIf
            
            AVIStreamRelease(pAVICompressed)
            
          Else            
            MessageRequester("Attention","AVI Make Compressed Stream call failed", #PB_MessageRequester_Ok | #MB_ICONERROR) 
          EndIf
          
        Else          
          MessageRequester("Attention","AVI Save Options call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)          
        EndIf
        
        AVIStreamRelease(pStream)
        
      Else        
        MessageRequester("Attention","AVI create File Stream failed", #PB_MessageRequester_Ok | #MB_ICONERROR)        
      EndIf
      
    Else      
      MessageRequester("Attention","Set frame width/height values failed", #PB_MessageRequester_Ok | #MB_ICONERROR)      
    EndIf
    
    AVIFileRelease(pFile)
    
  Else    
    MessageRequester("Attention","AVI File Open failed", #PB_MessageRequester_Ok | #MB_ICONERROR)    
  EndIf
  
  AVIFileExit() ;## Release the AVI Lib
  
  CloseLibrary(AviLib)
  
  ForEach Memory()
    GlobalFree_(Memory())
  Next
  
  MessageRequester("Info","Total number of Frames created: " + Str(igIndex))
Else
  MessageRequester("Attention","Could not Open AVI Lib", #PB_MessageRequester_Ok | #MB_ICONERROR)
EndIf

End

Code: Select all

;d'un code écrit en c++ par son auteur Chiew Heng Wah
;fixed by ADAmor Ziltch 2014

EnableExplicit

#streamtypeAUDIO      = $73647561
#streamtypeVIDEO      = 1935960438
#ICMF_CHOOSE_KEYFRAME = 1
#ICMF_CHOOSE_DATARATE = 2
#AVIERR_OK            = 0
#AVIIF_KEYFRAME       = $10
#BmpFile              = 20
#AviFile              = 30

#AVISTREAMINFO_DISABLED = $1
#AVISTREAMINFO_FORMATCHANGES = $10000
#AVISTREAMREAD_CONVENIENT = -1
#AVSTREAMMASTER_AUDIO = 0
#AVSTREAMMASTER_NONE = 1
#AVICOMPRESSF_DATARATE = $2
#AVICOMPRESSF_INTERLEAVE = $1
#AVICOMPRESSF_KEYFRAMES = $4
#AVICOMPRESSF_VALID = $8



Macro MAKE_SCODE(sev, fac, code)
  ((sev << 31) | (fac << 16) | (code))
EndMacro

#FACILITY_ITF = $0

Macro MAKE_AVIERR(e)
  MAKE_SCODE(#SEVERITY_ERROR, #FACILITY_ITF, $4000 + e)
EndMacro

#AVIERR_OK = 0
#AVIERR_UNSUPPORTED	= MAKE_AVIERR(101)
#AVIERR_BADFORMAT	= MAKE_AVIERR(102)
#AVIERR_MEMORY = MAKE_AVIERR(103)
#AVIERR_INTERNAL = MAKE_AVIERR(104)
#AVIERR_BADFLAGS = MAKE_AVIERR(105)
#AVIERR_BADPARAM = MAKE_AVIERR(106)
#AVIERR_BADSIZE = MAKE_AVIERR(107)
#AVIERR_BADHANDLE = MAKE_AVIERR(108)
#AVIERR_FILEREAD = MAKE_AVIERR(109)
#AVIERR_FILEWRITE	= MAKE_AVIERR(110)
#AVIERR_FILEOPEN = MAKE_AVIERR(111)
#AVIERR_COMPRESSOR = MAKE_AVIERR(112)
#AVIERR_NOCOMPRESSOR = MAKE_AVIERR(113)
#AVIERR_READONLY = MAKE_AVIERR(114)
#AVIERR_NODATA = MAKE_AVIERR(115)
#AVIERR_BUFFERTOOSMALL = MAKE_AVIERR(116)
#AVIERR_CANTCOMPRESS = MAKE_AVIERR(117)
#AVIERR_USERABORT	= MAKE_AVIERR(198)
#AVIERR_ERROR	= MAKE_AVIERR(199)



Global igIndex.i = 0
Global bgVal.b = 0


Structure bitmap24
  bmiHeader.BITMAPINFOHEADER
EndStructure

Structure msvc
  a.b
  b.b
  c.b
  d.b
EndStructure

Structure AVI_STREAM_INFO
  fccType.l
  fccHandler.msvc
  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.a[64]
EndStructure

Structure AVI_COMPRESS_OPTIONS
  fccType.l
  fccHandler.l
  dwKeyFrameEvery.l
  dwQuality.l
  dwBytesPerSecond.l
  dwFlags.l
  *lpFormat
  cbFormat.l
  *lpParms
  cbParms.l
  dwInterleaveEvery.l
EndStructure


Structure ImageStr
  Filename$
  *Buffer
EndStructure


;Global bi.BITMAPINFOHEADER
Global Opts.AVI_COMPRESS_OPTIONS
Global pFile.IAVIFILE
Global pStream
Global strhdr.AVI_STREAM_INFO

; ==== VB Syntax ====
; AVIFileInit()
; AVISaveOptions(ByVal hwnd As IntPtr, ByVal flags As UInt32, ByVal nStreams As Integer, ByRef ptr_ptr_avi As IntPtr, ByRef ao As Integer) As Integer 'AVI_COMPRESS_OPTIONS)
; AVISaveVA(ByVal szfile As String, ByVal pclsidhandler As Long, ByVal lpfncallback As Long, ByVal nstreams As Long, ByRef ppavistream As Long, ByRef ppcompoptions As Long) As Long
; AVIMakeCompressedStream(ByRef ppsCompressed As Long, ByRef psSource As Long, ByRef lpOptions As AVI_COMPRESS_OPTIONS, ByVal pclsidHandler As Long) As Long
; AVIFileOpen(ByRef ppfile As Int32, ByVal szFile As String, ByVal uMode As Int32, ByVal pclsidHandler As Int32) As Int32
; AVIFileGetStream(ByVal pfile As Int32, ByRef ppavi As IntPtr, ByVal fccType As Int32, ByVal lParam As Int32) As Int32
; AVIStreamStart(ByVal pavi As Int32) As Int32
; AVIStreamLength(ByVal pavi As Int32) As Int32
; AVIStreamInfo(ByVal pAVIStream As Int32, ByRef psi As AVISTREAM_INFO, ByVal lSize As Int32) As Int32
; AVIStreamGetFrameOpen(ByVal pAVIStream As IntPtr, ByRef bih As BITMAPINFOHEADER) As Int32
; AVIStreamGetFrame(ByVal pGetFrameObj As Int32, ByVal lPos As Int32) As Int32
; AVIFileCreateStream(ByVal pfile As Int32, ByRef ppavi As IntPtr, ByRef ptr_streaminfo As AVISTREAM_INFO) As Int32
; AVIStreamSetFormat(ByVal aviStream As IntPtr, ByVal lPos As Int32, ByRef lpFormat As BITMAPINFOHEADER, ByVal cbFormat As Int32) As Int32
; AVIStreamWrite(ByVal aviStream As IntPtr, ByVal lStart As Int32, ByVal lSamples As Int32, ByVal lpBuffer As IntPtr, ByVal cbBuffer As Int32, ByVal dwFlags As Int32, ByVal dummy1 As Int32, ByVal dummy2 As Int32) As Integer
; AVIStreamGetFrameClose(ByVal pGetFrameObj As Integer) As Integer
; AVIStreamRelease(ByVal aviStream As IntPtr) As Integer
; AVIFileRelease(ByVal pfile As Integer) As Integer
; AVIFileExit()

Prototype AVIFileInit()
Prototype AVISaveOptions(iHwnd.i,iFlags.i,iNstreams.i,ptrAvi,iOpts.i)
Prototype AVISaveVA(sFileSave.s,iPclsidhandler.i,iLpfncallback,iNstreams.i,iPpavistream.i,iPpcompoptions.i)
Prototype AVIMakeCompressedStream(iPpsCompressed.i,iPsSource.i,LpOptions.i,iPclsidHandler.i)
Prototype.l AVIFileOpen(iPfile.l, sFileOpen.p-Ascii, iUmode.l, iPclsidHandler.l)
Prototype AVIFileGetStream(ipfileStream.i,ptr_avi,iFccType.i,iLParam.i)
Prototype AVIStreamStart(iPavi.i)
Prototype AVIStreamLength(iPavi.i)
Prototype AVIStreamInfo(iPaviStream.i,psi.i,iLsize.i)
Prototype AVIStreamGetFrameOpen(ptrAviStream,BitmapHeader)
Prototype AVIStreamGetFrame(iPGetFrameObj.i,iLpos.i)
Prototype AVIFileCreateStream(ptrAviFile,ptrAviStream,ptrStreamInfo)
Prototype AVIStreamSetFormat(ptrAviStream,iLpos.i,LpFormat,iCbFormat.i)
Prototype AVIStreamWrite(ptrAviStream,iLstart.i,iLsamples.i,ptrLpBuffer,iCbBuffer.i,iDwFlags.i,iDummy1.i,iDummy2.i)
Prototype AVIStreamGetFrameClose(iPGetFrameObj.i)
Prototype AVIStreamRelease(ptrAviStream)
Prototype AVIFileRelease(iPfile.i)
Prototype AVIFileExit()

Global AVIFileInit.AVIFileInit
Global AVISaveOptions.AVISaveOptions
Global AVISaveVA.AVISaveVA
Global AVIMakeCompressedStream.AVIMakeCompressedStream
Global AVIFileOpen.AVIFileOpen
Global AVIFileGetStream.AVIFileGetStream
Global AVIStreamStart.AVIStreamStart
Global AVIStreamLength.AVIStreamLength
Global AVIStreamInfo.AVIStreamInfo
Global AVIStreamGetFrameOpen.AVIStreamGetFrameOpen
Global AVIStreamGetFrame.AVIStreamGetFrame
Global AVIFileCreateStream.AVIFileCreateStream
Global AVIStreamSetFormat.AVIStreamSetFormat
Global AVIStreamWrite.AVIStreamWrite
Global AVIStreamGetFrameClose.AVIStreamGetFrameClose
Global AVIStreamRelease.AVIStreamRelease
Global AVIFileRelease.AVIFileRelease
Global AVIFileExit.AVIFileExit



Define.i AviLib, Window_Main, PixelFormat, Pitch, y, WindHwnd, pAVICompressed, *ppfile
Define.l ResultL
Define sgPat$, Images$
Define *Buffer
Define bmi.bitmap24
Define sgAviFile.s
Define *pavfile.IAVIFILE


NewList ImageList.ImageStr()


UseJPEGImageDecoder()
UsePNGImageDecoder()


AviLib = OpenLibrary(#PB_Any, "avifil32.dll")

If AviLib
  AVIFileInit = GetFunction(AviLib, "AVIFileInit")
  AVISaveOptions = GetFunction(AviLib, "AVISaveOptions")
  AVISaveVA = GetFunction(AviLib, "AVISaveVA")
  AVIMakeCompressedStream = GetFunction(AviLib, "AVIMakeCompressedStream")
  AVIFileOpen = GetFunction(AviLib, "AVIFileOpen")
  AVIFileGetStream = GetFunction(AviLib, "AVIFileGetStream")
  AVIStreamStart = GetFunction(AviLib, "AVIStreamStart")
  AVIStreamLength = GetFunction(AviLib, "AVIStreamLength")
  AVIStreamInfo = GetFunction(AviLib, "AVIStreamInfo")
  AVIStreamGetFrameOpen = GetFunction(AviLib, "AVIStreamGetFrameOpen")
  AVIStreamGetFrame = GetFunction(AviLib, "AVIStreamGetFrame")
  AVIFileCreateStream = GetFunction(AviLib, "AVIFileCreateStream")
  AVIStreamSetFormat = GetFunction(AviLib, "AVIStreamSetFormat")
  AVIStreamWrite = GetFunction(AviLib, "AVIStreamWrite")
  AVIStreamGetFrameClose = GetFunction(AviLib, "AVIStreamGetFrameClose")
  AVIStreamRelease = GetFunction(AviLib, "AVIStreamRelease")
  AVIFileRelease = GetFunction(AviLib, "AVIFileRelease")
  AVIFileExit = GetFunction(AviLib, "AVIFileExit")
  
  
  MessageRequester("Info", "All pictures need to have the same size of course")
  
  
  sgPat$ = "Image Files |*.BMP;*.bmp;*.jpg;*.JPG;*.png;*.PNG"
  Images$ = OpenFileRequester("Select multiple Bitmap Images", "", sgPat$, 0, #PB_Requester_MultiSelection)
  
  If Images$
    AddElement(ImageList())
    ImageList()\Filename$ = Images$
   
    Repeat     
      Images$ = NextSelectedFileName()
      If Images$
        AddElement(ImageList())
        ImageList()\Filename$ = Images$
      EndIf     
    Until Images$ = ""
   
  EndIf
 
 
  ; ----- this routine copies the data directly but the AVI functions need data in BGR not RGB
  ; ----- so the red and blue colors get swaped in avi
  ForEach ImageList()
    
    If LoadImage(#BmpFile, ImageList()\Filename$)
      
      StartDrawing(ImageOutput(#BmpFile))
      *Buffer = DrawingBuffer()
      PixelFormat = DrawingBufferPixelFormat()
      Pitch = DrawingBufferPitch()
      StopDrawing()
      
      If bmi\bmiHeader\biSize = 0
        bmi\bmiHeader\biSize = SizeOf(bitmap24)
        bmi\bmiHeader\biBitCount = 24
        bmi\bmiHeader\biPlanes = 1
     
        bmi\bmiHeader\biWidth = ImageWidth(#BmpFile)
        bmi\bmiHeader\biHeight = ImageHeight(#BmpFile)
        bmi\bmiHeader\biSizeImage = bmi\bmiHeader\biWidth * bmi\bmiHeader\biHeight * 3
      EndIf
      
      ImageList()\Buffer = AllocateMemory(bmi\bmiHeader\biSizeImage)
     
      If ImageList()\Buffer
        For y = 0 To bmi\bmiHeader\biHeight - 1
          CopyMemory(*Buffer + (y * Pitch), ImageList()\Buffer + (y * bmi\bmiHeader\biWidth * 3), bmi\bmiHeader\biWidth * 3)
        Next y
      EndIf
     
      FreeImage(#BmpFile)
     
    EndIf
   
  Next
 
  If ListSize(ImageList())
   
    AVIFileInit()
 
    ;    sgPat = "AVI Movie File (*.AVI *.avi)|*.AVI;*.avi"
    ;sgAviFile = SaveFileRequester("Enter AVI File Name", "", sgPat, 0)
    sgAviFile = GetPathPart(ProgramFilename()) + "Test1.avi"
 
    ;If(GetExtensionPart(sgAviFile) = "") : sgAviFile = sgAviFile + ".avi" : EndIf
    
    ResultL = AVIFileOpen(@*pavfile, sgAviFile, #OF_CREATE, #Null)
    If ResultL = #AVIERR_OK
     
      strhdr\fccType                = #streamtypeVIDEO
      strhdr\fccHandler\a           = $6D
      strhdr\fccHandler\b           = $73
      strhdr\fccHandler\c           = $76
      strhdr\fccHandler\d           = $63
      strhdr\dwScale                = 1
      strhdr\dwRate                 = 1 ;##Frames per second(1 to 30)
      strhdr\dwSuggestedBufferSize  = (3 * bmi\bmiHeader\biHeight * bmi\bmiHeader\biWidth)
      strhdr\rcFrame\top            = 0
      strhdr\rcFrame\left           = 0
      strhdr\rcFrame\right          = bmi\bmiHeader\biWidth
      strhdr\rcFrame\bottom         = bmi\bmiHeader\biHeight
      strhdr\dwStart                = 0 ; StartFrame
      strhdr\dwLength               = ListSize(ImageList())
      ;strhdr\szName                 = @"Done by PureBasic"
      PokeS(@strhdr\szName[0], "Done by PureBasic", -1, #PB_Ascii)
     
     
      If AVIFileCreateStream(*pavfile, @pStream, @strhdr) = 0
       
        Dim Opts(1)
        Opts(0) = @Opts
       
     
        If AVISaveOptions(WindHwnd, #ICMF_CHOOSE_KEYFRAME | #ICMF_CHOOSE_DATARATE, 1, @pStream, @opts(0)) = 1
       
          If AVIMakeCompressedStream(@pAVICompressed, pStream, opts(0), 0) = #AVIERR_OK
         
            If AVIStreamSetFormat(pAVICompressed, 0, @bmi, SizeOf(bitmap24)) = 0
           
              ForEach ImageList()
                If ImageList()\Buffer
                  If AVIStreamWrite(pAVICompressed, igIndex, 1, ImageList()\Buffer, bmi\bmiHeader\bisizeimage, #AVIIF_KEYFRAME, 0, 0) = 0
                    igIndex = igIndex + 1
                    ;Debug "Wrote frame "+Str(igIndex)
                  Else                   
                    MessageRequester("Attention","AVI Stream Write call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)                   
                  EndIf                 
                EndIf
                FreeMemory(ImageList()\Buffer)
              Next
             
            Else             
              MessageRequester("Attention","AVI Stream Set Format call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)             
            EndIf
           
            AVIStreamRelease(pAVICompressed)
           
          Else           
            MessageRequester("Attention","AVI Make Compressed Stream call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)
          EndIf
         
        Else         
          MessageRequester("Attention","AVI Save Options call failed", #PB_MessageRequester_Ok | #MB_ICONERROR)         
        EndIf
       
        AVIStreamRelease(pStream)
       
      Else       
        MessageRequester("Attention","AVI create File Stream failed", #PB_MessageRequester_Ok | #MB_ICONERROR)       
      EndIf
     
      AVIFileRelease(*pavfile)
     
    Else   
      MessageRequester("Attention","AVI File Open failed: " + Hex(ResultL, #PB_Long), #PB_MessageRequester_Ok | #MB_ICONERROR)   
    EndIf
   
    AVIFileExit() ;## Release the AVI Lib
   
    MessageRequester("Info","Total number of Frames created: " + Str(igIndex))
   
  EndIf
 
  CloseLibrary(AviLib)
 
Else
  MessageRequester("Attention","Could not Open AVI Lib", #PB_MessageRequester_Ok | #MB_ICONERROR)
EndIf