Форум: "Media";
Текущий архив: 2005.01.30;
Скачать: [xml.tar.bz2];
ВнизBitmaps to AVI Найти похожие ветки
← →
Ozone © (2004-10-21 14:19) [0]Много химичил с sabj"ем, но все-равно получается с БОЛЬШИМ косяком. Решил написать сюда, может кто поможет советом.
(использовал как образец исходники TAviWriter).
Сама процедура записи в (VideoStream: IAVIStream)
var
pFile : IAVIFile;
StreamInfo : TAVIStreamInfo;
pStream : IAVIStream;
BitmapInfo : PBITMAPINFOHEADER;
BitmapInfoSize : DWORD;
BitmapSize : DWORD;
BitmapBits : pointer;
Bitmap : TBitmap;
AVIERR : integer;
i : integer;
{/*----------------------------------------------------*/}
if (AVIFileOpen(pFile, pChar("~temp.avi"), OF_CREATE OR OF_WRITE , nil)<> AVIERR_OK) then
raise Exception.Create("Failed to create AVI video work file");
Bitmap := TBitmap.create;
Bitmap.Height := FWidth;
Bitmap.Width := FHeight;
try
FillChar(StreamInfo, sizeof(StreamInfo), 0);
StreamInfo.dwRate := FRate;
StreamInfo.dwScale := FScale;
StreamInfo.fccType := streamtypeVIDEO;
StreamInfo.fccHandler := 0;
StreamInfo.dwFlags := 0;
StreamInfo.dwSuggestedBufferSize := 0;
StreamInfo.rcFrame.Left := 0;
// ширина Bitmap из Images (см. ниже)
StreamInfo.rcFrame.Right := FWidth;
StreamInfo.rcFrame.Top := 0;
// высота Bitmap из Images (см. ниже)
StreamInfo.rcFrame.Bottom := FHeight;
if (AVIFileCreateStream(pFile, pStream, StreamInfo) <> AVIERR_OK) then
raise Exception.Create("Failed to create AVI video stream");
try
// Images - динамич массив Bitmap"ов
for i:=0 to High(Images) do begin
try
Bitmap.Canvas.StretchDraw(Rect(0,0,FWidth,FHeight),Images[i]);
InternalGetDIBSizes(Bitmap.Handle, BitmapInfoSize, BitmapSize, 0);
if (BitmapInfoSize = 0) then
raise Exception.Create("Failed to retrieve bitmap info");
GetMem(BitmapInfo, BitmapInfoSize);
GetMem(BitmapBits, BitmapSize);
InternalGetDIB(Bitmap.Handle, 0, BitmapInfo^, BitmapBits^, 0);
if i = 0 then
if (AVIStreamSetFormat(pStream, 0, BitmapInfo, BitmapInfoSize) <> AVIERR_OK) then
raise Exception.Create("Failed to set AVI stream format");
AVIERR := AVIStreamWrite(pStream, i, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME, nil, nil);
if AVIERR <> AVIERR_OK then
raise Exception.Create("Failed to add frame to AVI. Err="+ inttohex(AVIERR,8));
finally
if (BitmapInfo <> nil) then FreeMem(BitmapInfo);
if (BitmapBits <> nil) then FreeMem(BitmapBits);
end;
end;
if CreateEditableStream(VideoStream,pStream) <> AVIERR_OK then
raise Exception.Create("Could not create Video Stream");
finally
pStream := nil;
end;
finally
BitMap.Free;
end;
Ну и потом собственно в AVI:
var
Streams : APAVISTREAM;
plpOptions : APAVICompressOptions;
AVIERR : integer;
nStream : integer;
begin
nStream := 1;
Streams[0] := VideoStream;
plpOptions[0] := nil;
try
AVIERR := AVISaveA(PChar(FileName),
nil,
nil,
nStream,
Streams,
plpOptions);
if AVIERR <> AVIERR_OK then
raise Exception.Create("Unable to write output file");
finally
if assigned(VideoStream) then
VideoStream := nil;
end;
DeleteFile("~temp.avi");
где InternalGetDIBSizes, InternalGetDIB, InitializeBitmapInfoHeader (Graphics.pas) тоже переделаны (код приведу ниже).
Дык вот, проблема в том, что загоняю файл вида http://www.test-mbit.narod.ru/old.JPG, а получаю http://www.test-mbit.narod.ru/new.JPG. Вы можете сказать что я указываю при "вшивании" не те размеры. Нет, это не так (проверено debugger"ом). Если бы даже это было так - там же стоит StretchDraw!!!
Вобщем незнаю куды копать. Поможите.
← →
Ozone © (2004-10-21 14:22) [1]Вот обещанные процедуры:
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader;
PixelFormat: TPixelFormat);
// From graphics.pas, "optimized" for our use
var
DIB : TDIBSection;
Bytes : Integer;
function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal;
begin
Dec(Alignment);
Result := ((Bits * BitsPerPixel) + Alignment) and not Alignment;
Result := Result SHL 3;
end;
begin
DIB.dsbmih.biSize := 0;
Bytes := GetObject(Bitmap, SizeOf(DIB), @DIB);
if (Bytes = 0) then
raise Exception.Create("Invalid bitmap");
// Error(sInvalidBitmap);
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;
pf24bit: Info.biBitCount := 24;
else
// Error(sInvalidPixelFormat);
raise Exception.Create("Invalid pixel foramt");
// 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 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;
Писал разработчикам, сказали что не имеют понятия почему получается такой баг.
← →
Ozone © (2004-10-21 15:58) [2]ЗЫ: размеры у выходного AVI рамерам перевернутого Bitmap"a, который вставляли...
← →
Pavia (2004-10-21 17:33) [3]Bitmap := TBitmap.create;
Bitmap.Height := FWidth;
Bitmap.Width := FHeight;
???
← →
Ozone © (2004-10-22 02:01) [4]Pavia (21.10.04 17:33) [3]
Ёб... тв... мат... Спасибо!!! Вот дурак! Неделю голову ломал!
Страницы: 1 вся ветка
Форум: "Media";
Текущий архив: 2005.01.30;
Скачать: [xml.tar.bz2];
Память: 0.47 MB
Время: 0.05 c