BMP2AVI将BMP图象内容写入到AVI文件中去

BMP2AVI将BMP图象内 容写入到AVI文件中去

http://www.hackchina.com/r/132069/BMP2AVI.txt__html

我收集网络中的一段代码,相信这段代码对你有用处:
unit avi;

interface
uses
  Windows,  SysUtils,   Graphics, Dialogs ,
  {$ifdef VER90}
  ole2;
{$else}
  ActiveX;
{$endif}
type
  TAVIStreamInfoA = record
    fccType,
    fccHandler,
    dwFlags,        // Contains AVITF_* flags
    dwCaps: DWORD;
    wPriority,
    wLanguage: WORD;
    dwScale,
    dwRate, // dwRate / dwScale == samples/second
    dwStart,
    dwLength, // In units above...
    dwInitialFrames,
    dwSuggestedBufferSize,
    dwQuality,
    dwSampleSize: DWORD;
    rcFrame: TRect;
    dwEditCount,
    dwFormatChangeCount: DWORD;
    szName:  array[0..63] of AnsiChar;
  end;

  TAVIStreamInfo = TAVIStreamInfoA;
  PAVIStreamInfo = ^TAVIStreamInfo;
  TAVISaveCallback = function (nPercent: integer): LONGint; stdcall;
  function AVIFileOpen(var ppfile: pointer; szFile: PChar; uMode: UINT; lpHandler: pointer): HResult; stdcall;
  procedure AVIFileInit; stdcall;
  procedure AVIFileExit; stdcall;
  function AVIFileCreateStream(pfile: pointer; var ppavi: pointer; var psi: TAVIStreamInfo): HResult; stdcall;
  function AVIStreamSetFormat(pavi: pointer; lPos: LONGint; lpFormat: pointer; cbFormat: LONGint): HResult; stdcall;
  function AVIStreamWrite(pavi: pointer; lStart, lSamples: LONGint; lpBuffer: pointer; cbBuffer: LONGint; dwFlags: DWORD; var plSampWritten: LONGint; var plBytesWritten: LONGint): HResult; stdcall;
  function AVIStreamRelease(pavi: pointer): ULONG; stdcall;
  function AVIFileRelease(pfile: pointer): ULONG; stdcall;
  function CreateEditableStream(var ppsEditable: pointer; psSource: pointer): HResult; stdcall;
  procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
     var ImageSize: longInt; PixelFormat: TPixelFormat);
  procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader;
            PixelFormat: TPixelFormat);
  function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal;
  function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
           var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean;
  function uf_createavi(as_bmppath,as_avifile:string;ai_rate,ai_maxbmp:integer;ap_pxf:tPixelFormat):boolean;

  const
  streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
  AVIIF_KEYFRAME  = $10;
implementation
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream; external 'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamSetFormat; external 'avifil32.dll' name 'AVIStreamSetFormat';
function AVIStreamWrite; external 'avifil32.dll' name 'AVIStreamWrite';
function AVIStreamRelease; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease; external 'avifil32.dll' name 'AVIFileRelease';
function CreateEditableStream; external 'avifil32.dll' name 'CreateEditableStream';
function  uf_createavi(as_bmppath,as_avifile:string;ai_rate,ai_maxbmp:integer;ap_pxf:tPixelFormat):boolean;
var
  pFile  ,pStream ,BitmapBits,VideoStream : pointer;
  StreamInfo    : TAVIStreamInfo;
  BitmapInfo    : PBitmapInfoHeader;
  BitmapInfoSize,i  : Integer;
  BitmapSize ,Dummy  : longInt;
  HasLocalPalette  : boolean;
  bmp                   :tbitmap;
begin
  result:=false;
  AVIFileInit;
  try
    if (AVIFileOpen(pFile, PChar(as_avifile), OF_WRITE or OF_CREATE OR OF_SHARE_EXCLUSIVE, nil) <> 0) then
        raise Exception.Create('创建avi文件失败');
    bmp:=tbitmap.Create;
    bmp.LoadFromFile(as_bmppath+'0.bmp');
    InternalGetDIBSizes(bmp.Handle, BitmapInfoSize, BitmapSize, ap_pxf);
    if (BitmapInfoSize = 0) then
            raise Exception.Create('取图象信息失败');
    FillChar(StreamInfo, sizeof(StreamInfo), 0);
    StreamInfo.fccType := streamtypeVIDEO;
    StreamInfo.fccHandler := 0;
    StreamInfo.dwFlags := 0;
    StreamInfo.dwSuggestedBufferSize := BitmapSize;
    StreamInfo.rcFrame.Right := bmp.Width;
    StreamInfo.rcFrame.Bottom := bmp.Height;
    StreamInfo.dwScale := 1;
    StreamInfo.dwRate := ai_rate;

    if (AVIFileCreateStream(pFile, pStream, StreamInfo) <> 0) then
       raise Exception.Create('创建avi流失败');

    BitmapInfo := nil;
    BitmapBits := nil;
    // Get DIB header and pixel buffers
    GetMem(BitmapInfo, BitmapInfoSize);
    GetMem(BitmapBits, BitmapSize);
    InternalGetDIB(bmp.Handle, 0, BitmapInfo^, BitmapBits^, ap_pxf);
    if (AVIStreamSetFormat(pStream, 0, BitmapInfo, BitmapInfoSize) <> 0) then
       raise Exception.Create('设置avi流格式失败');

    for i := 0 to ai_maxbmp-1 do
    begin
       bmp.LoadFromFile(as_bmppath+inttostr(i)+'.bmp');
       InternalGetDIB(bmp.Handle, 0, BitmapInfo^, BitmapBits^, ap_pxf);
       if AVIStreamWrite(pStream, i, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME, Dummy, Dummy) <>0 then
          raise Exception.Create('添加帧到avi文件失败');
    end;
    result:=true;
  finally
    if (BitmapInfo <> nil) then
     FreeMem(BitmapInfo);
    if (BitmapBits <> nil) then
     FreeMem(BitmapBits);
    AVIStreamRelease(pStream);
    AVIFileRelease(pFile);
    AVIFileExit;
  end;
end;
function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
  var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean;
// From graphics.pas, "optimized" for our use
var
  OldPal  : HPALETTE;
  DC    : HDC;
begin
  InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), PixelFormat);
  OldPal := 0;
  DC := CreateCompatibleDC(0);
  try
    if (Palette <> 0) then
    begin
      OldPal := SelectPalette(DC, Palette, False);
      RealizePalette(DC);
    end;
    Result := (GetDIBits(DC, Bitmap, 0, abs(TBitmapInfoHeader(BitmapInfo).biHeight),
      @Bits, TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0);
  finally
    if (OldPal <> 0) then
      SelectPalette(DC, OldPal, False);
    DeleteDC(DC);
  end;
end;
procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
  var ImageSize: longInt; PixelFormat: TPixelFormat);
// From graphics.pas, "optimized" for our use
var
  Info    : TBitmapInfoHeader;
begin
  InitializeBitmapInfoHeader(Bitmap, Info, PixelFormat);
  // Check for palette device format
  if (Info.biBitCount > 8) then
  begin
    // Header but no palette
    InfoHeaderSize := SizeOf(TBitmapInfoHeader);
    if ((Info.biCompression and BI_BITFIELDS) <> 0) then
      Inc(InfoHeaderSize, 12);
  end else
    // Header and palette
    InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl Info.biBitCount);
  ImageSize := Info.biSizeImage;
end;
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader;
  PixelFormat: TPixelFormat);
// From graphics.pas, "optimized" for our use
var
  DIB    : TDIBSection;
  Bytes    : Integer;
begin
  DIB.dsbmih.biSize := 0;
  Bytes := GetObject(Bitmap, SizeOf(DIB), @DIB);
  if (Bytes = 0) then
    showmessage('出错');

  if (Bytes >= (sizeof(DIB.dsbm) + sizeof(DIB.dsbmih))) and
    (DIB.dsbmih.biSize >= sizeof(DIB.dsbmih)) then
    Info := DIB.dsbmih
  else
  begin
    FillChar(Info, sizeof(Info), 0);
    with Info, DIB.dsbm do
    begin
      biSize := SizeOf(Info);
      biWidth := bmWidth;
      biHeight := bmHeight;
    end;
  end;
  case PixelFormat of
    pf1bit: Info.biBitCount := 1;
    pf4bit: Info.biBitCount := 4;
    pf8bit: Info.biBitCount := 8;
    pf15bit: Info.biBitCount := 15;
    pf16bit: Info.biBitCount := 16;
    pf24bit: Info.biBitCount := 24;
  else
        showmessage('出错');
    // Info.biBitCount := DIB.dsbm.bmBitsPixel * DIB.dsbm.bmPlanes;
  end;
  Info.biPlanes := 1;
  Info.biCompression := BI_RGB; // Always return data in RGB format
  Info.biSizeImage := AlignBit(Info.biWidth, Info.biBitCount, 32) * Cardinal(abs(Info.biHeight));
end;
function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal;
begin
  Dec(Alignment);
  Result := ((Bits * BitsPerPixel) + Alignment) and not Alignment;
  Result := Result SHR 3;
end;
end.