首页  编辑  

连续BMP转换AVI

Tags: /超级猛料/Multi-Media.多媒体相关/   Date Created:

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.