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';
this first thought, code definition cannot work in non unicode versions of delphi, because called not existing function.
Comments
Post a Comment