img
00:00
imgDRKB online - BMP ---> AVI (для TAnimate)
imgimgimg
  Общие вопросы
  Delphi IDE, компиллятор, отладчик, редактор
  Язык программирования Дельфи
  VCL
  Системные функции и WinAPI
  Базы данных
  Работа с файловой системой
  Репортинг, работа с принтером
  Работа с сетью, интернетом, протоколами
  Работа с графикой и мультимедиа
  Математика, алгоритмы
  Форматы файлов, данных. Конвертация форматов
  ANSI ---> ASCII
  BMP ---> AVI (для TAnimate)
  BMP ---> EMF
  BMP ---> DIB
  BMP ---> ICO
  BMP ---> JPG
  BMP --> EMF (Enhanced Metafile)
  BMP ---> RTF
  BMP ---> WMF
  CUR ---> BMP
  ICO ---> BMP
  JPG ---> BMP
  TIF ---> PDF
  TXT ---> GIF
  DOC ---> HTML
  WMF ---> BMP
  RTF-->HTML
  HTML --> RTF
  DFM -->TXT, TXT --> DFM
  Win1251 <-> Koi8r
  Как инсталлировать INF файл?
  Как конвертировать WideString в String?
  Как определить графический формат файла (не используя расширение)?
  Как прочитать MP3 ID3-Tag?
  Как прочитать заголовок wav файла?
  Информация о AVI файле (разбор заголовка AVI)
  Как работать с DWG файлами (AutoCAD)?
  Как работать с GIF файлами?
  Как работать с PDF файлами?
  Как разрезать wav файл?
  Как узнать размер картинки для JPG, GIF и PNG файлов?
  Компонент для работы с PCX файлами
  Пример работы чтения и сохранении wav-файлов
  Работа с TGA файлами
  Формат wave файла
  Декомпилляция звукового файла формата Wave и получение звуковых данных
  Flash SWF --> EXE
  Преобразование иконок в Gliph-ы
  Документация на основе RTF-шаблона
  "Дедушка RTF" еще послужит
  ActiveX, COM, DCOM, MIDAS, CORBA, интерфейсы, OLE, DDE
  Разработка приложений
  Kylix
  Delphi.Net
  Развлечения
  
  [drkb=3973] Комментариев: 0 
BMP ---> AVI (для TAnimate)



TAnimate is a rather nice component. However if you don't want to use the built in AVI files and want to create your own AVI files from BMP files, then you may have a problem as there is no tool in Delphi to do this.

While browsing the web for information on AVI file formats I came upon a site www.shrinkwrapvb.com/...help.htm that is maintained by Ray Mercer. In this tutorial he explains how to manipulate,read and write AVI files. I was particularly interested in "Step 5" in which he shows a utility that takes a list of BMP files that creates an AVI file which can be used by the TAnimate component. The only problem was that the examples are in Visual Basic, thus a conversion to Delphi was required.

I have posted this procedure
CreateAVI(const FileName : string; BMPFileList : TStrings; FramesPerSec : integer = 10);

To keep the text of the example simple and readable I have left out most to the error checking (try except etc.). You can also play with the AVISaveOptions dialog box, but I can only seem to get it to work with "Full Frames Uncompressed" with BMP files. Can anyone shed some light on this ?

Errors you should check for are ..
All files are valid BMP files and are of the same size.
All Blockreads are valid with no read errors.

Ray has a downloadable EXE that works quite nicely, however I am about to write my own utility that incorporates the following ...

Multiline file selection.
Listbox line reordering (drag/drop).
Sort File list
Layout Save and Load .
AVI Preview.

(I have beta version 1.0.0.0 ready, if anyone wants a copy of exe or source code, drop me a mail at mheydon@pgbison.co.za)

For further info on AVI files I recommend you vist Ray's site at http://www.shrinkwrap...help.htm it really is a well written tutorial (even if it is in Visual Basic)
delphi
const
  // AVISaveOptions Dialog box flags

  ICMF_CHOOSE_KEYFRAME = 1; // show KeyFrame Every box
  ICMF_CHOOSE_DATARATE = 2; // show DataRate box
  ICMF_CHOOSE_PREVIEW = 4; // allow expanded preview dialog
  ICMF_CHOOSE_ALLCOMPRESSORS = 8; // don't only show those that
  // 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';

// ============================================================================
// Main Function to Create AVI file from BMP file listing
// ============================================================================

procedure CreateAVI(const FileName: string; IList: TStrings;
  FramesPerSec: integer = 10);
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(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]);
    Reset(BFile, 1);
    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));
    CloseFile(BFile);

    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]);
            Reset(BFile, 1);
            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));
            CloseFile(BFile);
            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;


@Drkb::04264
Взято с Delphi Knowledge Base: http://www.baltsoft.com/
Количество статей: 4366
 
Вход
Имя:
Пароль:
Запомнить
Регистрация Забыли пароль?
Мини-чат :)
Необходима регистрация
Архив мини-чата
Вчера, 23:51
admin
Это хоумпейдж, для души, с чего бы ему умирать? К тому же на хостинге другие сервисы подняты, для себя.
Вчера, 22:49
Oleg4260
Мда... тут 2 страницы пролистаешь и уже на год раньше дата сообщения
походу сайт мёртвый. странно, что он до сих пор хостится, и даже админ вчера онлайн утром был.
Вчера, 22:48
Oleg4260
сейчас
Вчера, 22:48
Oleg4260
2019
Вчера, 22:45
Oleg4260
Ого, это сайт 2007 года!
Вчера, 22:43
Oleg4260
Только тут письмо на почту долго приходит
Вчера, 22:43
Oleg4260
А ну регистрируйтесь, быстро! Мне одному скучно.
Вчера, 22:43
Oleg4260
Я вижу на странице 31 гостя и только 1 зарегистрированного пользователя - меня!
Вчера, 22:42
Oleg4260
Всем привет
Вчера, 00:19
Organizm
- Вот сейчас вызову кого следует, узнаете!
- Ну вызывайте, вызывайте!
- Отойдите, пентаграмму чертить мешаете.
Статистика
 СегодняВсего
Посетителей8332134356
Запросов27519325359125
Online
Пользователей0
Гостей43
imgimgimgimg
 
img
     00:00