delphi - How to convert bitmaps to video? -


my application creates images fractals , love feeling of 'flying' around fractal. once saved 2000 bitmaps file , created avi using premiere. experience rather frustrating though succeeded in creating movie. spectacular. of course want create video application. don't care niftyness of codec, compression or whatever. want have video can replay on systems.

in past have tried never succeeded. triggered question alas not ffmpeg running.

update

i decided adapt question , put bounty it. have seen several solutions attractive (because it's simple) seems me taviwrite. tried taviwriter did not succeed. in procedure taviwriter.write; function call around line 370

  avierr := avisavev(s, //                   pchar(filename),                nil,                    // file handler                nil,                    // callback                nstreams,               // number of streams                streams,                compoptions);           // compress options videostream 

does not return avierr_ok.

update 2

the reason above mentioned error wrong declaration of avisavev, should declared avisavevw tlama pointed out. correct code creating avi filoes form bmp files posted below. original code below downloaded efg example unit.

using delphi xe on windows 7.

unit aviwriter;  ///////////////////////////////////////////////////////////////////////////// //                                                                         // //       aviwriter -- component create rudimentary avi files          // //                  elliott shevin, large pieces of code           // //                  stolen anders melander                            // //       version 1.0. please send comments, suggestions, , advice        // //       shevine@aol.com.                                               // /////////////////////////////////////////////////////////////////////////////  interface  uses   windows,messages, sysutils, classes, graphics, controls, forms, dialogs,   stdctrls, ole2;  //////////////////////////////////////////////////////////////////////////////// //                                                                            // //                      video windows                                     // //                                                                            // //////////////////////////////////////////////////////////////////////////////// //                                                                            // // adapted thomas schimming's vfw.pas                                    // // (c) 1996 thomas schimming, schimmin@iee1.et.tu-dresden.de                  // // (c) 1998,99 anders melander                                                // //                                                                            // //////////////////////////////////////////////////////////////////////////////// //                                                                            // // ripped com/activex stuff , added avi stream functions.          // //                                                                            // //////////////////////////////////////////////////////////////////////////////// // unicode version created arnold , tlama (2012)                         // ////////////////////////////////////////////////////////////////////////////////  type   long = longint;   pvoid = pointer;  const // tavifileinfo dwflag values    avif_hasindex          = $00000010;    avif_mustuseindex      = $00000020;    avif_isinterleaved     = $00000100;    avif_wascapturefile    = $00010000;    avif_copyrighted       = $00020000;    avif_known_flags       = $00030130;     avierr_unsupported     = $80044065; // make_avierr(101)    avierr_badformat       = $80044066; // make_avierr(102)    avierr_memory          = $80044067; // make_avierr(103)    avierr_internal        = $80044068; // make_avierr(104)    avierr_badflags        = $80044069; // make_avierr(105)    avierr_badparam        = $8004406a; // make_avierr(106)    avierr_badsize         = $8004406b; // make_avierr(107)    avierr_badhandle       = $8004406c; // make_avierr(108)    avierr_fileread        = $8004406d; // make_avierr(109)    avierr_filewrite       = $8004406e; // make_avierr(110)    avierr_fileopen        = $8004406f; // make_avierr(111)    avierr_compressor      = $80044070; // make_avierr(112)    avierr_nocompressor    = $80044071; // make_avierr(113)    avierr_readonly        = $80044072; // make_avierr(114)    avierr_nodata          = $80044073; // make_avierr(115)    avierr_buffertoosmall  = $80044074; // make_avierr(116)    avierr_cantcompress    = $80044075; // make_avierr(117)    avierr_userabort       = $800440c6; // make_avierr(198)    avierr_error           = $800440c7; // make_avierr(199)  // tavistreaminfo dwflag values    avisf_disabled         = $00000001;    avisf_video_palchanges = $00010000;    avisf_known_flags      = $00010001;  type   tavifileinfow = record     dwmaxbytespersec,// max. transfer rate     dwflags,         // 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 file type?   end;   pavifileinfow = ^tavifileinfow;    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: dword;     szname:  array[0..63] of widechar;   end;   tavistreaminfo = tavistreaminfow;   pavistreaminfo = ^tavistreaminfo;    pavistream = pointer;   pavifile   = pointer;   tavistreamlist = array[0..0] of pavistream;   pavistreamlist = ^tavistreamlist;   tavisavecallback = function (npercent: integer): long; stdcall;    tavicompressoptions = packed record     fcctype     : dword;     fcchandler      : dword;     dwkeyframeevery : dword;     dwquality       : dword;     dwbytespersecond    : dword;     dwflags     : dword;     lpformat        : pointer;     cbformat        : dword;     lpparms     : pointer;     cbparms     : dword;     dwinterleaveevery   : dword;   end;   pavicompressoptions = ^tavicompressoptions;  // palette change data record const   riff_palettechange: dword = 1668293411;  type   tavipalchange = packed record     bfirstentry     : byte;     bnumentries     : byte;     wflags      : word;     penew       : array[byte] of tpaletteentry;   end;   pavipalchange = ^tavipalchange;    apavistream          = array[0..1] of pavistream;   apavicompressoptions = array[0..1] of pavicompressoptions;   procedure avifileinit; stdcall; procedure avifileexit; stdcall; function avifileopen(var ppfile: pavifile; szfile: pchar; umode: uint; lphandler: pointer): hresult; stdcall; function avifilecreatestream(pfile: pavifile; var ppavi: pavistream; var psi: tavistreaminfo): hresult; stdcall; function avistreamsetformat(pavi: pavistream; lpos: long; lpformat: pointer; cbformat: long): hresult; stdcall; function avistreamreadformat(pavi: pavistream; lpos: long; lpformat: pointer; var cbformat: long): hresult; stdcall; function avistreamwrite(pavi: pavistream; lstart, lsamples: long; lpbuffer: pointer; cbbuffer: long; dwflags: dword; var plsampwritten: long; var plbyteswritten: long): hresult; stdcall; function avistreamrelease(pavi: pavistream): ulong; stdcall; function avifilerelease(pfile: pavifile): ulong; stdcall; function avifilegetstream(pfile: pavifile; var ppavi: pavistream; fcctype: dword; lparam: long): hresult; stdcall; function createeditablestream(var ppseditable: pavistream; pssource: pavistream): hresult; stdcall; function avisavev(szfile: pchar; pclsidhandler: pclsid; lpfncallback: tavisavecallback;   nstreams: integer; pavi: apavistream; lpoptions: apavicompressoptions): hresult; stdcall;  const   avierr_ok       = 0;    aviif_list      = $01;   aviif_twocc     = $02;   aviif_keyframe  = $10;    streamtypevideo = $73646976; // dword( 'v', 'i', 'd', 's' )   streamtypeaudio = $73647561; // dword( 'a', 'u', 'd', 's' )   type   tpixelformat = (pfdevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit, pf24bit, pf32bit, pfcustom);  type   taviwriter = class (tcomponent)   private     tempfilename   : string;     pfile          : pavifile;     fheight        : integer;     fwidth         : integer;     fstretch       : boolean;     fframetime     : integer;     ffilename      : string;     fwavfilename   : string;     videostream    : pavistream;     audiostream    : pavistream;      procedure addvideo;     procedure addaudio;     procedure internalgetdibsizes(bitmap: hbitmap; var infoheadersize: integer;         var imagesize: longint; pixelformat: tpixelformat);     function internalgetdib(bitmap: hbitmap; palette: hpalette;         var bitmapinfo; var bits; pixelformat: tpixelformat): boolean;     procedure initializebitmapinfoheader(bitmap: hbitmap; var info: tbitmapinfoheader;            pixelformat: tpixelformat);     procedure setwavfilename(value : string);    public     bitmaps : tlist;     constructor create(aowner : tcomponent); override;     destructor  destroy; override;     procedure write;    published     property height   : integer read fheight  write fheight;     property width    : integer read fwidth   write fwidth;     property frametime: integer read fframetime write fframetime;     property stretch  : boolean read fstretch write fstretch;     property filename : string  read ffilename write ffilename;     property wavfilename  : string  read fwavfilename write setwavfilename;   end;  procedure register;  implementation  procedure avifileinit; stdcall; external 'avifil32.dll' name 'avifileinit'; procedure avifileexit; stdcall; external 'avifil32.dll' name 'avifileexit'; function avifileopen; external 'avifil32.dll' name 'avifileopenw'; function avifilecreatestream; external 'avifil32.dll' name 'avifilecreatestreamw'; function avistreamsetformat; external 'avifil32.dll' name 'avistreamsetformat'; function avistreamreadformat; external 'avifil32.dll' name 'avistreamreadformat'; function avistreamwrite; external 'avifil32.dll' name 'avistreamwrite'; function avistreamrelease; external 'avifil32.dll' name 'avistreamrelease'; function avifilerelease; external 'avifil32.dll' name 'avifilerelease'; function avifilegetstream; external 'avifil32.dll' name 'avifilegetstream'; function createeditablestream; external 'avifil32.dll' name 'createeditablestream'; function avisavev; external 'avifil32.dll' name 'avisavevw';  constructor taviwriter.create(aowner : tcomponent); begin     inherited create(aowner);     fheight    := screen.height div 10;     fwidth     := screen.width  div 10;     fframetime := 1000;     fstretch   := true;     ffilename  := '';     bitmaps    := tlist.create;     avifileinit;     tempfilename := {tempdir +} 'temp.avi'; end;  destructor taviwriter.destroy; begin     bitmaps.free;     avifileexit;     inherited; end;  procedure taviwriter.write; var   extbitmap             : tbitmap;   nstreams              : integer;                       : integer;   streams               : apavistream;   compoptions           : apavicompressoptions;   avierr                : integer;   refcount              : integer; begin    audiostream := nil;    videostream := nil;     // if no bitmaps on list, raise error.    if bitmaps.count < 1       raise exception.create('no bitmaps on bitmaps list');     // if on bitmaps tlist not bitmap, raise    // error.    := 0 bitmaps.count - 1    begin       extbitmap := bitmaps[i];       if not(extbitmap tbitmap)          raise exception.create('bitmaps[' + inttostr(i)                        + '] not tbitmap');    end; //     try       addvideo;        if wavfilename <> ''          addaudio;        // create output file.       if wavfilename <> ''          nstreams := 2          else nstreams := 1;        streams[0] := videostream;       streams[1] := audiostream;       compoptions[0] := nil;       compoptions[1] := nil;        avierr := avisavev(                    pchar(filename),                    nil,                    // file handler                    nil,                    // callback                    nstreams,               // number of streams                    streams,                    compoptions);           // compress options videostream       if avierr <> avierr_ok              raise exception.create('unable write output file');          if assigned(videostream)          avistreamrelease(videostream);       if assigned(audiostream)          avistreamrelease(audiostream);        try          repeat             refcount := avifilerelease(pfile);          until refcount <= 0;       except          // ignore exception       end; // try..except        deletefile(tempfilename);    end; // try..finally end;  procedure taviwriter.addvideo; var   pstream:         pavistream;   streaminfo:      tavistreaminfo;   bitmapinfo:      pbitmapinfoheader;   bitmapinfosize:  integer;   bitmapsize:      longint;   bitmapbits:      pointer;   bitmap:          tbitmap;   extbitmap:       tbitmap;   samples_written: long;   bytes_written:   long;   avierr:          integer;   i:               integer;   ok: int64;   mode: uint32;   fn: pchar;   err: string; begin     // open avi file write     pfile := nil;     mode  := of_create or of_write or of_share_exclusive;     fn    := pchar (tempfilename);      ok := avifileopen (pfile, fn, mode, nil);     if ok = avierr_badformat    err := 'the file not read, indicating corrupt file or unrecognized format.';     if ok = avierr_memory       err := 'the file not opened because of insufficient memory.';     if ok = avierr_fileread     err := 'a disk error occurred while reading file.';     if ok = avierr_fileopen     err := 'a disk error occurred while opening file.';     if ok = regdb_e_classnotreg err := 'according registry, type of file specified in avifileopen not have handler process it.';     if err <> '' raise exception.create (err);      // allocate bitmap bitmaps on bitmaps tlist     // copied.     bitmap        := tbitmap.create;     bitmap.height := self.height;     bitmap.width  := self.width;      // write stream header.     try        fillchar (streaminfo, sizeof (streaminfo), 0);         // set frame rate , scale        streaminfo.dwrate  := 1000;        streaminfo.dwscale := fframetime;        streaminfo.fcctype := streamtypevideo;        streaminfo.fcchandler := 0;        streaminfo.dwflags := 0;        streaminfo.dwsuggestedbuffersize := 0;        streaminfo.rcframe.right  := self.width;        streaminfo.rcframe.bottom := self.height;         // open avi data stream        if (avifilecreatestream(pfile, pstream, streaminfo) <> avierr_ok)            raise exception.create('failed create avi video stream');         try           // write bitmaps stream.           := 0 bitmaps.count - 1           begin              bitmapinfo := nil;              bitmapbits := nil;              try                 // copy bitmap list avi bitmap,                // stretching if desired. if caller elects not                // stretch, use first pixel in bitmap                // background color in case either height or                // width of source smaller output.                // if draw fails, stretchdraw.                extbitmap := bitmaps[i];                if fstretch                   bitmap.canvas.stretchdraw                            (rect(0,0,self.width,self.height),extbitmap)                   else try                          bitmap.canvas begin                             brush.color := extbitmap.canvas.pixels[0,0];                             brush.style := bssolid;                             fillrect(rect(0,0,bitmap.width,bitmap.height));                             draw(0,0,extbitmap);                          end;                        except                          bitmap.canvas.stretchdraw                             (rect(0,0,self.width,self.height),extbitmap);                        end;                 // determine size of dib                internalgetdibsizes(bitmap.handle, bitmapinfosize, bitmapsize, pf8bit);                if (bitmapinfosize = 0)                   raise exception.create('failed retrieve bitmap info');                 // dib header , pixel buffers                getmem(bitmapinfo, bitmapinfosize);                getmem(bitmapbits, bitmapsize);                internalgetdib                      (bitmap.handle, 0, bitmapinfo^, bitmapbits^, pf8bit);                 // on first time through, set stream format.                if = 0                   if (avistreamsetformat(pstream, 0, bitmapinfo, bitmapinfosize) <> avierr_ok)                       raise exception.create('failed set avi stream format');                 // write frame video stream                avierr :=                   avistreamwrite(pstream, i, 1, bitmapbits, bitmapsize, aviif_keyframe,                              samples_written, bytes_written);                if avierr <> avierr_ok                     raise exception.create                             ('failed add frame avi. err='                                + inttohex(avierr,8));                             if (bitmapinfo <> nil)                  freemem(bitmapinfo);                if (bitmapbits <> nil)                  freemem(bitmapbits);              end;           end;            // create editable videostream pstream.           if createeditablestream(videostream,pstream) <> avierr_ok                     raise exception.create                             ('could not create video stream');                  avistreamrelease(pstream);        end;            bitmap.free;     end; end;  procedure taviwriter.addaudio; var    inputfile    : pavifile;    inputstream  : pavistream;    err: string;    ok: int64; begin    // open audio file.     ok := avifileopen(inputfile, pchar(wavfilename),of_read, nil);     if ok = avierr_badformat    err := 'the file not read, indicating corrupt file or unrecognized format.';     if ok = avierr_memory       err := 'the file not opened because of insufficient memory.';     if ok = avierr_fileread     err := 'a disk error occurred while reading file.';     if ok = avierr_fileopen     err := 'a disk error occurred while opening file.';     if ok = regdb_e_classnotreg err := 'according registry, type of file specified in avifileopen not have handler process it.';     if err <> '' raise exception.create (err);     // open audio stream.    try      if (avifilegetstream(inputfile, inputstream, 0, 0) <> avierr_ok)          raise exception.create('unable audio stream');       try        // create audiostream copy of inputstream        if (createeditablestream(audiostream,inputstream) <> avierr_ok)             raise exception.create('failed create editable avi audio stream');             avistreamrelease(inputstream);      end;          avifilerelease(inputfile);    end; end;  // -------------- // internalgetdib // -------------- // converts bitmap dib of specified pixelformat. // // note: internalgetdibsizes function can used calculate // nescessary sizes of bitmapinfo , bits buffers. // // graphics.pas, "optimized" our use  function taviwriter.internalgetdib (    bitmap: hbitmap;   // handle of source bitmap    palette: hpalette; // handle of source palette    var bitmapinfo;    // buffer receive dib's tbitmapinfo structure.                       // buffer of sufficient size must have been allocated prior                       // calling function    var bits;          // buffer receive dib's pixel data    pixelformat: tpixelformat // pixel format of destination dib ): boolean; // true on success, false on failure var   oldpal    : hpalette;   dc        : hdc; begin   initializebitmapinfoheader(bitmap, tbitmapinfoheader(bitmapinfo), pixelformat);   oldpal := 0;   dc := createcompatibledc(0);   try     if (palette <> 0)     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);       if (oldpal <> 0)       selectpalette(dc, oldpal, false);     deletedc(dc);   end; end;   // ------------------- // internalgetdibsizes // ------------------- // calculates buffer sizes nescessary convertion of bitmap dib // of specified pixelformat. // see getdibsizes api function more info. // graphics.pas, "optimized" our use  procedure taviwriter.internalgetdibsizes (    bitmap: hbitmap;             // handle of source bitmap    var infoheadersize: integer; // returned size of buffer receive                                 // dib's tbitmapinfo structure    var imagesize: longint;      // returned size of buffer receive dib's pixel data    pixelformat: tpixelformat    // pixel format of destination dib ); var   info: tbitmapinfoheader; begin   initializebitmapinfoheader(bitmap, info, pixelformat);   // check palette device format   if (info.bibitcount > 8)   begin     // header no palette     infoheadersize := sizeof(tbitmapinfoheader);     if ((info.bicompression , bi_bitfields) <> 0)       inc(infoheadersize, 12);   end else     // header , palette     infoheadersize := sizeof(tbitmapinfoheader) + sizeof(trgbquad) * (1 shl info.bibitcount);   imagesize := info.bisizeimage; end;  // -------------------------- // initializebitmapinfoheader // -------------------------- // fills tbitmapinfoheader values of bitmap when converted // dib of specified pixelformat. // graphics.pas, "optimized" our use  procedure taviwriter.initializebitmapinfoheader (    bitmap: hbitmap;              // handle of source bitmap    var info: tbitmapinfoheader;  // tbitmapinfoheader buffer receive values    pixelformat: tpixelformat     // pixel format of destination dib ); var   dib       : tdibsection;   bytes     : integer;   function alignbit(bits, bitsperpixel, alignment: cardinal): cardinal;   begin     dec(alignment);     result := ((bits * bitsperpixel) + alignment) , not alignment;     result := result shr 3;   end; begin   dib.dsbmih.bisize := 0;   bytes := getobject(bitmap, sizeof(dib), @dib);   if (bytes = 0)     raise exception.create('invalid bitmap'); //    error(sinvalidbitmap);    if (bytes >= (sizeof(dib.dsbm) + sizeof(dib.dsbmih))) ,     (dib.dsbmih.bisize >= sizeof(dib.dsbmih))     info := dib.dsbmih   else   begin     fillchar(info, sizeof(info), 0);     info, dib.dsbm     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 format');     // info.bibitcount := dib.dsbm.bmbitspixel * dib.dsbm.bmplanes;   end;   info.biplanes := 1;   info.bicompression := bi_rgb; // return data in rgb format   info.bisizeimage := alignbit(info.biwidth, info.bibitcount, 32) * cardinal(abs(info.biheight)); end;  procedure taviwriter.setwavfilename(value : string); begin    if lowercase(fwavfilename) <> lowercase(value)       if lowercase(extractfileext(value)) <> '.wav'              raise exception.create('wavfilename must name file '                              + 'with .wav extension')              else fwavfilename := value; end;  procedure register; begin   registercomponents('samples', [taviwriter]); end;  end. 

change import part of avisavev function unicode version of it. when function in windows api reference has note unicode , ansi names means you, in delphi, have choose either unicode version of function or ansi 1 depending on compiler use.

you're trying call avisavev, physically doesn't exists. there's avisaveva , avisavevw in avifil32.dll , since want convert code unicode, try change function import way:

function avisavev; external 'avifil32.dll' name 'avisavevw'; 

enter image description here

this first thought, code definition cannot work in non unicode versions of delphi, because called not existing function.


Comments

Popular posts from this blog

python - ('The SQL contains 0 parameter markers, but 50 parameters were supplied', 'HY000') or TypeError: 'tuple' object is not callable -

jasper reports - Fixed header in Excel using JasperReports -