存储bmp序列为avi的代码在playicq上有。
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-1do
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.dsbmdo
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.
]