Шустрый
Профиль
Группа: Участник
Сообщений: 85
Регистрация: 26.4.2007
Репутация: нет
Всего: нет
|
Приветствую всех обитателей форума! Делаю следующее: есть 251 bmp картинка 32 бит на пиксель. Эти картинки являются кадрами. Нужно из них собрать видеофайл avi. Выполнил двумя способами: 1) | Код |
procedure BuildAvi(List:TStringList; FileName:string);
var
i: Integer;
pfile: PAVIFile;
asi: TAVIStreamInfo;
ps: PAVIStream;
nul: Longint;
BitmapInfo: PBitmapInfoHeader;
BitmapInfoSize: Integer;
BitmapBits: Pointer;
BitmapSize: Integer;
begin
AVIFileInit;
DeleteFile(FileName);
if AVIFileOpen(pfile, PChar(FileName), OF_WRITE or OF_CREATE, nil)=AVIERR_OK then
begin
FillChar(asi,sizeof(asi),0);
asi.fccType := streamtypeVIDEO; // Now prepare the stream
asi.fccHandler := 0;
asi.dwScale := 1;
asi.dwRate :=25;
with List.Objects[0] as TBitmap do
begin
InternalGetDIBSizes(Handle,BitmapInfoSize,dword(BitmapSize),256);
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
InternalGetDIB(Handle,0,BitmapInfo^,BitmapBits^,256);
end;
asi.dwSuggestedBufferSize := BitmapInfo^.biSizeImage;
asi.rcFrame.Right := BitmapInfo^.biWidth;
asi.rcFrame.Bottom := BitmapInfo^.biHeight;
if AVIFileCreateStream(pfile,ps,asi)=AVIERR_OK then
with (List.Objects[0] as TBitmap) do
begin
InternalGetDIB(Handle,0,BitmapInfo^,BitmapBits^,256);
if AVIStreamSetFormat(ps,0,BitmapInfo,BitmapInfoSize)=AVIERR_OK then
begin
for i:=0 to List.Count-1 do
with (List.Objects[i] as TBitmap) do
begin
InternalGetDIB(Handle,0,BitmapInfo^,BitmapBits^,256);
if AVIStreamWrite(ps,i,1,BitmapBits,BitmapSize,AVIIF_KEYFRAME,nul,nul)<>AVIERR_OK then
begin
raise Exception.Create('Could not add frame');
break;
end;
end;
end;
end;
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
end;
AVIStreamRelease(ps);
AVIFileRelease(pfile);
AVIFileExit;
end;
|
с использованием модулей: | Код |
unit Vfw_2;
{ don't know who wrote this - the AVI section for avifil32.dll - Thanks !!!}
interface
uses Windows, IUnk;
type
{ TAVIFileInfoW record }
LONG = Longint;
PVOID = Pointer;
TAVIFileInfoW = record
dwMaxBytesPerSec, // max. transfer rate
dwFlags, // the ever-present flags
dwCaps,
dwStreams,
dwSuggestedBufferSize,
dwWidth,
dwHeight,
dwScale,
dwRate, // dwRate / dwScale == samples/second
dwLength,
dwEditCount: DWORD;
szFileType: array[0..63] of WideChar; // descriptive string for file type?
end;
PAVIFileInfoW = ^TAVIFileInfoW;
{ TAVIStreamInfoA record }
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,
szName: array[0..63] of AnsiChar;
end;
TAVIStreamInfo = TAVIStreamInfoA;
{ TAVIStreamInfoW record }
TAVIStreamInfoW = 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,
szName: array[0..63] of WideChar;
end;
{ IAVIStream interface }
IAVIStream = class(IUnknown)
function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall; abstract;
function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes: LONG; var plSamples: LONG): HResult; virtual; stdcall; abstract;
function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; virtual; stdcall; abstract;
function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual; stdcall; abstract;
function WriteData(fcc: DWORD; lp: PVOID; cb: LONG): HResult; virtual; stdcall; abstract;
function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIStream = ^IAVIStream;
{ IAVIFile interface }
IAVIFile = class(IUnknown)
function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW): HResult; virtual; stdcall; abstract;
function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; virtual; stdcall; abstract;
function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; virtual; stdcall; abstract;
function EndRecord: HResult; virtual; stdcall; abstract;
function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIFile = ^IAVIFile;
procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; stdcall;
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVISTREAM; var psi: TAVIStreamInfoA): HResult; stdcall;
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; stdcall;
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; stdcall;
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;
const
AVIERR_OK = 0;
AVIIF_LIST = $01;
AVIIF_TWOCC = $02;
AVIIF_KEYFRAME = $10;
streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
{ AVI interface IDs }
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));
{ AVI class IDs }
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));
implementation
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID): HResult; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVIStream; var psi: TAVIStreamInfoA): HResult; external 'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; external 'avifil32.dll' name 'AVIStreamSetFormat';
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; external 'avifil32.dll' name 'AVIStreamWrite';
function AVIStreamRelease(pavi: PAVIStream): ULONG; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease(pfile: PAVIFile): ULONG; external 'avifil32.dll' name 'AVIFileRelease';
end.
|
и | Код |
unit DIBitmap;
interface
uses Windows, SysUtils, Classes;
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;
Colors: Integer);
procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
var ImageSize: DWORD; Colors: Integer);
function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
var BitmapInfo; var Bits; Colors: Integer): Boolean;
implementation
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var BI: TBitmapInfoHeader;
Colors: Integer);
var
BM: Windows.TBitmap;
begin
GetObject(Bitmap, SizeOf(BM), @BM);
with BI do
begin
biSize := SizeOf(BI);
biWidth := BM.bmWidth;
biHeight := BM.bmHeight;
if Colors <> 0 then
case Colors of
2: biBitCount := 1;
16: biBitCount := 4;
256: biBitCount := 8;
end
else biBitCount := BM.bmBitsPixel * BM.bmPlanes;
biPlanes := 1;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
if biBitCount>8 then biClrUsed := 0 else biClrUsed := Colors;
biClrImportant := 0;
biCompression := BI_RGB;
if biBitCount in [16, 32] then biBitCount := 24;
biSizeImage := (((biWidth * biBitCount) + 31) div 32) * 4 * biHeight;
end;
end;
procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
var ImageSize: DWORD; Colors: Integer);
var
BI: TBitmapInfoHeader;
begin
InitializeBitmapInfoHeader(Bitmap, BI, Colors);
with BI do
begin
case biBitCount of
24: InfoHeaderSize := SizeOf(TBitmapInfoHeader);
else
InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) *
(1 shl biBitCount);
end;
end;
ImageSize := BI.biSizeImage;
end;
function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
var BitmapInfo; var Bits; Colors: Integer): Boolean;
var
OldPal: HPALETTE;
Focus: HWND;
DC: HDC;
begin
InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), Colors);
OldPal := 0;
Focus := GetFocus;
DC := GetDC(Focus);
try
if Palette <> 0 then
begin
OldPal := SelectPalette(DC, Palette, False);
RealizePalette(DC);
end;
Result := GetDIBits(DC, Bitmap, 0, TBitmapInfoHeader(BitmapInfo).biHeight, @Bits,
TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0;
finally
if OldPal <> 0 then SelectPalette(DC, OldPal, False);
ReleaseDC(Focus, DC);
end;
end;
end.
|
2) | Код |
procedure CreateAVI(const FileName: string; IList: TStringList;
FramesPerSec: integer);
var
Opts: AVI_COMPRESS_OPTIONS;
pOpts: Pointer;
pFile, ps, psCompressed: DWORD;
strhdr: AVI_STREAM_INFO;
i: integer;
BFile: file;
m_Bih: BITMAPINFOHEADER;
m_Bfh: BITMAPFILEHEADER;
m_MemBits: packed array of byte;
m_MemBitMapInfo: packed array of byte;
begin
DeleteFile(PChar(FileName));
Fillchar(Opts, SizeOf(Opts), 0);
FillChar(strhdr, SizeOf(strhdr), 0);
Opts.fccHandler := 541215044; // Full frames Uncompressed
AVIFileInit;
pfile := 0;
pOpts := @Opts;
if AVIFileOpen(@pFile, PChar(FileName), OF_WRITE or OF_CREATE, 0) = 0 then
begin
// Determine Bitmap Properties from file item[0] in list
AssignFile(BFile, IList[0]);
{$I-}
Reset(BFile, 1);
if IOresult = 0 then
try
BlockRead(BFile, m_Bfh, SizeOf(m_Bfh));
BlockRead(BFile, m_Bih, SizeOf(m_Bih));
SetLength(m_MemBitMapInfo, m_bfh.bfOffBits - 14);
SetLength(m_MemBits, m_Bih.biSizeImage);
Seek(BFile, SizeOf(m_Bfh));
BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo));
finally
CloseFile(BFile);
end;
{$I+}
strhdr.fccType := mmioStringToFOURCCA('vids', 0); // stream type video
strhdr.fccHandler := 0; // def AVI handler
strhdr.dwScale := 1;
strhdr.dwRate := FramesPerSec; // fps 1 to 30
strhdr.dwSuggestedBufferSize := m_Bih.biSizeImage; // size of 1 frame
SetRect(strhdr.rcFrame, 0, 0, m_Bih.biWidth, m_Bih.biHeight);
if AVIFileCreateStream(pFile, @ps, @strhdr) = 0 then
begin
// if you want user selection options then call following line
// (but seems to only like "Full frames Uncompressed option)
// AVISaveOptions(Application.Handle,
// ICMF_CHOOSE_KEYFRAME or ICMF_CHOOSE_DATARATE,
// 1,@ps,@pOpts);
// AVISaveOptionsFree(1,@pOpts);
if AVIMakeCompressedStream(@psCompressed, ps, @opts, 0) = 0 then
begin
if AVIStreamSetFormat(psCompressed, 0, @m_memBitmapInfo[0],
length(m_MemBitMapInfo)) = 0 then
begin
for i := 0 to IList.Count - 1 do
begin
AssignFile(BFile, IList[i]);
{$I-}
Reset(BFile, 1);
if IOresult = 0 then
try
Seek(BFile, m_bfh.bfOffBits);
BlockRead(BFile, m_MemBits[0], m_Bih.biSizeImage);
Seek(BFile, SizeOf(m_Bfh));
BlockRead(BFile, m_MemBitMapInfo[0], length(m_MemBitMapInfo));
finally
CloseFile(BFile);
end;
{$I+}
if AVIStreamWrite(psCompressed, i, 1, @m_MemBits[0],
m_Bih.biSizeImage, AVIIF_KEYFRAME, 0, 0) <> 0 then
begin
//ShowMessage('Error during Write AVI File');
break;
end;
end;
end;
end;
end;
AVIStreamRelease(ps);
AVIStreamRelease(psCompressed);
AVIFileRelease(pFile);
end;
AVIFileExit;
m_MemBitMapInfo := nil;
m_memBits := nil;
end;
|
с использованием модуля: | Код |
unit Data;
interface
uses Types;
const
// AVISaveOptions Dialog box flags
ICMF_CHOOSE_KEYFRAME = 1;
ICMF_CHOOSE_DATARATE = 2;
ICMF_CHOOSE_PREVIEW = 4;
ICMF_CHOOSE_ALLCOMPRESSORS = 8;
// can handle the input format
// or input data
AVIIF_KEYFRAME = 10;
type
AVI_COMPRESS_OPTIONS = packed record
fccType: DWORD; // stream type, for consistency
fccHandler: DWORD; // compressor
dwKeyFrameEvery: DWORD; // keyframe rate
dwQuality: DWORD; // compress quality 0-10,000
dwBytesPerSecond: DWORD; // bytes per second
dwFlags: DWORD; // flags... see below
lpFormat: DWORD; // save format
cbFormat: DWORD;
lpParms: DWORD; // compressor options
cbParms: DWORD;
dwInterleaveEvery: DWORD; // for non-video streams only
end;
AVI_STREAM_INFO = 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 char;
end;
BITMAPINFOHEADER = packed record
biSize: DWORD;
biWidth: DWORD;
biHeight: DWORD;
biPlanes: word;
biBitCount: word;
biCompression: DWORD;
biSizeImage: DWORD;
biXPelsPerMeter: DWORD;
biYPelsPerMeter: DWORD;
biClrUsed: DWORD;
biClrImportant: DWORD;
end;
BITMAPFILEHEADER = packed record
bfType: word; //"magic cookie" - must be "BM"
bfSize: integer;
bfReserved1: word;
bfReserved2: word;
bfOffBits: integer;
end;
// DLL External declarations
function AVISaveOptions(Hwnd: DWORD; uiFlags: DWORD; nStreams: DWORD;
pPavi: Pointer; plpOptions: Pointer): boolean;
stdcall; external 'avifil32.dll';
function AVIFileCreateStream(pFile: DWORD; pPavi: Pointer; pSi: Pointer): integer;
stdcall; external 'avifil32.dll';
function AVIFileOpen(pPfile: Pointer; szFile: PChar; uMode: DWORD;
clSid: DWORD): integer;
stdcall; external 'avifil32.dll';
function AVIMakeCompressedStream(psCompressed: Pointer; psSource: DWORD;
lpOptions: Pointer; pclsidHandler: DWORD): integer;
stdcall; external 'avifil32.dll';
function AVIStreamSetFormat(pAvi: DWORD; lPos: DWORD; lpGormat: Pointer;
cbFormat: DWORD): integer;
stdcall; external 'avifil32.dll';
function AVIStreamWrite(pAvi: DWORD; lStart: DWORD; lSamples: DWORD;
lBuffer: Pointer; cBuffer: DWORD; dwFlags: DWORD;
plSampWritten: DWORD; plBytesWritten: DWORD): integer;
stdcall; external 'avifil32.dll';
function AVISaveOptionsFree(nStreams: DWORD; ppOptions: Pointer): integer;
stdcall; external 'avifil32.dll';
function AVIFileRelease(pFile: DWORD): integer; stdcall; external 'avifil32.dll';
procedure AVIFileInit; stdcall; external 'avifil32.dll';
procedure AVIFileExit; stdcall; external 'avifil32.dll';
function AVIStreamRelease(pAvi: DWORD): integer; stdcall; external 'avifil32.dll';
function mmioStringToFOURCCA(sz: PChar; uFlags: DWORD): integer;
stdcall; external 'winmm.dll';
implementation
end.
|
А проблема в следующем: В первом способе видео собирается нормально, за исключением цветового набора(цвета не соответствуют картинкам). А во втором случае, не получается собрать его 25кадр/сек(получается что-то типа анимации) Буду признателен за любую помощь! |
Проблема со сборкой avi 
Загрузка ...
avi_work.rar 26,79 Kb
