Sorry your browser is not supported!

{*****************************************************************************}
{*                                                                           *}
{* AVIReaderWriter                                                           *}
{* ---------------                                                           *}
{*                                                                           *}
{* Written by Mark Walters                                                   *}
{* (c) Copyright 2011                                                        *}
{*                                                                           *}
{*****************************************************************************}
{*                                                                           *}
{* Things to do                                                              *}
{* ------------                                                              *}
{*                                                                           *}
{*                                                                           *}
{* 1) The if / then error code blocks need updating so that all allocated    *}
{*    resources are freed.                                                   *}
{*                                                                           *}
{*****************************************************************************}

unit AVIReaderWriter;

interface

uses
  Windows, SysUtils, Classes, Graphics, Forms, Dialogs, VFW, StdCtrls;

// a type to hold info for an open avi file
type
  TAVIFileHandle = packed record
    pFile: PAVIFile;
    AVIInfo: TAVIFILEINFOW;
    AVIStream: PAVIStream;
    gapgf: PGETFRAME;
    lpbi: PBITMAPINFOHEADER;
    FrameBmp: TBitmap;
    FrameSize: longword;
    FrameRasterWidth: longint;
    m_Bih: BITMAPINFOHEADER;
    TheOpts: TAVICOMPRESSOPTIONS;
    Opts: PAVICOMPRESSOPTIONS;
    ps: PAVIStream;
    TheCompressed: IAVIStream;
    psCompressed: PAVIStream;
    Thestrhdr: TAVISTREAMINFO;
    strhdr: PAVISTREAMINFO;
  end;

var
  debugmemo: TMemo;

function mmioStringToFOURCCA(sz : PChar; uFlags : DWORD) : integer; stdcall; external 'winmm.dll';

// functions to open, read and close
function AVIReaderOpenAVI(avifn: string; var avifilehandle: TAVIFileHandle): boolean;
function AVIReaderGetFrame(var avifilehandle: TAVIFileHandle; iFrameNumber: longint): boolean;
function AVIReaderCloseAVI(var avifilehandle: TAVIFileHandle): boolean;

// functions to open, write and close
function AVIWriterOpenAVI(avifn: string; var avifilehandle: TAVIFileHandle;
  FrameWidth: longint; FrameHeight: longint; FramesPerSec: longint;  CompressionOptions: pointer; CompressionParms: string): boolean;
function AVIWriterPutFrame(var aviFileHandle: TAVIFileHandle; i: longword): boolean;
function AVIWriterCloseAVI(var aviFileHandle: TAVIFileHandle): boolean;

implementation

{*****************************************************************************}
{*                                                                           *}
{* AVIReaderOpenAVI                                                          *}
{* ----------------                                                          *}
{*                                                                           *}
{*****************************************************************************}

function AVIReaderOpenAVI(avifn: string; var avifilehandle: TAVIFileHandle): boolean;
var
  Error: longword;
  sError: string;
begin
  avifilehandle.framebmp := nil;

  // The AVIFileOpen function opens an AVI file
  Error := AVIFileOpen(avifilehandle.pFile, PChar(avifn), 0, nil);
  if Error <> 0 then
  begin
    case Error of
      AVIERR_BADFORMAT: sError := 'The file couldn''t be read';
      AVIERR_MEMORY: sError := 'The file could not be opened because of insufficient memory.';
      AVIERR_FILEREAD: sError := 'A disk error occurred while reading the file.';
      AVIERR_FILEOPEN: sError := 'A disk error occurred while opening the file.';
    end;
    ShowMessage(sError);
    result := false;
    Exit;
  end;

  // AVIFileInfo obtains information about an AVI file
  if AVIFileInfo(avifilehandle.pFile, @avifilehandle.AVIINFO, SizeOf(avifilehandle.AVIINFO)) <> AVIERR_OK then
  begin
    // Clean up and exit
    AVIFileRelease(avifilehandle.pFile);
    sError := 'AVIFileInfo failed.';
    ShowMessage(sError);
    result := false;
    Exit;
  end;

  // Open a Stream from the file
  Error := AVIFileGetStream(avifilehandle.pFile, avifilehandle.AVIStream, streamtypeVIDEO, 0);
  if Error <> AVIERR_OK then
  begin
    // Clean up and exit
    sError := 'AVIFileGetStream failed.';
    ShowMessage(sError);
    result := false;
    Exit;
  end;

 // Prepares to decompress video frames
  avifilehandle.gapgf := AVIStreamGetFrameOpen(avifilehandle.AVIStream, nil);
  if avifilehandle.gapgf = nil then
  begin
    sError := 'AVIStreamGetFrameOpen failed.';
    ShowMessage(sError);
    result := false;
    Exit;
  end;

  AVIReaderGetFrame(avifilehandle, 0);

  result := true;
end;

{*****************************************************************************}
{*                                                                           *}
{* AVIReaderGetFrame                                                         *}
{* -----------------                                                         *}
{*                                                                           *}
{*****************************************************************************}

function AVIReaderGetFrame(var avifilehandle: TAVIFileHandle; iFrameNumber: longint): boolean;
var
  sError: string;
  bits: pointer;
begin
  // Read current Frame
  // AVIStreamGetFrame Returns the address of a decompressed video frame
  avifilehandle.lpbi := AVIStreamGetFrame(avifilehandle.gapgf, iFrameNumber);
  if avifilehandle.lpbi = nil then
  begin
    sError := 'AVIStreamGetFrame failed.';
    ShowMessage(sError);
    result := false;
    Exit;
  end;

  // need to create the frame buffer once
  if avifilehandle.framebmp = nil then
  begin
    avifilehandle.framebmp := TBitmap.Create;
    avifilehandle.framebmp.width := avifilehandle.lpbi.biWidth;
    avifilehandle.framebmp.height := avifilehandle.lpbi.biHeight;
    case avifilehandle.lpbi.biBitCount of
      24: avifilehandle.framebmp.pixelformat := pf24bit;
      32: avifilehandle.framebmp.pixelformat := pf32bit;
    else
      showmessage('AVIReaderGetFrame:  Assuming 32 bit frames.');
      avifilehandle.framebmp.pixelformat := pf32bit;
    end;

    with avifilehandle.framebmp.canvas do
    begin
      pen.color := rgb(0,255,0);
      brush.color := rgb(0,255,0);
      rectangle(0, 0, avifilehandle.lpbi.biWidth, avifilehandle.lpbi.biHeight);
    end;
  end;

  bits := Pointer(Integer(avifilehandle.lpbi) + SizeOf(TBITMAPINFOHEADER));

  CopyMemory(avifilehandle.framebmp.scanline[avifilehandle.lpbi.biHeight-1],
             bits,
             avifilehandle.lpbi.biSizeImage);
  {
  showmessage('frame '+#13#13+
              inttostr(avifilehandle.lpbi.biHeight)+#13+
              inttostr(avifilehandle.lpbi.biWidth)+#13+
              inttostr(avifilehandle.lpbi.biBitCount));
  }

  result := true;
end;

{*****************************************************************************}
{*                                                                           *}
{* AVIReaderCloseAVI                                                         *}
{* -----------------                                                         *}
{*                                                                           *}
{*****************************************************************************}

function AVIReaderCloseAVI(var avifilehandle: TAVIFileHandle): boolean;
begin
  if avifilehandle.framebmp <> nil then
  begin
    avifilehandle.framebmp.destroy;
  end;

  AVIStreamGetFrameClose(avifilehandle.gapgf);
  AVIStreamRelease(avifilehandle.AVIStream);
  AVIFileRelease(avifilehandle.pfile);

  result := true;
end;

{*****************************************************************************}
{*                                                                           *}
{* AVIWriterOpenAVI                                                          *}
{* ----------------                                                          *}
{*                                                                           *}
{*****************************************************************************}

function AVIWriterOpenAVI(avifn: string; var avifilehandle: TAVIFileHandle;
  FrameWidth: longint; FrameHeight: longint; FramesPerSec: longint;
  CompressionOptions: pointer;
  CompressionParms: string): boolean;
var
  i: integer;
  p: pointer;
  Error: longword;
  presetup: pointer;
begin
  DeleteFile(avifn);

  Fillchar(aviFileHandle.TheOpts, SizeOf(aviFileHandle.TheOpts),0);
  FillChar(aviFileHandle.Thestrhdr,SizeOf(aviFileHandle.Thestrhdr),0);
  aviFileHandle.Opts := @aviFileHandle.TheOpts;
  aviFileHandle.strhdr := @aviFileHandle.Thestrhdr;

  aviFileHandle.Opts.fccHandler := 541215044;    // Full frames Uncompressed

  aviFileHandle.pfile := nil;

  Error := AVIFileOpen(avifilehandle.pFile, PChar(avifn), OF_WRITE or OF_CREATE, nil);
  if Error <> 0 then
  begin
    ShowMessage('AVIFileOpen failed');
    result := false;
    exit;
  end;

  with aviFileHandle do
  begin
    if assigned(framebmp) = true then framebmp.destroy;
    framebmp := TBitmap.Create;
    framebmp.width := FrameWidth;
    framebmp.height := FrameHeight;
    framebmp.PixelFormat := pf24bit;
    with framebmp.canvas do
    begin
      pen.color := $00FF00;
      brush.color := $00FF00;
      rectangle(0, 0, FrameWidth+1, FrameHeight+1);
    end;
    FrameRasterWidth := longword(FrameBMP.ScanLine[0]) - longword(FrameBMP.ScanLine[1]);

    //ShowMessage(IntToStr(FrameRasterWidth));
    FrameSize := FrameRasterWidth * FrameHeight;
  end;

  with aviFileHandle.m_Bih do
  begin
    biSize := 40;
    biWidth := FrameWidth;
    biHeight := FrameHeight;
    biPlanes := 1;
    biBitCount := 24;
    //biBitCount := 32;
    biCompression := 0;
    biSizeImage := aviFileHandle.FrameSize;
    biXPelsPerMeter := 10000;
    biYPelsPerMeter := 10000;
    biClrUsed := 0;
    biClrImportant := 0;
  end;

  aviFileHandle.strhdr.fccType := mmioStringToFOURCCA('vids', 0);      // stream type video
  aviFileHandle.strhdr.fccHandler := 0;                                // def AVI handler

  aviFileHandle.strhdr.dwScale := 1;
  aviFileHandle.strhdr.dwRate := FramesPerSec;                         // fps 1 to 30
  aviFileHandle.strhdr.dwSuggestedBufferSize := 0;    // size of 1 frame

  SetRect(aviFileHandle.strhdr.rcFrame,0,0, FrameWidth, FrameHeight);

  Error := AVIFileCreateStream(aviFileHandle.pFile, aviFileHandle.ps, aviFileHandle.strhdr);
  if Error <> 0 then
  begin
    Showmessage('AVIFileCreateStream failed');
    result := false;
    exit;
  end;

  // if you want user selection options then pass an empty CompressionParms string
  if CompressionParms = '' then
  begin
    AVISaveOptions(Application.Handle,
                   ICMF_CHOOSE_KEYFRAME or ICMF_CHOOSE_DATARATE,
                   1,
                   aviFileHandle.ps,
                   aviFileHandle.Opts);
  end else begin
    // compression settings have been pre-specified
    //
    // The AVISaveOptionsFree API function frees the block of memory passed to it so we need to
    // allocate a temp buffer and let the function deallocate it.  We cannot pass the pointer
    // give to us because the caller may try and use its memory again
    Presetup := pointer(GlobalAlloc(GMEM_FIXED, length(CompressionParms)));
    if Presetup = nil then
    begin
      Showmessage('AVIWriterOpenAVI - GlobalAlloc failed');
      result := false;
      exit;
    end;

    // copy the compression parms into the temp buffer
    CopyMemory(presetup, @CompressionParms[1], length(CompressionParms));

    // fill in the compression options record
    CopyMemory(@aviFileHandle.TheOpts, CompressionOptions,
      sizeof(aviFileHandle.TheOpts));

    aviFileHandle.Opts.lpParms := Presetup;
    aviFileHandle.Opts.cbParms := length(CompressionParms);
  end;

  if debugmemo <> nil then
  begin
    debugmemo.clear;

    debugmemo.lines.add('Type               = ' + inttostr(aviFileHandle.Opts.fccType));
    debugmemo.lines.add('Handler            = ' + inttostr(aviFileHandle.Opts.fccHandler));
    debugmemo.lines.add('KeyFrameEvery      = ' + inttostr(aviFileHandle.Opts.dwKeyFrameEvery));
    debugmemo.lines.add('Quality            = ' + inttostr(aviFileHandle.Opts.dwQuality));
    debugmemo.lines.add('BytesPerSecond     = ' + inttostr(aviFileHandle.Opts.dwBytesPerSecond));
    debugmemo.lines.add('Flags              = ' + inttostr(aviFileHandle.Opts.dwFlags));
    debugmemo.lines.add('lpFormat           = ' + inttostr(longword(aviFileHandle.Opts.lpFormat)));
    debugmemo.lines.add('cbFormat           = ' + inttostr(aviFileHandle.Opts.cbFormat));
    debugmemo.lines.add('lpParms            = ' + inttostr(longword(aviFileHandle.Opts.lpParms)));
    debugmemo.lines.add('cbParms            = ' + inttostr(aviFileHandle.Opts.cbParms));
    debugmemo.lines.add('dwInterleaveEvery  = ' + inttostr(aviFileHandle.Opts.dwInterleaveEvery));

    p := pointer(aviFileHandle.Opts.lpParms);
    debugmemo.lines.add('IsBadReadPtr = '+IntToStr(longint(IsBadReadPtr(p, aviFileHandle.Opts.cbParms))));

    for i := 0 to aviFileHandle.Opts.cbParms-1 do
    begin
      debugmemo.lines.add(inttostr(i)+' '+inttostr(byte(p^)));
      inc(longword(p));
    end;
  end;

  /////////////////////////////////////////////////////////////////////////

  Error := AVIMakeCompressedStream(aviFileHandle.psCompressed, aviFileHandle.ps, aviFileHandle.opts, nil);
  if Error <> 0 then
  begin
    ShowMessage('AVIMakeComprssedStream failed');
    result := false;
    exit;
  end;

  AVISaveOptionsFree(1, aviFileHandle.Opts);

  if debugmemo <> nil then
  begin
    p := pointer(aviFileHandle.Opts.lpParms);
    debugmemo.lines.add('IsBadReadPtr = '+IntToStr(longint(IsBadReadPtr(p, aviFileHandle.Opts.cbParms))));
  end;

  Error := AVIStreamSetFormat(aviFileHandle.psCompressed,0,@aviFileHandle.m_BiH, sizeof(aviFileHandle.m_BiH));
  if Error <> 0 then
  begin
    showmessage('AVIStreamSetFormat failed');
    result := false;
    exit;
  end;

  result := true;
end;

{*****************************************************************************}
{*                                                                           *}
{* AVIWriterPutFrame                                                         *}
{* -----------------                                                         *}
{*                                                                           *}
{*****************************************************************************}

function AVIWriterPutFrame(var aviFileHandle: TAVIFileHandle; i: longword): boolean;
begin
  if AVIStreamWrite(aviFileHandle.psCompressed,
                    i,
                    1,
                    aviFileHandle.FrameBmp.ScanLine[aviFileHandle.FrameBmp.height-1],
                    aviFileHandle.FrameSize,
                    AVIIF_KEYFRAME,
                    nil,
                    nil) <> 0 then
  begin
    ShowMessage('Error during Write AVI File');
    result := false;
    exit;
  end;

  result := true;
end;

{*****************************************************************************}
{*                                                                           *}
{* AVIWriterCloseAVI                                                         *}
{* -----------------                                                         *}
{*                                                                           *}
{*****************************************************************************}

function AVIWriterCloseAVI(var aviFileHandle: TAVIFileHandle): boolean;
begin
  AVIStreamRelease(aviFileHandle.ps);
  AVIStreamRelease(aviFileHandle.psCompressed);
  AVIFileRelease(aviFileHandle.pFile);

  result := true;
end;

initialization

  AVIReaderWriter.debugmemo := nil;

end.