avi.pas

基于DELPHI的图片浏览系统设计与实现

unit AVI;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,shellapi,mmsystem;



type
  PAVIStream = type Pointer;
  PAVIFile = type Pointer;

  TAVIStreamInfo = packed record
    fccType: DWORD;
    fccHandler: DWORD;
    dwFlags: DWORD;
    dwCaps: DWORD;
    wPriority: Word;
    wLanguage: Word;
    dwScale: DWORD;
    dwRate: DWORD;
    dwStart: DWORD;
    dwLength: DWORD;
    dwInitialFrames: DWORD;
    dwSuggestedBufferSize: DWORD;
    dwQuality: DWORD;
    dwSampleSize: DWORD;
    rcFrame: TRect;
    dwEditCount: DWORD;
    dwFormatChangeCount: DWORD;
    szName: array [0..63] of AnsiChar;
  end;
  PAVIStreamInfo = ^TAVIStreamInfo;

  TAVICompressOptions = packed record
    fccType: DWORD;
    fccHandler: DWORD;
    dwKeyFrameEvery: DWORD;
    dwQuality: DWORD;
    dwBytesPerSecond: DWORD;
    dwFlags: DWORD;
    lpFormat: Pointer;
    cbFormat: DWORD;
    lpParms: Pointer;
    cbParms: DWORD;
    dwInterleaveEvery: DWORD;
  end;
  PAVICompressOptions = ^TAVICompressOptions;

  TAVIFile = class(TObject)
  private
    FAVIFile: PAVIFile;
    FAVIStreamInfo: TAVIStreamInfo;
    FAVIUncompressedStream: PAVIStream;
    FAVICompressedStream: PAVIStream;
    FAVIOutputStream: PAVIStream;
    FBitmapInfoSize: Integer;
    FBitmapSize: DWORD;
    FBitmapInfo: PBitmapInfoHeader;
    FBitmapBits: Pointer;
    FAVICompressOptions: TAVICompressOptions;
    FFileName: string;
    FIndex: Integer;
  public
    constructor Create(const AFileName: string; const AInterval: Double; const ASampleBitmap: HBITMAP);
    destructor Destroy; override;
    procedure AddBitmap(Bitmap: HBITMAP);
  end;

type
  EAVIFileError = class(Exception);

const
  streamtypeVIDEO = $73646976;//FourCC('vids')

  Codec = 'MRLE';//change this if you want to use a different codec

  AVIERR_OK          = $00000000;
  AVIIF_LIST         = $00000001;
  AVIIF_TWOCC          = $00000002;
  AVIIF_KEYFRAME     = $00000010;
  AVICOMPRESSF_VALID = $00000008;

  IID_IAVIFile: TGUID = (D1:$00020020;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIStream: TGUID = (D1:$00020021;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIStreaming: TGUID = (D1:$00020022;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IGetFrame: TGUID = (D1:$00020023;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIEditStream: TGUID = (D1:$00020024;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  CLSID_AVISimpleUnMarshal: TGUID = (D1:$00020009;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  CLSID_AVIFile: TGUID = (D1:$00020000;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));

procedure AVIFileInit; stdcall; external 'avifil32.dll';
procedure AVIFileExit; stdcall; external 'avifil32.dll';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PGUID): HResult; stdcall; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVIStream; psi: PAVIStreamInfo): HResult; stdcall; external 'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIMakeCompressedStream(var ppsCompressed: PAVIStream; psSource: PAVIStream; const lpOptions: TAVICompressOptions; pclsid: PGUID): HResult; stdcall; external 'avifil32.dll';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: Integer; lpFormat: Pointer; cbFormat: Integer): HResult; stdcall; external 'avifil32.dll';
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: Integer; lpBuffer: Pointer; cbBuffer: Integer; dwFlags: DWORD; plSampWritten: PLongint; plBytesWritten: PLongint): HResult; stdcall; external 'avifil32.dll';
function AVIStreamRelease(pavi: PAVIStream): ULONG; stdcall; external 'avifil32.dll';
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall; external 'avifil32.dll';


implementation

procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader);
var
BM: Windows.TBitmap;
begin
GetObject(Bitmap, SizeOf(BM), @BM);
  with BI do begin
    biSize := SizeOf(BI);
    biWidth := BM.bmWidth;
    biHeight := BM.bmHeight;
    biBitCount := 8;
    biPlanes := 1;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed := 256;
    biClrImportant := 0;
    biCompression := BI_RGB;
    biSizeImage := ((8*biWidth + 31) div 32) * 4 * biHeight;
  end;
end; (* InitializeBitmapInfoHeader *)

procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer; var ImageSize: DWORD);
var BI: TBitmapInfoHeader;
begin
  InitializeBitmapInfoHeader(Bitmap, BI);
  with BI do begin
    InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * 256;
  end;
  ImageSize := BI.biSizeImage;
end; (* InternalGetDIBSizes *)

function InternalGetDIB(Bitmap: HBITMAP; var BitmapInfo; var Bits): Boolean;
var
  Focus: HWND;
  DC: HDC;
begin
  InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo));
  Focus := GetFocus;
  DC := GetDC(Focus);
  try
    Result := GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits, TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0;
    TBitmapInfoHeader(BitmapInfo).biClrUsed := 256;//GetDIBits screws this up
  finally
    ReleaseDC(Focus, DC);
  end;
end; (* InternalGetDIB *)

{ TAVIFile }

const
  SCouldNotCreateError = 'Could not create AVI File ''%s''.  This may be because the file is being used by another program.';
  SStreamCreateError = 'Could not create AVI stream.';
  SFormatError = 'Could not set AVI stream format.';
  SAddFrameError = 'Could not add frame.  This may be because there is not enough disk space for the AVI file.';

constructor TAVIFile.Create(const AFileName: string; const AInterval: Double; const ASampleBitmap: HBITMAP);

  function SetStreamFormat: Boolean;
  begin
    Result := AVIStreamSetFormat(FAVIOutputStream, 0, FBitmapInfo, FBitmapInfoSize)=AVIERR_OK;
  end; (* SetStreamFormatOK *)

begin
  inherited Create;
  FFileName := AFileName;
  AVIFileInit;

  if FileExists(PChar(FFileName)) then begin
    //delete file if already in existence - need to do this for compression to work!!
    if not DeleteFile(PChar(FFileName)) then begin
      raise EAVIFileError.CreateFmt(SCouldNotCreateError, [FFileName]);
    end;
  end;

  if AVIFileOpen(FAVIFile, PChar(FFileName), OF_WRITE or OF_CREATE, nil)<>AVIERR_OK then begin
    raise EAVIFileError.CreateFmt(SCouldNotCreateError, [FFileName]);
  end;

  //FAVIStreamInfo has been zeroised by the constructor
  FAVIStreamInfo.fccType := streamtypeVIDEO;
  if AInterval>1000.0 then begin
    FAVIStreamInfo.dwScale := Round(AInterval);
    FAVIStreamInfo.dwRate := 1;
  end else if AInterval>1.0 then begin
    FAVIStreamInfo.dwScale := Round(1000.0*AInterval);
    FAVIStreamInfo.dwRate := 1000;
  end else if AInterval>0.001 then begin
    FAVIStreamInfo.dwScale := 1000;
    FAVIStreamInfo.dwRate := Round(1000.0/AInterval);
  end else begin
    FAVIStreamInfo.dwScale := 1;
    FAVIStreamInfo.dwRate := Round(1.0/AInterval);
  end;

  InternalGetDIBSizes(ASampleBitmap, FBitmapInfoSize, FBitmapSize);
  FBitmapInfo := AllocMem(FBitmapInfoSize);
  FBitmapBits := AllocMem(FBitmapSize);
  InternalGetDIB(ASampleBitmap, FBitmapInfo^, FBitmapBits^);

  FAVIStreamInfo.dwSampleSize := FBitmapSize;
  FAVIStreamInfo.rcFrame.Right := FBitmapInfo.biWidth;
  FAVIStreamInfo.rcFrame.Bottom := FBitmapInfo.biHeight;

  if AVIFileCreateStream(FAVIFile, FAVIUncompressedStream, @FAVIStreamInfo)<>AVIERR_OK then begin
    raise EAVIFileError.Create(SStreamCreateError);
  end;

  FAVICompressOptions.fccType := streamtypeVIDEO;
  FAVICompressOptions.fccHandler := mmioStringToFOURCC(Codec, 0);
  FAVICompressOptions.dwQuality := 10000;

  if AVIMakeCompressedStream(FAVICompressedStream, FAVIUncompressedStream, FAVICompressOptions, nil)=AVIERR_OK then begin
    //try compressed stream
    FAVIOutputStream := FAVICompressedStream;
    if SetStreamFormat then begin exit; end;
  end;

  FAVIOutputStream := FAVIUncompressedStream;
  if not SetStreamFormat then begin raise EAVIFileError.Create(SFormatError); end;
end; (* TAVIFile.Create *)

destructor TAVIFile.Destroy;
begin
  if Assigned(FAVICompressedStream) then begin AVIStreamRelease(FAVICompressedStream); end;
  if Assigned(FAVIUncompressedStream) then begin AVIStreamRelease(FAVIUncompressedStream); end;
  FreeMem(FBitmapBits);
  FreeMem(FBitmapInfo);
  if Assigned(FAVIFile) then begin AVIFileRelease(FAVIFile); end;
  AVIFileExit;
  inherited Destroy;
end; (* TAVIFile.Destroy *)

procedure TAVIFile.AddBitmap(Bitmap: HBITMAP);
begin
  InternalGetDIB(Bitmap, FBitmapInfo^, FBitmapBits^);
  if AVIStreamWrite(FAVIOutputStream, FIndex, 1, FBitmapBits, FBitmapSize, AVIIF_KEYFRAME, nil, nil)<>AVIERR_OK then begin
    raise EAVIFileError.Create(SAddFrameError);
  end;
  inc(FIndex);
end; (* TAVIFile.AddBitmap *)
end.