Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "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
1-1105960029
sasha-bumer
2005-01-17 14:07
2005.01.30
Flash


1-1106072354
W_h_i_t_e_
2005-01-18 21:19
2005.01.30
.txt в .Res


1-1105791814
L.E.E.
2005-01-15 15:23
2005.01.30
Карта города с объектами - домами?


3-1103878034
Aleks
2004-12-24 11:47
2005.01.30
Загрузка Blob в параметр TADOQuery


14-1105217802
pika
2005-01-08 23:56
2005.01.30
Уходя хотел, спросить !!!





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский