sz3905
asked on
"C" code to Delphi, Can you convert?
I'm trying to convert a MSDN "C"example to delphi.
I seem to be having problems with the syntax converstions.
The snippet below contains the 6 lines that need converting. The rest of the code is to large to post and
still in a design stage anyway. The project hopes to be a
BMP to avi converter that uses various compressions when it grows up. The AVI calls are in avifil32 and other standard MS video dlls. The structures, interfaces and vars are working fine using non-compressed frames. The delphi syntax for lines 1-6 and the varible layout are what I'm looking for. I realize that the provided info is somewhat skimpy but you can look at the org. sample for writeavi.exe at MSDN for more. Maybe I should learn see . . . .
Thanks for any help!
/Steve
sz3905
#sample used is "writeavi.h" at MSDN
//------------------------ ---------- ---------- ---------- ---------- ------// Defines
//------------------------ ---------- ---------- ---------- ---------- ------#def ine AVIIF_KEYFRAME 0x00000010L // this frame is a key frame.
#define BUFSIZE 260
#define LPLPBI LPBITMAPINFOHEADER *
// setup vars
// Dear EXPERT, Please assume AVISTREAMINFO, AVICOMPRESSOPTIONS structures
// and PAVIFILE+PAVISTREAM interfaces are setup and well.
////////////////////////// ////////// ////////// ////////// ////////
PAVISTREAMINFO = ^TAVISTREAMINFO
PAVIFILE =^ IAVIFILE
PAVISTREAM = ^IAVISTREAM
PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS
///////////// varible layout //////////////////////
LPBITMAPINFOHEADER alpbi[N_FRAMES];
int i;
AVISTREAMINFO strhdr;
PAVIFILE pfile = NULL;
PAVISTREAM ps = NULL, psCompressed = NULL, psText = NULL;
AVICOMPRESSOPTIONS opts;
AVICOMPRESSOPTIONS FAR * aopts[1] = {&opts}; // array of pointers to AVICOMPRESSOPTIONS
HRESULT hr;
//////////// Lines 1- 6 /////////////////////////
1) AVIFileOpen(&pfile, // returned file pointer
szTitle, // file name
OF_WRITE | OF_CREATE, // mode to open file with
NULL); // use handler determined
2)AVIFileCreateStream(pfil e, // file pointer
&ps, // returned stream pointer
&strhdr); // stream header
3) AVISaveOptions(NULL, 0, 1, &ps, (LPAVICOMPRESSOPTIONS FAR *) &aopts)
4) AVIMakeCompressedStream(&p sCompresse d, ps, &opts, NULL);
5) AVIStreamSetFormat(psCompr essed, 0,
alpbi[0], // stream format
alpbi[0]->biSize + // format size
alpbi[0]->biClrUsed * sizeof(RGBQUAD));
6) AVIStreamWrite(psCompresse d, // stream pointer
FrameNumber, // time of this frame
1, // number to write
(LPBYTE) alpbi[i] + // pointer to data
alpbi[i]->biSize +
alpbi[i]->biClrUsed * sizeof(RGBQUAD),
alpbi[i]->biSizeImage, // size of this frame
AVIIF_KEYFRAME, // flags....
NULL,NULL);
////////////////// his is self explanitory //////////////////////
if (ps<> nil) AVIStreamClose(ps); // etc,etc
if (psCompressed)
AVIStreamClose(psCompresse d);
if (psText)
AVIStreamClose(psText);
if (pfile)
AVIFileClose(pfile);
AVIFileExit();
I seem to be having problems with the syntax converstions.
The snippet below contains the 6 lines that need converting. The rest of the code is to large to post and
still in a design stage anyway. The project hopes to be a
BMP to avi converter that uses various compressions when it grows up. The AVI calls are in avifil32 and other standard MS video dlls. The structures, interfaces and vars are working fine using non-compressed frames. The delphi syntax for lines 1-6 and the varible layout are what I'm looking for. I realize that the provided info is somewhat skimpy but you can look at the org. sample for writeavi.exe at MSDN for more. Maybe I should learn see . . . .
Thanks for any help!
/Steve
sz3905
#sample used is "writeavi.h" at MSDN
//------------------------
//------------------------
#define BUFSIZE 260
#define LPLPBI LPBITMAPINFOHEADER *
// setup vars
// Dear EXPERT, Please assume AVISTREAMINFO, AVICOMPRESSOPTIONS structures
// and PAVIFILE+PAVISTREAM interfaces are setup and well.
//////////////////////////
PAVISTREAMINFO = ^TAVISTREAMINFO
PAVIFILE =^ IAVIFILE
PAVISTREAM = ^IAVISTREAM
PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS
///////////// varible layout //////////////////////
LPBITMAPINFOHEADER alpbi[N_FRAMES];
int i;
AVISTREAMINFO strhdr;
PAVIFILE pfile = NULL;
PAVISTREAM ps = NULL, psCompressed = NULL, psText = NULL;
AVICOMPRESSOPTIONS opts;
AVICOMPRESSOPTIONS FAR * aopts[1] = {&opts}; // array of pointers to AVICOMPRESSOPTIONS
HRESULT hr;
//////////// Lines 1- 6 /////////////////////////
1) AVIFileOpen(&pfile, // returned file pointer
szTitle, // file name
OF_WRITE | OF_CREATE, // mode to open file with
NULL); // use handler determined
2)AVIFileCreateStream(pfil
&ps, // returned stream pointer
&strhdr); // stream header
3) AVISaveOptions(NULL, 0, 1, &ps, (LPAVICOMPRESSOPTIONS FAR *) &aopts)
4) AVIMakeCompressedStream(&p
5) AVIStreamSetFormat(psCompr
alpbi[0], // stream format
alpbi[0]->biSize + // format size
alpbi[0]->biClrUsed * sizeof(RGBQUAD));
6) AVIStreamWrite(psCompresse
FrameNumber, // time of this frame
1, // number to write
(LPBYTE) alpbi[i] + // pointer to data
alpbi[i]->biSize +
alpbi[i]->biClrUsed * sizeof(RGBQUAD),
alpbi[i]->biSizeImage, // size of this frame
AVIIF_KEYFRAME, // flags....
NULL,NULL);
////////////////// his is self explanitory //////////////////////
if (ps<> nil) AVIStreamClose(ps); // etc,etc
if (psCompressed)
AVIStreamClose(psCompresse
if (psText)
AVIStreamClose(psText);
if (pfile)
AVIFileClose(pfile);
AVIFileExit();
This:
AVIMakeCompressedStream(ps Compressed , ps, opts, NULL);
Should be
AVIMakeCompressedStream(ps Compressed , ps, opts, Nil);
Cheers,
Raymond.
AVIMakeCompressedStream(ps
Should be
AVIMakeCompressedStream(ps
Cheers,
Raymond.
ASKER
Greetings Raymond, Thx for the quick response.
I need just a couple more hints and we can rap this up.
Would the aopts[1] be declared as:
aopts:array[0..0] of pointer;
And then, whats the converted declaration line for:
AVICOMPRESSOPTIONS FAR * aopts[1] = {&opts};
My problem has been certain compressors(Ms Video 1) are using resources that I cant find to free (i could be wrong). So I'm guessing that the 'AVISaveOptions' requirements for a pointer that points to an array of pointers that point to individual 'opts' for each stream is giving me the problems. And I'm sure it's my converstion syntax.
Thx Again
I need just a couple more hints and we can rap this up.
Would the aopts[1] be declared as:
aopts:array[0..0] of pointer;
And then, whats the converted declaration line for:
AVICOMPRESSOPTIONS FAR * aopts[1] = {&opts};
My problem has been certain compressors(Ms Video 1) are using resources that I cant find to free (i could be wrong). So I'm guessing that the 'AVISaveOptions' requirements for a pointer that points to an array of pointers that point to individual 'opts' for each stream is giving me the problems. And I'm sure it's my converstion syntax.
Thx Again
This line:
AVICOMPRESSOPTIONS FAR * aopts[1] = {&opts};
Actually declares an array of pointers to AVICOMPRESSOPTIONS structures which contains just one element, and assigns the address of opts to the only element in the array (don't you just LOVE C :-)
So, in Delphi we would say:
var
aopts : array[0..0] of PAVICOMPRESSOPTIONS;
// Where PAVICOMPRESSOPTIONS is a pointer to an AVICOMPRESSOPTIONS structure (though pointer would also do)
Obviously you would declare/allocate this structure to an appropriate size for multiple streams...
....
aopts[0] := @opts; // assign opts to aopts[0]
Let me know if this helps.
Cheers,
Raymond.
AVICOMPRESSOPTIONS FAR * aopts[1] = {&opts};
Actually declares an array of pointers to AVICOMPRESSOPTIONS structures which contains just one element, and assigns the address of opts to the only element in the array (don't you just LOVE C :-)
So, in Delphi we would say:
var
aopts : array[0..0] of PAVICOMPRESSOPTIONS;
// Where PAVICOMPRESSOPTIONS is a pointer to an AVICOMPRESSOPTIONS structure (though pointer would also do)
Obviously you would declare/allocate this structure to an appropriate size for multiple streams...
....
aopts[0] := @opts; // assign opts to aopts[0]
Let me know if this helps.
Cheers,
Raymond.
ASKER
Greetings Raymond,
(don't you just LOVE C :-)
I'd love to know it!
Anyway thanks for all. You have made it much clearer to me.
Answer the question so you may have some points. I dont know how many they will give you, but I put up 1k.
thx again
steve
/sz3905
(don't you just LOVE C :-)
I'd love to know it!
Anyway thanks for all. You have made it much clearer to me.
Answer the question so you may have some points. I dont know how many they will give you, but I put up 1k.
thx again
steve
/sz3905
ASKER
Raymond,
One last pointer to a pointer question if I may?
Assume all declarations and pointers are set as you prescribed
above.
This line:
(Actual Line:) AviSaveOptions(handle,0,1, ps,aopts);
which is invoked with:
Function AviSaveOptions(HWND:Thandl e; uiFlags:UINT; nStreams:integer; ppavi: PAVIStream;plpOptions:poin ter): HResult;
Declared as :
Function AVISaveOptions(HWND:Thandl e;uiFlags: UINT;nStre ams:intege r;
ppavi: PAVIStream;plpOptions:poin ter): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
Is not working (runtime access err) because I use "plpOptions:pointer" I've changed the Actual Line to many variations including pointer(aopts), Pointer(@aopts), etc, etc with no luck. "AVISaveOptions" seems unable to get to the single TAVICOMPRESSOPTIONS structure that the single array element(pointer) we're using, points to. Maybe more of my code would explain if this isn't clear.
Any ideas what may be causing problems? (besides I think I dont know what I'm doing :-(
Thx
steve
One last pointer to a pointer question if I may?
Assume all declarations and pointers are set as you prescribed
above.
This line:
(Actual Line:) AviSaveOptions(handle,0,1,
which is invoked with:
Function AviSaveOptions(HWND:Thandl
Declared as :
Function AVISaveOptions(HWND:Thandl
ppavi: PAVIStream;plpOptions:poin
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
Is not working (runtime access err) because I use "plpOptions:pointer" I've changed the Actual Line to many variations including pointer(aopts), Pointer(@aopts), etc, etc with no luck. "AVISaveOptions" seems unable to get to the single TAVICOMPRESSOPTIONS structure that the single array element(pointer) we're using, points to. Maybe more of my code would explain if this isn't clear.
Any ideas what may be causing problems? (besides I think I dont know what I'm doing :-(
Thx
steve
Listening..
ASKER
Brainware,
Come on in, the more the better.
sz3905/steve
Come on in, the more the better.
sz3905/steve
OK... From the declaration of the prototype we need to pass pointers to things, rather than treat them as var parameters. So the code for those lines should look more like this:
AVIFileOpen(@pfile, // returned file pointer
szTitle, // file name
OF_WRITE OR OF_CREATE, // mode to open file with
nil); // use handler determined
AVIFileCreateStream(pfile, // file pointer
@ps, // returned stream pointer
strhdr); // stream header
AVISaveOptions(nil, 0, 1, @ps, @aopts);
AVIMakeCompressedStream(@p sCompresse d, ps, @opts, Nil);
// No change to the last two lines.
I've been using nice API conversions for too long :-)
Cheers,
Raymond.
AVIFileOpen(@pfile, // returned file pointer
szTitle, // file name
OF_WRITE OR OF_CREATE, // mode to open file with
nil); // use handler determined
AVIFileCreateStream(pfile,
@ps, // returned stream pointer
strhdr); // stream header
AVISaveOptions(nil, 0, 1, @ps, @aopts);
AVIMakeCompressedStream(@p
// No change to the last two lines.
I've been using nice API conversions for too long :-)
Cheers,
Raymond.
ASKER
Raymond,
The more I learn, the less I know. Go figure . . .
I'm at a loss as to why these two proto's dont work?
The MSDN docs claim that this is the calling convention for
AVISaveOptions:
BOOL AVISaveOptions(
HWND hwnd,
UINT uiFlags,
int nStreams,
PAVISTREAM * ppavi,
LPAVICOMPRESSOPTIONS * plpOptions );
This is my version, which must be wrong:
Function AVISaveOptions(HWND:Thandl e;uiFlags: UINT;nStre ams:intege r;
var ppavi: PAVIStream;var plpOptions:pointer): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
//------------------------ ---------- ---------- ----//
The MSDN docs claim that this is the calling convention for
AVIMakeCompressedStream:
STDAPI AVIMakeCompressedStream(
PAVISTREAM * ppsCompressed,
PAVISTREAM psSource,
AVICOMPRESSOPTIONS * lpOptions,
CLSID * pclsidHandler);
This is my version, which must be wrong:
Function AVIMakeCompressedStream(
var ppavi: pointer; pavi:PAVIStream;
pavo:PAVICOMPRESSOPTIONS;
PCLSID:pointer):HResult; stdcall;
Are my version's syntax out in left field? If so
any suggestions (other than learning 'C') ?
I kow 1k points is not a lot for what I'm asking.
thx
sz3905/steve (:-]
The more I learn, the less I know. Go figure . . .
I'm at a loss as to why these two proto's dont work?
The MSDN docs claim that this is the calling convention for
AVISaveOptions:
BOOL AVISaveOptions(
HWND hwnd,
UINT uiFlags,
int nStreams,
PAVISTREAM * ppavi,
LPAVICOMPRESSOPTIONS * plpOptions );
This is my version, which must be wrong:
Function AVISaveOptions(HWND:Thandl
var ppavi: PAVIStream;var plpOptions:pointer): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
//------------------------
The MSDN docs claim that this is the calling convention for
AVIMakeCompressedStream:
STDAPI AVIMakeCompressedStream(
PAVISTREAM * ppsCompressed,
PAVISTREAM psSource,
AVICOMPRESSOPTIONS * lpOptions,
CLSID * pclsidHandler);
This is my version, which must be wrong:
Function AVIMakeCompressedStream(
var ppavi: pointer; pavi:PAVIStream;
pavo:PAVICOMPRESSOPTIONS;
PCLSID:pointer):HResult; stdcall;
Are my version's syntax out in left field? If so
any suggestions (other than learning 'C') ?
I kow 1k points is not a lot for what I'm asking.
thx
sz3905/steve (:-]
The make compressed stream one looks OK, but the save options one needs to be changed to this:
Function AVISaveOptions(HWND:Thandl e;
uiFlags:UINT;
nStreams:integer;
var ppavi: PAVIStream;
plpOptions:pointer): HResult;
The difference is that plpOptions is a pointer to an array of pointers (which in C is thought of simply as a pointer to a pointer). It doesn't need to be a var parameter as we are not changing the location of the array, just its contents.
Using these prototypes call the functions like this:
AVISaveOptions(nil, 0, 1, ps, @aopts);
AVIMakeCompressedStream(ps Compressed , ps, @opts, nil);
I'm not 100% sure if the ps parm to AviSaveOptions needs to be var (ie: if the pointer itself will changed. But the result is the same as if you declared it as pointer to pointer and passed @ps anyway).
If this doesn't work out post all the MSDN prototypes and your prototypes for these functions, and the code snippet that is calling them.
1k points is plenty!
Cheers,
Raymond.
Function AVISaveOptions(HWND:Thandl
uiFlags:UINT;
nStreams:integer;
var ppavi: PAVIStream;
plpOptions:pointer): HResult;
The difference is that plpOptions is a pointer to an array of pointers (which in C is thought of simply as a pointer to a pointer). It doesn't need to be a var parameter as we are not changing the location of the array, just its contents.
Using these prototypes call the functions like this:
AVISaveOptions(nil, 0, 1, ps, @aopts);
AVIMakeCompressedStream(ps
I'm not 100% sure if the ps parm to AviSaveOptions needs to be var (ie: if the pointer itself will changed. But the result is the same as if you declared it as pointer to pointer and passed @ps anyway).
If this doesn't work out post all the MSDN prototypes and your prototypes for these functions, and the code snippet that is calling them.
1k points is plenty!
Cheers,
Raymond.
Everybody's watching Raymond going to the limits,
where are the other Experts,
come on !
Indi
where are the other Experts,
come on !
Indi
Everybody's watching Raymond going to the limits,
where are the other Experts,
come on !
Indi
where are the other Experts,
come on !
Indi
ASKER
okay, here it is . . .
// Raymond, on a clean form add a button, drop this in.
// should run, but this snippet version wont save
// the avi format cause I tried to simplify
// and stripped out a bit to much, I can fix tomarrow and send back.
// This tries to create 50 frames. The color management
// code has been left out to save space.
procedure TForm1.Button1Click(Sender : TObject);
var
StdHdr: TAVIStreamInfo;
pfile: PAVIFile;
ps,psCompressed: PAVIStream;
opts:TAVICOMPRESSOPTIONS;
aOpts:array[0..0] of pointer;
FRAME,X,i: Integer;
nul: lONG;
nul2: lONG;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
BitmapInfoSize: Dword;
BitmapSize: Dword;
NumbEROfColors:Integer;
er:long;
bm:Tbitmap;
Procedure DrawSomeThingOnBitmap(FRAM E:integer) ; begin
with bm.Canvas do begin fillrect(cliprect);
textout(5*frame,60,'Delphi '); bm.canvas.Refresh; end; end;
begin
ps:=nil; psCompressed:=nil;
aOpts[0]:=allocmem(sizeof( TAVICOMPRE SSOPTIONS) );
fillchar(aopts[0]^,sizeof( TAVICOMPRE SSOPTIONS) ,0);
AVIFileInit;
if fileExists('e:\avicreate\t est.avi') then deletefile('e:\avicreate\t est.avi');
if AVIFileOpen(pfile, 'e:\avicreate\test.avi',
OF_WRITE or OF_CREATE, nil)=AVIERR_OK then
begin
bm:=tbitmap.create; // make a bitmap to play with
bm.width:=180; bm.height:=120;
bm.PixelFormat:=pf8bit;
bm.Canvas.brush.color:=clb lue;
bm.Canvas.font.color:=clYe llow;
bm.Canvas.font.size:=24;
bm.Canvas.FillRect(bm.canv as.cliprec t);
GetDIBSizes(bm.Handle,Bitm apInfoSize ,BitmapSiz e);
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
GetDIB(bm.Handle,0,BitmapI nfo^,Bitma pBits^);
FillChar(StdHdr,sizeof(Std Hdr),0);
StdHdr.fccType := streamtypeVIDEO;
StdHdr.fccHandler := 0;
StdHdr.dwScale := 1;
StdHdr.dwRate := 30;
StdHdr.dwSuggestedBufferSi ze := BitmapInfo^.biSizeImage;
StdHdr.rcFrame.Right := BitmapInfo^.biWidth ;
StdHdr.rcFrame.Bottom := BitmapInfo^.biHeight;
if AVIFileCreateStream(pfile, ps,StdHdr) = AVIERR_OK then
{#3} if AviSaveOptions(handle,0,1, ps,@aOpts) > AVIERR_OK then
{#4} if AviMakeCompressedStream(ps Compressed ,ps,
PAVICOMPRESSOPTIONS(@opts) ,nil) = AVIERR_OK then
{#5} IF AVIStreamSetFormat(psCompr essed,0,Bi tmapInfo,
(BitmapInfo.biSize+BitmapI nfo.biClrU sed)*sizeo f(TrgbQuad ))
= AVIERR_OK THEN
begin
FRAME:=-1;
FOR X:=0 TO 49 DO // make 50 frames
begin
FRAME:=FRAME+1;
DrawSomeThingOnBitmap(FRAM E); // alter the bitmap
canvas.draw(100,100,bm); // draw to show it's kinda working
GetDIB(bm.Handle,0,BitmapI nfo^,Bitma pBits^);
if AVIStreamWrite(psCompresse d,FRAME,1, @BitmapBit s,
(BitmapInfo^.biSize+Bitmap Info^.biCl rUsed)*siz eof(TrgbQu ad),
AVIIF_KEYFRAME,
nul,nul2)<>AVIERR_OK then
begin raise Exception.Create('Could not add frame');break;end;
end;
end;
// Free leftovers
bm.free;
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
freemem( pointer(aOpts[0]));
AVISaveOptionsFree(1,point er(aOpts)) ;
AVIStreamRelease(ps);
AVIStreamRelease(psCompres sed);
AVIFileRelease(pfile);
AVIFileExit;
APPLICATION.PROCESSMESSAGE S;
end;
end;
// ----------------- snip and save as DeVFW.pas -----------
////add deVFW; to uses clause of clean form
unit DeVFW; // This has been around, various contributors sz3905'99
interface // the extra junk is for the rest of the project
uses Windows, SysUtils,mmsystem, Classes;
type
LONG = Longint;
PVOID = Pointer;
PCLSID=Pointer;
TAVIFileInfoW = record
dwMaxBytesPerSec,
dwFlags,
dwCaps,
dwStreams,
dwSuggestedBufferSize,
dwWidth,
dwHeight,
dwScale,
dwRate,
dwLength,
dwEditCount: DWORD;
szFileType: array[0..63] of WideChar;
end;
PAVIFileInfoW = ^TAVIFileInfoW;
TAVICOMPRESSOPTIONS = record //12/6/99sbs
fccType, // typically = streamtypeVIDEO
fccHandler, // mmioFOURCC('M','S','V','C' )).
dwKeyFrameEvery, //Maximum period between video key frames
dwQuality,
dwFlags,
dwBytesPerSecond :Dword;
lpFormat:Pointer; // For an audio stream, this is an LPWAVEFORMAT structure.
cbFormat:DWORD; //Size, in bytes, of the data referenced by lpFormat.
lpParms:pointer; //Video-compressor-specifi c data; used internally.
cbParms:DWORD; //Size, in bytes, of the data referenced by lpParms
dwInterleaveEvery:DWORD; //Interleave factor for interspersing stream data
end;
PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS;
TCOMPVARS = record //12/6/99sbs
cbSize:LONG;
dwFlags:DWORD ;
hic:hwnd; // handle of compressor to use
fccType, fccHandler:DWORD ;
lpbiIn:PBITMAPINFO;
lpbiOut:PBITMAPINFO;
lpBitsOut,lpBitsPrev:PVOID ;
lFrame,lKey,lDataRate,lQ,l KeyCount:D word;
lpState:PVOID ;
cbState:LONG ;
end;
PCOMPVARS = ^TCompvars;
TICINFO = record // //12/6/99sbs video compression drivers info(via enumeration)
dwSize, //Size, in bytes, of the ICINFO structure.
fccType,
fccHandler,
dwFlags, // VIDCF_COMPRESSFRAMES,etc
dwVersion, //Version number of the driver.
dwVersionICM:Dword;
szName: array[0..15] of wideChar;
szDescription:array[0..127 ] of wideChar;
szDriver:array[0..127] of wideChar;
end;
PICINFO = ^TICINFO;
TAVIStreamInfoA = record
fccType,
fccHandler,
dwFlags,
dwCaps: DWORD;
wPriority,
wLanguage: WORD;
dwScale,
dwRate,
dwStart,
dwLength,
dwInitialFrames,
dwSuggestedBufferSize,
dwQuality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,
dwFormatChangeCount,
szName: array[0..63] of AnsiChar;
end;
TAVIStreamInfo = TAVIStreamInfoA;
TAVIStreamInfoW = record
fccType,
fccHandler,
dwFlags,
dwCaps: DWORD;
wPriority,
wLanguage: WORD;
dwScale,
dwRate,
dwStart,
dwLength,
dwInitialFrames,
dwSuggestedBufferSize,
dwQuality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,
dwFormatChangeCount,
szName: array[0..63] of WideChar;
end;
{ IAVIStream interface }
IAVIStream = class(TInterfacedObject) //;; /IUnknown;
function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall; abstract;
function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes: LONG; var plSamples: LONG): HResult; virtual; stdcall; abstract;
function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; virtual; stdcall; abstract;
function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual; stdcall; abstract;
function WriteData(fcc: DWORD; lp: PVOID; cb: LONG): HResult; virtual; stdcall; abstract;
function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIStream = ^IAVIStream;
IAVIFile = class( TInterfacedObject)
function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW): HResult; virtual; stdcall; abstract;
function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; virtual; stdcall; abstract;
function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; virtual; stdcall; abstract;
function EndRecord: HResult; virtual; stdcall; abstract;
function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIFile = ^IAVIFile;
procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; stdcall;
function AVIFileCreateStream(pfile: PAVIFile;
var ppavi: PAVISTREAM;
var psi: TAVIStreamInfoA): HResult; stdcall;
Function AVIMakeCompressedStream(
var ppavi: PAVIStream; pavi:PAVIStream;
pavo: PAVICOMPRESSOPTIONS ;
PCLSID:pointer):HResult; stdcall;
function AVIStreamSetFormat(
pavi: PAVIStream;
lPos: LONG; lpFormat: PVOID;
cbFormat: LONG): HResult; stdcall;
Function AVISaveOptions(HWND:Thandl e;uiFlags: UINT;nStre ams:intege r;
var ppavi:PAVISTREAM;plpOption s:pointer) :HResult; stdcall;
Function AVISaveOptionsFree(nStream s:integer; var plpOptions:pointer):HResul t; stdcall;
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; 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 ICCompressorChoose(hwnd:hw nd;uiflags :UINT;pvln :PVOID;lpd ata:Pvoid; pc:Pcompva rs;lpsztit le:LPSTR): Bool;stdca ll;
Function ICCompressGetSize(Hic:hwnd ; lpbiInput:PBITMAPINFOHEADE R;lpbiOutp ut:PBITMAP INFOHEADER ):Dword; stdcall;
Function ICInfo(fccType,fccHandler: FOURCC;ICI NFO:PICINF O):Bool;st dcall;
Function ICCompress(HIC:Thandle;dwF lags: DWORD; lpbiOutput:PBITMAPINFOHEAD ER;
lpData:Pointer;lpbiInput:P BITMAPINFO HEADER;lpB its:pointe r;lpckid:L PDWORD;
lpdwFlags:LPDWORD;lFrameNu m: LONG ;dwFrameSize: DWORD ;dwQuality:DWORD ;
lpbiPrev:PBITMAPINFOHEADER ; lpPrev:PVOID):Dword;stdcal l;
Function ICSeqCompressFrame(pc:PCOM PVARS;uiFl ags:UINT;l pBits:poin ter;Var pfKey:bool; var plSize:LONG):pointer;stdca ll;
Function ICSeqCompressFrameStart(pc :PCOMPVARS ;lpbiIn:PB ITMAPINFO) :bool; stdcall;
Function ICSeqCompressFrameEnd( pc:PCOMPVARS):Pvoid;stdcal l;
const
AVIERR_OK = 0;
AVIIF_LIST = $01;
AVIIF_TWOCC = $02;
AVIIF_KEYFRAME = $10;
ICMF_CHOOSE_ALLCOMPRESSORS = $01; //wrong
streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
IID_IAVIFile: TGUID = (
D1:$00020020;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IAVIStream: TGUID = (
D1:$00020021;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IAVIStreaming: TGUID = (
D1:$00020022;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IGetFrame: TGUID = (
D1:$00020023;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IAVIEditStream: TGUID = (
D1:$00020024;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
CLSID_AVISimpleUnMarshal: TGUID = (
D1:$00020009;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
CLSID_AVIFile: TGUID = (
D1:$00020000;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
implementation
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVIStream; var psi: TAVIStreamInfoA): HResult; external 'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; external 'avifil32.dll' name 'AVIStreamWrite';
function AVIStreamRelease(pavi: PAVIStream): ULONG; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease(pfile: PAVIFile): ULONG; external 'avifil32.dll' name 'AVIFileRelease';
Function AVISaveOptions(HWND:Thandl e;uiFlags: UINT;nStre ams:intege r;
var ppavi: PAVIStream;plpOptions:poin ter): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
Function AVISaveOptionsFree(nStream s:integer;
var plpOptions:pointer):HResul t;
stdcall; external 'avifil32.dll'
name 'AVISaveOptionsFree';
Function AVIMakeCompressedStream(
var ppavi: PAVIStream; pavi:PAVIStream;
pavo: PAVICOMPRESSOPTIONS ;PCLSID:pointer
):HResult; stdcall; external 'avifil32.dll'
name 'AVIMakeCompressedStream';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; external 'avifil32.dll' name 'AVIStreamSetFormat';
Function ICCompressGetSize(Hic:HWND ; lpbiInput:PBITMAPINFOHEADE R;lpbiOutp ut:PBITMAP INFOHEADER ):Dword; external 'MSVFW32.dll' name 'ICCompressGetSize';
Function ICInfo(fccType,fccHandler: FOURCC;ICI NFO:PICINF O):Bool;ex ternal 'MSVFW32.dll' name 'ICInfo';
Function ICCompress(HIC:Thandle;dwF lags: DWORD; lpbiOutput:PBITMAPINFOHEAD ER;
lpData:Pointer;lpbiInput:P BITMAPINFO HEADER;lpB its:pointe r;lpckid:L PDWORD;
lpdwFlags:PDWORD;lFrameNum : LONG ;dwFrameSize: DWORD ;dwQuality:DWORD ;
lpbiPrev:PBITMAPINFOHEADER ;lpPrev:PV OID):Dword ; external 'MSVFW32.dll' name 'ICCompress';
Function ICCompressorChoose(hwnd:hw nd;uiflags :UINT;pvln :PVOID;
lpdata:Pvoid;pc:Pcompvars; lpsztitle: LPSTR):Boo l; external 'MSVFW32.dll' name 'ICCompressorChoose';
Function ICSeqCompressFrame(pc:PCOM PVARS;uiFl ags:UINT;l pBits:poin ter;Var pfKey:bool;var plSize:LONG):pointer;
external 'MSVFW32.dll' name 'ICSeqCompressFrame';
Function ICSeqCompressFrameStart(pc :PCOMPVARS ;lpbiIn:PB ITMAPINFO) :bool;exte rnal 'MSVFW32.dll' name 'ICSeqCompressFrameStart';
Function ICSeqCompressFrameEnd( pc:PCOMPVARS):Pvoid;
external 'MSVFW32.dll' name 'ICSeqCompressFrameEnd';
end.
// ----------------- snip and save as DeVFW.pas -----------
// Raymond, on a clean form add a button, drop this in.
// should run, but this snippet version wont save
// the avi format cause I tried to simplify
// and stripped out a bit to much, I can fix tomarrow and send back.
// This tries to create 50 frames. The color management
// code has been left out to save space.
procedure TForm1.Button1Click(Sender
var
StdHdr: TAVIStreamInfo;
pfile: PAVIFile;
ps,psCompressed: PAVIStream;
opts:TAVICOMPRESSOPTIONS;
aOpts:array[0..0] of pointer;
FRAME,X,i: Integer;
nul: lONG;
nul2: lONG;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
BitmapInfoSize: Dword;
BitmapSize: Dword;
NumbEROfColors:Integer;
er:long;
bm:Tbitmap;
Procedure DrawSomeThingOnBitmap(FRAM
with bm.Canvas do begin fillrect(cliprect);
textout(5*frame,60,'Delphi
begin
ps:=nil; psCompressed:=nil;
aOpts[0]:=allocmem(sizeof(
fillchar(aopts[0]^,sizeof(
AVIFileInit;
if fileExists('e:\avicreate\t
if AVIFileOpen(pfile, 'e:\avicreate\test.avi',
OF_WRITE or OF_CREATE, nil)=AVIERR_OK then
begin
bm:=tbitmap.create; // make a bitmap to play with
bm.width:=180; bm.height:=120;
bm.PixelFormat:=pf8bit;
bm.Canvas.brush.color:=clb
bm.Canvas.font.color:=clYe
bm.Canvas.font.size:=24;
bm.Canvas.FillRect(bm.canv
GetDIBSizes(bm.Handle,Bitm
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
GetDIB(bm.Handle,0,BitmapI
FillChar(StdHdr,sizeof(Std
StdHdr.fccType := streamtypeVIDEO;
StdHdr.fccHandler := 0;
StdHdr.dwScale := 1;
StdHdr.dwRate := 30;
StdHdr.dwSuggestedBufferSi
StdHdr.rcFrame.Right := BitmapInfo^.biWidth ;
StdHdr.rcFrame.Bottom := BitmapInfo^.biHeight;
if AVIFileCreateStream(pfile,
{#3} if AviSaveOptions(handle,0,1,
{#4} if AviMakeCompressedStream(ps
PAVICOMPRESSOPTIONS(@opts)
{#5} IF AVIStreamSetFormat(psCompr
(BitmapInfo.biSize+BitmapI
= AVIERR_OK THEN
begin
FRAME:=-1;
FOR X:=0 TO 49 DO // make 50 frames
begin
FRAME:=FRAME+1;
DrawSomeThingOnBitmap(FRAM
canvas.draw(100,100,bm); // draw to show it's kinda working
GetDIB(bm.Handle,0,BitmapI
if AVIStreamWrite(psCompresse
(BitmapInfo^.biSize+Bitmap
AVIIF_KEYFRAME,
nul,nul2)<>AVIERR_OK then
begin raise Exception.Create('Could not add frame');break;end;
end;
end;
// Free leftovers
bm.free;
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
freemem( pointer(aOpts[0]));
AVISaveOptionsFree(1,point
AVIStreamRelease(ps);
AVIStreamRelease(psCompres
AVIFileRelease(pfile);
AVIFileExit;
APPLICATION.PROCESSMESSAGE
end;
end;
// ----------------- snip and save as DeVFW.pas -----------
////add deVFW; to uses clause of clean form
unit DeVFW; // This has been around, various contributors sz3905'99
interface // the extra junk is for the rest of the project
uses Windows, SysUtils,mmsystem, Classes;
type
LONG = Longint;
PVOID = Pointer;
PCLSID=Pointer;
TAVIFileInfoW = record
dwMaxBytesPerSec,
dwFlags,
dwCaps,
dwStreams,
dwSuggestedBufferSize,
dwWidth,
dwHeight,
dwScale,
dwRate,
dwLength,
dwEditCount: DWORD;
szFileType: array[0..63] of WideChar;
end;
PAVIFileInfoW = ^TAVIFileInfoW;
TAVICOMPRESSOPTIONS = record //12/6/99sbs
fccType, // typically = streamtypeVIDEO
fccHandler, // mmioFOURCC('M','S','V','C'
dwKeyFrameEvery, //Maximum period between video key frames
dwQuality,
dwFlags,
dwBytesPerSecond :Dword;
lpFormat:Pointer; // For an audio stream, this is an LPWAVEFORMAT structure.
cbFormat:DWORD; //Size, in bytes, of the data referenced by lpFormat.
lpParms:pointer; //Video-compressor-specifi
cbParms:DWORD; //Size, in bytes, of the data referenced by lpParms
dwInterleaveEvery:DWORD; //Interleave factor for interspersing stream data
end;
PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS;
TCOMPVARS = record //12/6/99sbs
cbSize:LONG;
dwFlags:DWORD ;
hic:hwnd; // handle of compressor to use
fccType, fccHandler:DWORD ;
lpbiIn:PBITMAPINFO;
lpbiOut:PBITMAPINFO;
lpBitsOut,lpBitsPrev:PVOID
lFrame,lKey,lDataRate,lQ,l
lpState:PVOID ;
cbState:LONG ;
end;
PCOMPVARS = ^TCompvars;
TICINFO = record // //12/6/99sbs video compression drivers info(via enumeration)
dwSize, //Size, in bytes, of the ICINFO structure.
fccType,
fccHandler,
dwFlags, // VIDCF_COMPRESSFRAMES,etc
dwVersion, //Version number of the driver.
dwVersionICM:Dword;
szName: array[0..15] of wideChar;
szDescription:array[0..127
szDriver:array[0..127] of wideChar;
end;
PICINFO = ^TICINFO;
TAVIStreamInfoA = record
fccType,
fccHandler,
dwFlags,
dwCaps: DWORD;
wPriority,
wLanguage: WORD;
dwScale,
dwRate,
dwStart,
dwLength,
dwInitialFrames,
dwSuggestedBufferSize,
dwQuality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,
dwFormatChangeCount,
szName: array[0..63] of AnsiChar;
end;
TAVIStreamInfo = TAVIStreamInfoA;
TAVIStreamInfoW = record
fccType,
fccHandler,
dwFlags,
dwCaps: DWORD;
wPriority,
wLanguage: WORD;
dwScale,
dwRate,
dwStart,
dwLength,
dwInitialFrames,
dwSuggestedBufferSize,
dwQuality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,
dwFormatChangeCount,
szName: array[0..63] of WideChar;
end;
{ IAVIStream interface }
IAVIStream = class(TInterfacedObject) //;; /IUnknown;
function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall; abstract;
function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes: LONG; var plSamples: LONG): HResult; virtual; stdcall; abstract;
function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; virtual; stdcall; abstract;
function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual; stdcall; abstract;
function WriteData(fcc: DWORD; lp: PVOID; cb: LONG): HResult; virtual; stdcall; abstract;
function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIStream = ^IAVIStream;
IAVIFile = class( TInterfacedObject)
function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW): HResult; virtual; stdcall; abstract;
function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; virtual; stdcall; abstract;
function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; virtual; stdcall; abstract;
function EndRecord: HResult; virtual; stdcall; abstract;
function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIFile = ^IAVIFile;
procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; stdcall;
function AVIFileCreateStream(pfile:
var ppavi: PAVISTREAM;
var psi: TAVIStreamInfoA): HResult; stdcall;
Function AVIMakeCompressedStream(
var ppavi: PAVIStream; pavi:PAVIStream;
pavo: PAVICOMPRESSOPTIONS ;
PCLSID:pointer):HResult; stdcall;
function AVIStreamSetFormat(
pavi: PAVIStream;
lPos: LONG; lpFormat: PVOID;
cbFormat: LONG): HResult; stdcall;
Function AVISaveOptions(HWND:Thandl
var ppavi:PAVISTREAM;plpOption
Function AVISaveOptionsFree(nStream
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; 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 ICCompressorChoose(hwnd:hw
Function ICCompressGetSize(Hic:hwnd
Function ICInfo(fccType,fccHandler:
Function ICCompress(HIC:Thandle;dwF
lpData:Pointer;lpbiInput:P
lpdwFlags:LPDWORD;lFrameNu
lpbiPrev:PBITMAPINFOHEADER
Function ICSeqCompressFrame(pc:PCOM
Function ICSeqCompressFrameStart(pc
Function ICSeqCompressFrameEnd( pc:PCOMPVARS):Pvoid;stdcal
const
AVIERR_OK = 0;
AVIIF_LIST = $01;
AVIIF_TWOCC = $02;
AVIIF_KEYFRAME = $10;
ICMF_CHOOSE_ALLCOMPRESSORS
streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
IID_IAVIFile: TGUID = (
D1:$00020020;D2:$0;D3:$0;D
IID_IAVIStream: TGUID = (
D1:$00020021;D2:$0;D3:$0;D
IID_IAVIStreaming: TGUID = (
D1:$00020022;D2:$0;D3:$0;D
IID_IGetFrame: TGUID = (
D1:$00020023;D2:$0;D3:$0;D
IID_IAVIEditStream: TGUID = (
D1:$00020024;D2:$0;D3:$0;D
CLSID_AVISimpleUnMarshal: TGUID = (
D1:$00020009;D2:$0;D3:$0;D
CLSID_AVIFile: TGUID = (
D1:$00020000;D2:$0;D3:$0;D
implementation
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile:
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; external 'avifil32.dll' name 'AVIStreamWrite';
function AVIStreamRelease(pavi: PAVIStream): ULONG; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease(pfile: PAVIFile): ULONG; external 'avifil32.dll' name 'AVIFileRelease';
Function AVISaveOptions(HWND:Thandl
var ppavi: PAVIStream;plpOptions:poin
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
Function AVISaveOptionsFree(nStream
var plpOptions:pointer):HResul
stdcall; external 'avifil32.dll'
name 'AVISaveOptionsFree';
Function AVIMakeCompressedStream(
var ppavi: PAVIStream; pavi:PAVIStream;
pavo: PAVICOMPRESSOPTIONS ;PCLSID:pointer
):HResult; stdcall; external 'avifil32.dll'
name 'AVIMakeCompressedStream';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult; external 'avifil32.dll' name 'AVIStreamSetFormat';
Function ICCompressGetSize(Hic:HWND
Function ICInfo(fccType,fccHandler:
Function ICCompress(HIC:Thandle;dwF
lpData:Pointer;lpbiInput:P
lpdwFlags:PDWORD;lFrameNum
lpbiPrev:PBITMAPINFOHEADER
Function ICCompressorChoose(hwnd:hw
lpdata:Pvoid;pc:Pcompvars;
Function ICSeqCompressFrame(pc:PCOM
external 'MSVFW32.dll' name 'ICSeqCompressFrame';
Function ICSeqCompressFrameStart(pc
Function ICSeqCompressFrameEnd( pc:PCOMPVARS):Pvoid;
external 'MSVFW32.dll' name 'ICSeqCompressFrameEnd';
end.
// ----------------- snip and save as DeVFW.pas -----------
Hi Steve,
I have done as you said, and I think it works! I can trace through the code and all the calls seem to work (I saw some blue squares with text on them flash up on the form), I chose uncompressed frames though, which may have been a cop out :-)
You might like to include the constants for these errors in your API:
AVIERR_NOCOMPRESSOR A suitable compressor cannot be found.
AVIERR_MEMORY There is not enough memory to complete the operation.
AVIERR_UNSUPPORTED Compression is not supported for this type of data. This error might be returned if you try to compress data that is not audio or video.
For what its worth I am using D4.03 on NT4 SP4
Cheers,
Raymond.
I have done as you said, and I think it works! I can trace through the code and all the calls seem to work (I saw some blue squares with text on them flash up on the form), I chose uncompressed frames though, which may have been a cop out :-)
You might like to include the constants for these errors in your API:
AVIERR_NOCOMPRESSOR A suitable compressor cannot be found.
AVIERR_MEMORY There is not enough memory to complete the operation.
AVIERR_UNSUPPORTED Compression is not supported for this type of data. This error might be returned if you try to compress data that is not audio or video.
For what its worth I am using D4.03 on NT4 SP4
Cheers,
Raymond.
ASKER
Raymond,
Thanks for tring it. Yea, it runs but dont work.
When you saw the blue it meant it was making the 50 frames.
But the frames, they are crazy frames. If you where to change the code to actually save the "MS Video 1" format
(#3avisaveoption & #4avimakecompressedsteam) The format will save but a major mem leak occurs. Other compressors will work better(Indeo R3.2). Can I offer 500 more points to help me finish it up? (I dont know how many of the 1.5k points will actually be awarded you.)
If not I understand. I'll get through it sooner or later.
I thank you for your expert insight on this in any event.
Best regards, sz3905/steve
Thanks for tring it. Yea, it runs but dont work.
When you saw the blue it meant it was making the 50 frames.
But the frames, they are crazy frames. If you where to change the code to actually save the "MS Video 1" format
(#3avisaveoption & #4avimakecompressedsteam) The format will save but a major mem leak occurs. Other compressors will work better(Indeo R3.2). Can I offer 500 more points to help me finish it up? (I dont know how many of the 1.5k points will actually be awarded you.)
If not I understand. I'll get through it sooner or later.
I thank you for your expert insight on this in any event.
Best regards, sz3905/steve
When you say:
>The format will save but a major mem leak occurs.
Do you mean that it saves it correctly, but you end up with a memory leak?
If so I think you need to use these calls:
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;
To free the memory allocated to the AVI file and streams. This should solve your memory leak.
Cheers,
Raymond.
>The format will save but a major mem leak occurs.
Do you mean that it saves it correctly, but you end up with a memory leak?
If so I think you need to use these calls:
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;
To free the memory allocated to the AVI file and streams. This should solve your memory leak.
Cheers,
Raymond.
DOH! Reading your code again I see you do free them. Sigh!
Cheers,
Raymond.
Cheers,
Raymond.
Hi,
Here is something I wrote a few months ago for creating AVI files.
You basically do this.
AviFile := TAviFile.Create('MyAvi.avi ', 15);
try
AviFile.AddFrame(File1.bmp );
AviFile.AddFrame(File2.bmp );
finally
AviFile.Free;
end;
>>>>>>>>>>>>>
unit AviFile;
interface
uses Windows, Classes, Graphics, SysUtils, DIBitmap, Vfw;
type
TAviFile = class (TObject)
private
FAviFileName: string;
FAviFileHandle: PAviFile;
FAviStream: PAVIStream;
FFrameRate: Integer;
FFrameIndex: Integer;
function OpenAviFile(AAviFileName: string; ABmp: TBitmap; AFrameRate: Integer): PAviFile;
procedure CloseAviFile(AAviFileHandl e: PAviFile);
protected
public
constructor Create(AAviFileName: string; AFrameRate: Integer = 15);
destructor Destroy; override;
procedure AddFrame(ABmp: TBitmap); overload;
procedure AddFrame(ABmpFileName: string); overload;
procedure AddFrames(ABmpFileNames: TStrings);
end;
implementation
{ TAviFile }
const
GBitCounts: array [pf1Bit..pf32Bit] of Byte = (1, 4, 8, 16, 16, 24, 32);
constructor TAviFile.Create(AAviFileNa me: string; AFrameRate: Integer);
begin
inherited Create;
FAviFileName := AAviFileName;
FAviFileHandle := nil;
FFrameRate := AFrameRate;
FFrameIndex := 0;
end;
destructor TAviFile.Destroy;
begin
if FAviFileHandle <> nil then
begin
CloseAviFile(FAviFileHandl e);
FAviFileHandle := nil;
end;
inherited Destroy;
end;
function TAviFile.OpenAviFile(AAviF ileName: string; ABmp: TBitmap; AFrameRate: Integer): PAviFile;
var BitmapInfoSize: Integer;
BitmapSize: DWORD;
AviStreamInfo: TAVIStreamInfo;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
begin
AVIFileInit;
if AVIFileOpen(Result, PChar(AAviFileName), OF_WRITE or OF_CREATE, nil) <> AVIERR_OK then
begin
raise Exception.Create('Unable to create AVI file because an error occurred writing to ''' + AAviFileName + '''.');
end;
InternalGetDIBSizes(ABmp.H andle, BitmapInfoSize, BitmapSize, 0);
ZeroMemory(@AviStreamInfo, SizeOf(AviStreamInfo));
AviStreamInfo.fccType := streamtypeVIDEO;
AviStreamInfo.fccHandler := 0;
AviStreamInfo.dwScale := 1;
AviStreamInfo.dwRate := AFrameRate;
AviStreamInfo.dwSuggestedB ufferSize := BitmapSize;
AviStreamInfo.rcFrame.Righ t := ABmp.Width;
AviStreamInfo.rcFrame.Bott om := ABmp.Height;
if AVIFileCreateStream(Result , FAviStream, AviStreamInfo) <> AVIERR_OK then
begin
raise Exception.Create('Unable to create AVI file because an error occurred creating the AVI stream.');
end;
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
try
InternalGetDIB(ABmp.Handle , 0, BitmapInfo^, BitmapBits^, 0);
if AVIStreamSetFormat(FAviStr eam, 0, BitmapInfo, BitmapInfoSize) <> AVIERR_OK then
begin
raise Exception.Create('Unable to create AVI file because an error occurred setting the AVI stream format.');
end;
finally
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
end;
end;
procedure TAviFile.CloseAviFile(AAvi FileHandle : PAviFile);
begin
AVIStreamRelease(FAviStrea m);
FAviStream := nil;
AVIFileRelease(AAviFileHan dle);
AVIFileExit;
end;
procedure TAviFile.AddFrame(ABmp: TBitmap);
var BitmapInfoSize: Integer;
BitmapSize: DWORD;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
Dummy: LongInt;
begin
if (FAviFileHandle = nil) or (FAviStream = nil) then
begin
FAviFileHandle := OpenAviFile(FAviFileName, ABmp, FFrameRate);
end;
InternalGetDIBSizes(ABmp.H andle, BitmapInfoSize, BitmapSize, 0);
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
try
InternalGetDIB(ABmp.Handle , 0, BitmapInfo^, BitmapBits^, 0);
if AVIStreamWrite(FAviStream, FFrameIndex, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME, Dummy, Dummy) <> AVIERR_OK then
begin
raise Exception.Create('An error occurred adding a frame to ''' + FAviFileName + '''.');
end;
finally
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
end;
Inc(FFrameIndex);
end;
procedure TAviFile.AddFrame(ABmpFile Name: string);
var Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(ABmpFileN ame);
AddFrame(Bmp);
finally
Bmp.Free;
end;
end;
procedure TAviFile.AddFrames(ABmpFil eNames: TStrings);
var Index: Integer;
begin
for Index := 0 to ABmpFileNames.Count - 1 do
begin
AddFrame(ABmpFileNames[Ind ex]);
end;
end;
end.
<<<<<<<<<<<<<<
Here is something I wrote a few months ago for creating AVI files.
You basically do this.
AviFile := TAviFile.Create('MyAvi.avi
try
AviFile.AddFrame(File1.bmp
AviFile.AddFrame(File2.bmp
finally
AviFile.Free;
end;
>>>>>>>>>>>>>
unit AviFile;
interface
uses Windows, Classes, Graphics, SysUtils, DIBitmap, Vfw;
type
TAviFile = class (TObject)
private
FAviFileName: string;
FAviFileHandle: PAviFile;
FAviStream: PAVIStream;
FFrameRate: Integer;
FFrameIndex: Integer;
function OpenAviFile(AAviFileName: string; ABmp: TBitmap; AFrameRate: Integer): PAviFile;
procedure CloseAviFile(AAviFileHandl
protected
public
constructor Create(AAviFileName: string; AFrameRate: Integer = 15);
destructor Destroy; override;
procedure AddFrame(ABmp: TBitmap); overload;
procedure AddFrame(ABmpFileName: string); overload;
procedure AddFrames(ABmpFileNames: TStrings);
end;
implementation
{ TAviFile }
const
GBitCounts: array [pf1Bit..pf32Bit] of Byte = (1, 4, 8, 16, 16, 24, 32);
constructor TAviFile.Create(AAviFileNa
begin
inherited Create;
FAviFileName := AAviFileName;
FAviFileHandle := nil;
FFrameRate := AFrameRate;
FFrameIndex := 0;
end;
destructor TAviFile.Destroy;
begin
if FAviFileHandle <> nil then
begin
CloseAviFile(FAviFileHandl
FAviFileHandle := nil;
end;
inherited Destroy;
end;
function TAviFile.OpenAviFile(AAviF
var BitmapInfoSize: Integer;
BitmapSize: DWORD;
AviStreamInfo: TAVIStreamInfo;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
begin
AVIFileInit;
if AVIFileOpen(Result, PChar(AAviFileName), OF_WRITE or OF_CREATE, nil) <> AVIERR_OK then
begin
raise Exception.Create('Unable to create AVI file because an error occurred writing to ''' + AAviFileName + '''.');
end;
InternalGetDIBSizes(ABmp.H
ZeroMemory(@AviStreamInfo,
AviStreamInfo.fccType := streamtypeVIDEO;
AviStreamInfo.fccHandler := 0;
AviStreamInfo.dwScale := 1;
AviStreamInfo.dwRate := AFrameRate;
AviStreamInfo.dwSuggestedB
AviStreamInfo.rcFrame.Righ
AviStreamInfo.rcFrame.Bott
if AVIFileCreateStream(Result
begin
raise Exception.Create('Unable to create AVI file because an error occurred creating the AVI stream.');
end;
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
try
InternalGetDIB(ABmp.Handle
if AVIStreamSetFormat(FAviStr
begin
raise Exception.Create('Unable to create AVI file because an error occurred setting the AVI stream format.');
end;
finally
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
end;
end;
procedure TAviFile.CloseAviFile(AAvi
begin
AVIStreamRelease(FAviStrea
FAviStream := nil;
AVIFileRelease(AAviFileHan
AVIFileExit;
end;
procedure TAviFile.AddFrame(ABmp: TBitmap);
var BitmapInfoSize: Integer;
BitmapSize: DWORD;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
Dummy: LongInt;
begin
if (FAviFileHandle = nil) or (FAviStream = nil) then
begin
FAviFileHandle := OpenAviFile(FAviFileName, ABmp, FFrameRate);
end;
InternalGetDIBSizes(ABmp.H
BitmapInfo := AllocMem(BitmapInfoSize);
BitmapBits := AllocMem(BitmapSize);
try
InternalGetDIB(ABmp.Handle
if AVIStreamWrite(FAviStream,
begin
raise Exception.Create('An error occurred adding a frame to ''' + FAviFileName + '''.');
end;
finally
FreeMem(BitmapInfo);
FreeMem(BitmapBits);
end;
Inc(FFrameIndex);
end;
procedure TAviFile.AddFrame(ABmpFile
var Bmp: TBitmap;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile(ABmpFileN
AddFrame(Bmp);
finally
Bmp.Free;
end;
end;
procedure TAviFile.AddFrames(ABmpFil
var Index: Integer;
begin
for Index := 0 to ABmpFileNames.Count - 1 do
begin
AddFrame(ABmpFileNames[Ind
end;
end;
end.
<<<<<<<<<<<<<<
Nice piece of code Phil!
Cheers,
Raymond.
Cheers,
Raymond.
ASKER
Raymond,
Yep, we try to free-um if we get that far. Actually this piece-o-code is very explosive, should only be tried on Nt4.
I wouldn't try it without setting a few break points first.
The memleaks only occur when using the MS Video 1 compressor. Not sure that they are mem leaks, could be brain leaks. The CPU debug window pops up when it happens, and is pointing to nowhere, then Delphi gets really ill and starts knashing her teeth. (may have to restart her)
Phil,
Like your clean style. Have you ever considered adding compression? Would be lots-o-fun! What do you use for VFW?
Thanks Experts!
Yur the Best
sz3905/steve
Yep, we try to free-um if we get that far. Actually this piece-o-code is very explosive, should only be tried on Nt4.
I wouldn't try it without setting a few break points first.
The memleaks only occur when using the MS Video 1 compressor. Not sure that they are mem leaks, could be brain leaks. The CPU debug window pops up when it happens, and is pointing to nowhere, then Delphi gets really ill and starts knashing her teeth. (may have to restart her)
Phil,
Like your clean style. Have you ever considered adding compression? Would be lots-o-fun! What do you use for VFW?
Thanks Experts!
Yur the Best
sz3905/steve
Hi Steve,
I have vfw.pas which is a port of vfw.h, and DIBitmap.pas is a port of DIBitmap.c/h. I didn't write either of them but if you want, I'll paste them here.
I wrote it to hook together just a few bitmaps to get small animations like those in win explorer, so I wasn't concerned with compression. I agree it would be fun though!
Cheers,
Phil.
I have vfw.pas which is a port of vfw.h, and DIBitmap.pas is a port of DIBitmap.c/h. I didn't write either of them but if you want, I'll paste them here.
I wrote it to hook together just a few bitmaps to get small animations like those in win explorer, so I wasn't concerned with compression. I agree it would be fun though!
Cheers,
Phil.
ASKER
Hi Phil,
Does your vfw have all of the prototypes that I've been mangling here? If so please post or send it to me. May save some time and more knashing-of-the-teeth. {:-) Thx/steve sz3905@ucdavis.edu
Maybe we can get this working, then you'll have lots-o-fun to! Sorry bout my english, I was born in Los Angeles.
Does your vfw have all of the prototypes that I've been mangling here? If so please post or send it to me. May save some time and more knashing-of-the-teeth. {:-) Thx/steve sz3905@ucdavis.edu
Maybe we can get this working, then you'll have lots-o-fun to! Sorry bout my english, I was born in Los Angeles.
OK, I have sent it your way.
Los Angeles? I've only been to your airport! I'm from NZ. Practically noone could understand my english. Apparently I have an accent, how misguided!! ;-)
Cheers,
Phil.
Los Angeles? I've only been to your airport! I'm from NZ. Practically noone could understand my english. Apparently I have an accent, how misguided!! ;-)
Cheers,
Phil.
ASKER
Phil.
Got it thanks. I'll use the missing pieces you've provided.
Any idea where we could find an actual working delphi
AVIMakeCompressedStream and AVISaveoptions protos that work? I'd really like to put out/post a working version of this so others wont have to go through this compression pointer depression stuff. [:-)
/steve
Got it thanks. I'll use the missing pieces you've provided.
Any idea where we could find an actual working delphi
AVIMakeCompressedStream and AVISaveoptions protos that work? I'd really like to put out/post a working version of this so others wont have to go through this compression pointer depression stuff. [:-)
/steve
Sorry Steve,
But that's all I've got.
Cheers anyway,
Phil.
But that's all I've got.
Cheers anyway,
Phil.
Can you give us an idea of the size of the memory leak you are having?
If you run it more that once, does the memory allocated to the app increase? NT has a habit of not reporting memory decreases for an app even after the memory has been freed.
Cheers,
Raymond.
If you run it more that once, does the memory allocated to the app increase? NT has a habit of not reporting memory decreases for an app even after the memory has been freed.
Cheers,
Raymond.
ASKER
Experts, sorry I posted the code again(it's ugly). This is the current shared version that works, it may or may not have potential.
Raymond,
Scrap the previous version.
It seems changing the number colors freaks certain compressors out. 8 bit works with some 24 bit works with others.
The following works with MS Video 1, but not with Indeo R3.2 (memleak? not) unless you change numberofColors to 256.
Figure it out, the points are yours. Thx again!
Phil,
Heres the code so you can have lots-o-fun with compression. It's still very dangerous w/out error traps, but it do work.
The DrawSomeThingOnBitmap proc is where I'd put my image manipulation code. cYa
// This makes a blue 90 frame 24 bit avi with the word "delphi"
// going left to right in yellow @ 30 frames pers sec
procedure TForm1.Button1Click(Sender : TObject);
var// you must add dibitmap, devfw to your uses clause
StdHdr: TAVIStreamInfo; //DIBITMAP.PAS is public code
pfile: PAVIFile; // and is needed to make this work
ps,psCompressed: PAVIStream;
opts:TAVICOMPRESSOPTIONS;
aOpts:array[0..0] of pointer;
FRAME,X: Integer;
nul,nul2: lONG;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
BitmapSize,options: Dword;
BitmapInfoSize,NumbEROfCol ors:Intege r;
bm:Tbitmap;
Procedure DrawSomeThingOnBitmap(FRAM E:integer) ; begin
with bm.Canvas do begin fillrect(cliprect);
textout(frame,60,'Delphi') ; Refresh; end; end;
begin
numberofcolors:=0; //{24bit}
options:=0; //number of compression options in dialogbx 0-7
fillchar(Opts,sizeof(TAVIC OMPRESSOPT IONS),0);
aOpts[0]:=@opts; AVIFileInit;
if AVIFileOpen(pfile, 'test.avi',
OF_WRITE or OF_CREATE, nil)=AVIERR_OK then
begin
bm:=tbitmap.create;with bm do begin // make a 24bit dummy bitmap to play with
width:=180; bm.height:=120;PixelFormat :=pf24bit;
Canvas.brush.color:=clblue ;
Canvas.font.color:=clYello w;Canvas.f ont.size:= 24;
Canvas.FillRect(canvas.cli prect);end ;
InternalGetDIBSizes(bm.Han dle,Bitmap InfoSize,B itmapSize, numberOfCo lors);
BitmapInfo := AllocMem(BitmapInfoSize); // save bm's params for avistream
BitmapBits := AllocMem(BitmapSize);
InternalGetDIB(bm.Handle,0 ,BitmapInf o^,BitmapB its^,numbe rOfColors) ; //WAS 256
FillChar(StdHdr,sizeof(Std Hdr),0);
StdHdr.fccType := streamtypeVIDEO;
StdHdr.fccHandler := 0;StdHdr.dwScale := 1;
StdHdr.dwRate := 30; //30 frames pers sec
StdHdr.dwSuggestedBufferSi ze :=BitmapInfo^.biSizeImage;
StdHdr.rcFrame.Right := BitmapInfo^.biWidth ;
StdHdr.rcFrame.Bottom := BitmapInfo^.biHeight;
if AVIFileCreateStream(pfile, ps,StdHdr) = AVIERR_OK then
if AviSaveOptions(handle,Opti ons,1,ps,P OINTER(aOp ts)) > AVIERR_OK then
if AviMakeCompressedStream(PO INTER(psCo mpressed), ps,
@opts,nil) = AVIERR_OK then
IF AVIStreamSetFormat(psCompr essed,0,Bi tmapInfo,
(BitmapInfo.biSize+BitmapI nfo.biClrU sed)*sizeo f(TrgbQuad ))=AVIERR_ OK THEN
begin
FRAME:=-1;
FOR X:=0 TO 89 DO // make 50 frames
begin
FRAME:=FRAME+1;
DrawSomeThingOnBitmap(FRAM E); // alter the bitmap for this frame
canvas.draw(100,100,bm); // draw it to show it's kinda working
InternalGetDIB(bm.Handle,0 ,BitmapInf o^,BitmapB its^,numbe rOfColors) ;
AVIStreamWrite(psCompresse d,FRAME,1, BitmapBits ,
(BitmapInfo^.biSize+Bitmap Info^.biCl rUsed)*siz eof(TrgbQu ad), AVIIF_KEYFRAME,nul,nul2);
end;
end;
bm.free;// Free leftovers
FreeMem(BitmapInfo); FreeMem(BitmapBits);
AVIStreamRelease(PAVIStrea m(ps));
AVIStreamRelease(PAVIStrea m(psCompre ssed));
AVIFileRelease(pfile);
pfile:=nil;ps:=nil;psCompr essed:=nil ;
AVIFileExit;
APPLICATION.PROCESSMESSAGE S;
end;
end;
========== begin cut and save as devfw.pas ==========
unit DeVFW; // This has been around, various contributors sz3905'99
interface // Also from Phil in NZ
uses Windows, SysUtils,mmsystem, Classes;
type
HResult = Longint;
PGUID = ^TGUID;
TGUID = record
D1: Longint;D2: Word;D3: Word;
D4: array[0..7] of Byte;
end;
PIID = PGUID;TIID = TGUID;
PCLSID = PGUID;TCLSID = TGUID;
IUnknown = class
public
function QueryInterface(const iid: TIID; var obj): HResult; virtual; stdcall; abstract;
function AddRef: Longint; virtual; stdcall; abstract;
function Release: Longint; virtual; stdcall; abstract;
end;
type
LONG = Longint;
PVOID = Pointer;
TAVIFileInfoW = record
dwMaxBytesPerSec,dwFlags,
dwCaps,dwStreams,dwSuggest edBufferSi ze,
dwWidth,dwHeight,dwScale,d wRate,
dwLength,dwEditCount: DWORD;
szFileType: array[0..63] of WideChar;
end;
PAVIFileInfoW = ^TAVIFileInfoW;
TAVICOMPRESSOPTIONS = record //12/6/99sbs
fccType,fccHandler,dwKeyFr ameEvery,
dwQuality,dwFlags,dwBytesP erSecond :Dword;
lpFormat:Pointer;cbFormat: DWORD;
lpParms:pointer;cbParms:DW ORD;
dwInterleaveEvery:DWORD;
end;
PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS;
TAVIStreamInfoA = record
fccType,fccHandler,dwFlags ,dwCaps: DWORD;
wPriority,wLanguage: WORD;
dwScale,dwRate,dwStart,
dwLength,dwInitialFrames,
dwSuggestedBufferSize,dwQu ality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,dwFormatChange Count,
szName: array[0..63] of AnsiChar;
end;
TAVIStreamInfo = TAVIStreamInfoA;
TAVIStreamInfoW = record
fccType,fccHandler,dwFlags ,dwCaps: DWORD;
wPriority,wLanguage: WORD;
dwScale,dwRate,dwStart,dwL ength,dwIn itialFrame s,
dwSuggestedBufferSize,dwQu ality,dwSa mpleSize: DWORD;
rcFrame: TRect;dwEditCount,dwFormat ChangeCoun t,
szName: array[0..63] of WideChar;
end;
{ IAVIStream interface }
IAVIStream = class(Iunknown)
function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall; abstract;
function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes: LONG; var plSamples:
LONG): HResult; virtual; stdcall; abstract;
function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten:
LONG; var plBytesWritten: LONG): HResult; virtual; stdcall; abstract;
function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual; stdcall; abstract;
function WriteData(fcc: DWORD; lp: PVOID; cb: LONG): HResult; virtual; stdcall; abstract;
function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIStream = ^IAVIStream;
IAVIFile = class( IunKnown)
function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG): HResult; virtual; stdcall;
abstract;
function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW): HResult; virtual; stdcall; abstract;
function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; virtual; stdcall; abstract;
function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; virtual; stdcall; abstract;
function EndRecord: HResult; virtual; stdcall; abstract;
function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIFile = ^IAVIFile;
procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; stdcall;
function AVIFileCreateStream(pfile: PAVIFile;
var ppavi: PAVISTREAM; var psi: TAVIStreamInfoA): HResult; stdcall;
Function AVIMakeCompressedStream(va r ppavi: POINTER; pavi:PAVIStream;
pavo: pointer ;PCLSID:pointer):HResult; stdcall;
function AVIStreamSetFormat(pavi: PAVIStream;lPos: LONG; lpFormat: PVOID;
cbFormat: LONG): HResult; stdcall;
Function AVISaveOptions(HWND:Thandl e;uiFlags: UINT;nStre ams:intege r;
var ppavi:PAVISTREAM;var plpOptions:pointer):HResul t; stdcall;
Function AVISaveOptionsFree(nStream s:integer; var plpOptions:pointer):HResul t; stdcall;
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags:
DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; stdcall;
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;
const
AVIERR_OK = 0;
AVIIF_LIST = $01;
AVIIF_TWOCC = $02;
AVIIF_KEYFRAME = $10;
ICMF_CHOOSE_ALLCOMPRESSORS = $01; //wrong
streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
IID_IAVIFile: TGUID = (
D1:$00020020;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IAVIStream: TGUID = (
D1:$00020021;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IAVIStreaming: TGUID = (
D1:$00020022;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IGetFrame: TGUID = (
D1:$00020023;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
IID_IAVIEditStream: TGUID = (
D1:$00020024;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
CLSID_AVISimpleUnMarshal: TGUID = (
D1:$00020009;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
CLSID_AVIFile: TGUID = (
D1:$00020000;D2:$0;D3:$0;D 4:($C0,$0, $0,$0,$0,$ 0,$0,$46)) ;
implementation
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; external
'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVIStream; var psi: TAVIStreamInfoA): HResult; external
'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamWrite(pavi: PAVIStream; lStart,
lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags:
DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; external 'avifil32.dll' name
'AVIStreamWrite';
function AVIStreamRelease(pavi: PAVIStream): ULONG; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease(pfile: PAVIFile): ULONG; external 'avifil32.dll' name 'AVIFileRelease';
Function AVISaveOptions(HWND:Thandl e;uiFlags: UINT;nStre ams:intege r;
var ppavi: PAVIStream;var plpOptions:pointer): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
Function AVISaveOptionsFree(nStream s:integer;
var plpOptions:pointer):HResul t;stdcall; external 'avifil32.dll'
name 'AVISaveOptionsFree';
Function AVIMakeCompressedStream(va r ppavi: POINTER; pavi:PAVIStream;
pavo: pointer ;PCLSID:pointer):HResult; stdcall; external 'avifil32.dll'
name 'AVIMakeCompressedStream';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult;
external 'avifil32.dll' name 'AVIStreamSetFormat';
end. // sz3905/steve
========== end cut and save as devfw.pas ==========
Raymond,
Scrap the previous version.
It seems changing the number colors freaks certain compressors out. 8 bit works with some 24 bit works with others.
The following works with MS Video 1, but not with Indeo R3.2 (memleak? not) unless you change numberofColors to 256.
Figure it out, the points are yours. Thx again!
Phil,
Heres the code so you can have lots-o-fun with compression. It's still very dangerous w/out error traps, but it do work.
The DrawSomeThingOnBitmap proc is where I'd put my image manipulation code. cYa
// This makes a blue 90 frame 24 bit avi with the word "delphi"
// going left to right in yellow @ 30 frames pers sec
procedure TForm1.Button1Click(Sender
var// you must add dibitmap, devfw to your uses clause
StdHdr: TAVIStreamInfo; //DIBITMAP.PAS is public code
pfile: PAVIFile; // and is needed to make this work
ps,psCompressed: PAVIStream;
opts:TAVICOMPRESSOPTIONS;
aOpts:array[0..0] of pointer;
FRAME,X: Integer;
nul,nul2: lONG;
BitmapInfo: PBitmapInfoHeader;
BitmapBits: Pointer;
BitmapSize,options: Dword;
BitmapInfoSize,NumbEROfCol
bm:Tbitmap;
Procedure DrawSomeThingOnBitmap(FRAM
with bm.Canvas do begin fillrect(cliprect);
textout(frame,60,'Delphi')
begin
numberofcolors:=0; //{24bit}
options:=0; //number of compression options in dialogbx 0-7
fillchar(Opts,sizeof(TAVIC
aOpts[0]:=@opts; AVIFileInit;
if AVIFileOpen(pfile, 'test.avi',
OF_WRITE or OF_CREATE, nil)=AVIERR_OK then
begin
bm:=tbitmap.create;with bm do begin // make a 24bit dummy bitmap to play with
width:=180; bm.height:=120;PixelFormat
Canvas.brush.color:=clblue
Canvas.font.color:=clYello
Canvas.FillRect(canvas.cli
InternalGetDIBSizes(bm.Han
BitmapInfo := AllocMem(BitmapInfoSize); // save bm's params for avistream
BitmapBits := AllocMem(BitmapSize);
InternalGetDIB(bm.Handle,0
FillChar(StdHdr,sizeof(Std
StdHdr.fccType := streamtypeVIDEO;
StdHdr.fccHandler := 0;StdHdr.dwScale := 1;
StdHdr.dwRate := 30; //30 frames pers sec
StdHdr.dwSuggestedBufferSi
StdHdr.rcFrame.Right := BitmapInfo^.biWidth ;
StdHdr.rcFrame.Bottom := BitmapInfo^.biHeight;
if AVIFileCreateStream(pfile,
if AviSaveOptions(handle,Opti
if AviMakeCompressedStream(PO
@opts,nil) = AVIERR_OK then
IF AVIStreamSetFormat(psCompr
(BitmapInfo.biSize+BitmapI
begin
FRAME:=-1;
FOR X:=0 TO 89 DO // make 50 frames
begin
FRAME:=FRAME+1;
DrawSomeThingOnBitmap(FRAM
canvas.draw(100,100,bm); // draw it to show it's kinda working
InternalGetDIB(bm.Handle,0
AVIStreamWrite(psCompresse
(BitmapInfo^.biSize+Bitmap
end;
end;
bm.free;// Free leftovers
FreeMem(BitmapInfo); FreeMem(BitmapBits);
AVIStreamRelease(PAVIStrea
AVIStreamRelease(PAVIStrea
AVIFileRelease(pfile);
pfile:=nil;ps:=nil;psCompr
AVIFileExit;
APPLICATION.PROCESSMESSAGE
end;
end;
========== begin cut and save as devfw.pas ==========
unit DeVFW; // This has been around, various contributors sz3905'99
interface // Also from Phil in NZ
uses Windows, SysUtils,mmsystem, Classes;
type
HResult = Longint;
PGUID = ^TGUID;
TGUID = record
D1: Longint;D2: Word;D3: Word;
D4: array[0..7] of Byte;
end;
PIID = PGUID;TIID = TGUID;
PCLSID = PGUID;TCLSID = TGUID;
IUnknown = class
public
function QueryInterface(const iid: TIID; var obj): HResult; virtual; stdcall; abstract;
function AddRef: Longint; virtual; stdcall; abstract;
function Release: Longint; virtual; stdcall; abstract;
end;
type
LONG = Longint;
PVOID = Pointer;
TAVIFileInfoW = record
dwMaxBytesPerSec,dwFlags,
dwCaps,dwStreams,dwSuggest
dwWidth,dwHeight,dwScale,d
dwLength,dwEditCount: DWORD;
szFileType: array[0..63] of WideChar;
end;
PAVIFileInfoW = ^TAVIFileInfoW;
TAVICOMPRESSOPTIONS = record //12/6/99sbs
fccType,fccHandler,dwKeyFr
dwQuality,dwFlags,dwBytesP
lpFormat:Pointer;cbFormat:
lpParms:pointer;cbParms:DW
dwInterleaveEvery:DWORD;
end;
PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS;
TAVIStreamInfoA = record
fccType,fccHandler,dwFlags
wPriority,wLanguage: WORD;
dwScale,dwRate,dwStart,
dwLength,dwInitialFrames,
dwSuggestedBufferSize,dwQu
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,dwFormatChange
szName: array[0..63] of AnsiChar;
end;
TAVIStreamInfo = TAVIStreamInfoA;
TAVIStreamInfoW = record
fccType,fccHandler,dwFlags
wPriority,wLanguage: WORD;
dwScale,dwRate,dwStart,dwL
dwSuggestedBufferSize,dwQu
rcFrame: TRect;dwEditCount,dwFormat
szName: array[0..63] of WideChar;
end;
{ IAVIStream interface }
IAVIStream = class(Iunknown)
function Create(lParam1, lParam2: LPARAM): HResult; virtual; stdcall; abstract;
function Info(var psi: TAVIStreamInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function FindSample(lPos, lFlags: LONG): LONG; virtual; stdcall; abstract;
function ReadFormat(lPos: LONG; lpFormat: PVOID; var lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function SetFormat(lPos: LONG; lpFormat: PVOID; lpcbFormat: LONG): HResult; virtual; stdcall; abstract;
function Read(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; var plBytes: LONG; var plSamples:
LONG): HResult; virtual; stdcall; abstract;
function Write(lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten:
LONG; var plBytesWritten: LONG): HResult; virtual; stdcall; abstract;
function Delete(lStart, lSamples: LONG): HResult; virtual; stdcall; abstract;
function ReadData(fcc: DWORD; lp: PVOID; var lpcb: LONG): HResult; virtual; stdcall; abstract;
function WriteData(fcc: DWORD; lp: PVOID; cb: LONG): HResult; virtual; stdcall; abstract;
function SetInfo(var lpInfo: TAVIStreamInfoW; cbInfo: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIStream = ^IAVIStream;
IAVIFile = class( IunKnown)
function Info(var pfi: TAVIFileInfoW; lSize: LONG): HResult; virtual; stdcall; abstract;
function GetStream(var ppStream: PAVIStream; fccType: DWORD; lParam: LONG): HResult; virtual; stdcall;
abstract;
function CreateStream(var ppStream: PAVIStream; var pfi: TAVIFileInfoW): HResult; virtual; stdcall; abstract;
function WriteData(ckid: DWORD; lpData: PVOID; cbData: LONG): HResult; virtual; stdcall; abstract;
function ReadData(ckid: DWORD; lpData: PVOID; var lpcbData: LONG): HResult; virtual; stdcall; abstract;
function EndRecord: HResult; virtual; stdcall; abstract;
function DeleteStream(fccType: DWORD; lParam: LONG): HResult; virtual; stdcall; abstract;
end;
PAVIFile = ^IAVIFile;
procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; stdcall;
function AVIFileCreateStream(pfile:
var ppavi: PAVISTREAM; var psi: TAVIStreamInfoA): HResult; stdcall;
Function AVIMakeCompressedStream(va
pavo: pointer ;PCLSID:pointer):HResult; stdcall;
function AVIStreamSetFormat(pavi: PAVIStream;lPos: LONG; lpFormat: PVOID;
cbFormat: LONG): HResult; stdcall;
Function AVISaveOptions(HWND:Thandl
var ppavi:PAVISTREAM;var plpOptions:pointer):HResul
Function AVISaveOptionsFree(nStream
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags:
DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; stdcall;
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;
const
AVIERR_OK = 0;
AVIIF_LIST = $01;
AVIIF_TWOCC = $02;
AVIIF_KEYFRAME = $10;
ICMF_CHOOSE_ALLCOMPRESSORS
streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
IID_IAVIFile: TGUID = (
D1:$00020020;D2:$0;D3:$0;D
IID_IAVIStream: TGUID = (
D1:$00020021;D2:$0;D3:$0;D
IID_IAVIStreaming: TGUID = (
D1:$00020022;D2:$0;D3:$0;D
IID_IGetFrame: TGUID = (
D1:$00020023;D2:$0;D3:$0;D
IID_IAVIEditStream: TGUID = (
D1:$00020024;D2:$0;D3:$0;D
CLSID_AVISimpleUnMarshal: TGUID = (
D1:$00020009;D2:$0;D3:$0;D
CLSID_AVIFile: TGUID = (
D1:$00020000;D2:$0;D3:$0;D
implementation
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen(var ppfile: PAVIFILE; szFile: LPCSTR; uMode: UINT; lpHandler: PCLSID ): HResult; external
'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream(pfile:
'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamWrite(pavi: PAVIStream; lStart,
lSamples: LONG; lpBuffer: PVOID; cbBuffer: LONG; dwFlags:
DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; external 'avifil32.dll' name
'AVIStreamWrite';
function AVIStreamRelease(pavi: PAVIStream): ULONG; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease(pfile: PAVIFile): ULONG; external 'avifil32.dll' name 'AVIFileRelease';
Function AVISaveOptions(HWND:Thandl
var ppavi: PAVIStream;var plpOptions:pointer): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';
Function AVISaveOptionsFree(nStream
var plpOptions:pointer):HResul
name 'AVISaveOptionsFree';
Function AVIMakeCompressedStream(va
pavo: pointer ;PCLSID:pointer):HResult; stdcall; external 'avifil32.dll'
name 'AVIMakeCompressedStream';
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: PVOID; cbFormat: LONG): HResult;
external 'avifil32.dll' name 'AVIStreamSetFormat';
end. // sz3905/steve
========== end cut and save as devfw.pas ==========
Thanks for the compression code Steve,
Cheers,
Phil.
Cheers,
Phil.
Thanks Steve.
Thats pretty weird about the colours! Have you seen if there are web pages for the relevant drivers? They may have updates and feedback etc.
Cheers,
Raymond.
Thats pretty weird about the colours! Have you seen if there are web pages for the relevant drivers? They may have updates and feedback etc.
Cheers,
Raymond.
ASKER
Raymond,
The problem has to do with AVIStreamRelease(PAVIStrea m(ps)) and AVIStreamRelease(PAVIStrea m(psCompre ssed)). What it looks like is the compressors (based on amount of compression and number of colors) are buffering something that these two funtions aren't dealing with.
"Have you seen if there are web pages for the relevant drivers? They may have updates and feedback etc."
Yes, experts exchange was my last chance. I really dont believe there is a bug. I've seen the writeavi.exe example work, it dont blow up.
Do you really want to call it quits? I understand your plenty busy. If I accept your answer , will the question be closed for good? (I suppose I could repost it to finish it up.)
Best regards,
Steve
The problem has to do with AVIStreamRelease(PAVIStrea
"Have you seen if there are web pages for the relevant drivers? They may have updates and feedback etc."
Yes, experts exchange was my last chance. I really dont believe there is a bug. I've seen the writeavi.exe example work, it dont blow up.
Do you really want to call it quits? I understand your plenty busy. If I accept your answer , will the question be closed for good? (I suppose I could repost it to finish it up.)
Best regards,
Steve
Oops - my mistake, I misread your comment - sorry!
I'll have a try with your new code to see how it behaves.
Have you tried running several AVIs in one execution to see if the memory use keeps growing? And what exactly happens when it 'blows up'?
Cheers,
Raymond.
I'll have a try with your new code to see how it behaves.
Have you tried running several AVIs in one execution to see if the memory use keeps growing? And what exactly happens when it 'blows up'?
Cheers,
Raymond.
ASKER
Hi Raymond,
Assume chossen compression is "Ms Video 1":
"running several AVIs "
Yes, after setting the NumberOfColors to 0 (24bit),
no problems doing a dozen in row.
But, using NumberOfColors =256 and using > 50 on the compression slider, she blows at the end where the "AVIStreamRelease" startments are. And, when she blows,
it's all over. IDE CPU Debug window pops up
Below 50 or so is okay however. Seems like a silly bug . . .
Appreciate you hangin there Raymond!
thx/s
Assume chossen compression is "Ms Video 1":
"running several AVIs "
Yes, after setting the NumberOfColors to 0 (24bit),
no problems doing a dozen in row.
But, using NumberOfColors =256 and using > 50 on the compression slider, she blows at the end where the "AVIStreamRelease" startments are. And, when she blows,
it's all over. IDE CPU Debug window pops up
Below 50 or so is okay however. Seems like a silly bug . . .
Appreciate you hangin there Raymond!
thx/s
Hi Steve,
I made a couple of changes as below because it looked like you would be passing the wrong size information when not using 24 bit colors...
I have also tried running the program outside the debugger. This doesn't crash when writing the file! I am not sure why the debugger CPU IDE window comes up, but I am fairly sure it is not because of an error. Pressing F9 a few times sorts it out.
I also ran it a number of times (with 24 and 8 bit colour depth) in a row running it from the explorer. No crashes, though after an initial large jump in memory usage after the first run, there appeared to be only a minimal increase (a few K) for each subsequent run.
Cheers,
Raymond.
IF AVIStreamSetFormat(psCompr essed,0,Bi tmapInfo,
BitmapInfoSize (*(BitmapInfo.biSize+Bitma pInfo.biCl rUsed)*siz eof(TrgbQu ad)*))=AVI ERR_OK THEN
begin
FRAME:=-1;
FOR X:=0 TO 89 DO // make 50 frames
begin
FRAME:=FRAME+1;
DrawSomeThingOnBitmap(FRAM E); // alter the bitmap for this frame
canvas.draw(100,100,bm); // draw it to show it's kinda working
InternalGetDIB(bm.Handle,0 ,BitmapInf o^,BitmapB its^,numbe rOfColors) ;
AVIStreamWrite(psCompresse d,FRAME,1, BitmapBits ,
BitmapInfoSize (*(BitmapInfo^.biSize+Bitm apInfo^.bi ClrUsed)*s izeof(Trgb Quad)*), AVIIF_KEYFRAME,nul,nul2);
end;
end;
I made a couple of changes as below because it looked like you would be passing the wrong size information when not using 24 bit colors...
I have also tried running the program outside the debugger. This doesn't crash when writing the file! I am not sure why the debugger CPU IDE window comes up, but I am fairly sure it is not because of an error. Pressing F9 a few times sorts it out.
I also ran it a number of times (with 24 and 8 bit colour depth) in a row running it from the explorer. No crashes, though after an initial large jump in memory usage after the first run, there appeared to be only a minimal increase (a few K) for each subsequent run.
Cheers,
Raymond.
IF AVIStreamSetFormat(psCompr
BitmapInfoSize (*(BitmapInfo.biSize+Bitma
begin
FRAME:=-1;
FOR X:=0 TO 89 DO // make 50 frames
begin
FRAME:=FRAME+1;
DrawSomeThingOnBitmap(FRAM
canvas.draw(100,100,bm); // draw it to show it's kinda working
InternalGetDIB(bm.Handle,0
AVIStreamWrite(psCompresse
BitmapInfoSize (*(BitmapInfo^.biSize+Bitm
end;
end;
Oops - just ran it again in 8 bit colour mode with MS Video compression > 50 and it threw a runtime 216! Curious...
Cheers,
Raymond.
Cheers,
Raymond.
However... When I run it in the debugger - I get the same stopping in NTDLL which you can get through by pressing F9 a few times. It does go through and free everything else so there wasn't an exception.
Then, when I try to run it again the AVIFileOpen function fails (though I don't know what the error is...) - but no RTE 216!
Cheers,
Raymond.
Then, when I try to run it again the AVIFileOpen function fails (though I don't know what the error is...) - but no RTE 216!
Cheers,
Raymond.
ASKER
Hi Raymond,
I was out of town for the weekend. Looks like you've seen the same weird errors. I'm still researching the whole compression scheme and it appears as there is a bit more to it if using other than 8 bit/256c, like the writeavi.exe sample. The AVIsaveoptions function will display all compressors irregardless of the intended source and destination format.
Using ICCompressorChoose and ICInfo functions to set the avicompression structure based on the source structure will rid us of most of the errors, but... ( I can't get AVmaster's codec to come up and Indeo r3.2 is still crazy, and this is another story.)
I feel kinda bad about dragging this question on. Also, I don't know now if I can write an all in one 'make compressed avi util' for the delphi community because of the complexity. The points are yours whenever you want them.
Major Thx!
steve/sz3905
I was out of town for the weekend. Looks like you've seen the same weird errors. I'm still researching the whole compression scheme and it appears as there is a bit more to it if using other than 8 bit/256c, like the writeavi.exe sample. The AVIsaveoptions function will display all compressors irregardless of the intended source and destination format.
Using ICCompressorChoose and ICInfo functions to set the avicompression structure based on the source structure will rid us of most of the errors, but... ( I can't get AVmaster's codec to come up and Indeo r3.2 is still crazy, and this is another story.)
I feel kinda bad about dragging this question on. Also, I don't know now if I can write an all in one 'make compressed avi util' for the delphi community because of the complexity. The points are yours whenever you want them.
Major Thx!
steve/sz3905
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Hi Raymond,
1) 8 bit using the MS Video 1 compressor only.
2) Exectable runs okay dont know if there a mem leaks afterwards.
3) MS Video 1 - 8bit
All in all, using the ICCompressorChoose instead of the AVISaveOptions seems to help alot. I'm happy.
Thanks,
Steve
1) 8 bit using the MS Video 1 compressor only.
2) Exectable runs okay dont know if there a mem leaks afterwards.
3) MS Video 1 - 8bit
All in all, using the ICCompressorChoose instead of the AVISaveOptions seems to help alot. I'm happy.
Thanks,
Steve
I had a wee trawl through the MSDN web site looking for these API calls, with a singular lack of success. You obviously had better luck!
Its a bit weird that the WriteAVI sample is such a dog :-)
Cheers,
Raymond.
Its a bit weird that the WriteAVI sample is such a dog :-)
Cheers,
Raymond.
ASKER
Raymond,
Yea, "bit weird" is an putting it mildly. . . .
I'll keep diggin, I'll get it.
thx again
steve
Yea, "bit weird" is an putting it mildly. . . .
I'll keep diggin, I'll get it.
thx again
steve
AVIFileOpen(pfile, // returned file pointer
szTitle, // file name
OF_WRITE OR OF_CREATE, // mode to open file with
nil); // use handler determined
AVIFileCreateStream(pfile,
ps, // returned stream pointer
strhdr); // stream header
AVISaveOptions(nil, 0, 1, ps, aopts);
AVIMakeCompressedStream(ps
AVIStreamSetFormat(psCompr
alpbi[0], // stream format
alpbi[0]^.biSize + // format size
alpbi[0]^.biClrUsed * sizeof(TRGBQUAD));
AVIStreamWrite(psCompresse
FrameNumber, // time of this frame
1, // number to write
pointer(alpbi[i]) + // pointer to data
alpbi[i]^.biSize +
alpbi[i]^.biClrUsed * sizeof(TRGBQUAD),
alpbi[i]^.biSizeImage, // size of this frame
AVIIF_KEYFRAME, // flags....
nil, nil);