Link to home
Start Free TrialLog in
Avatar of sz3905
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
//----------------------------------------------------------------------#define 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(pfile,                // file pointer
&ps,                // returned stream pointer
&strhdr);          // stream header

3) AVISaveOptions(NULL, 0, 1, &ps, (LPAVICOMPRESSOPTIONS FAR *) &aopts)

4) AVIMakeCompressedStream(&psCompressed, ps, &opts, NULL);

5) AVIStreamSetFormat(psCompressed, 0,
alpbi[0],          // stream format
alpbi[0]->biSize +   // format size
alpbi[0]->biClrUsed * sizeof(RGBQUAD));

6) AVIStreamWrite(psCompressed,      // 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(psCompressed);
      if (psText)
            AVIStreamClose(psText);
      if (pfile)
            AVIFileClose(pfile);
      AVIFileExit();
Avatar of rwilson032697
rwilson032697

Assuming your header file has all the proper var args in the function calls, the code should look something like this. Note I haven't compiled, or tested it, but it should be a useful starting point for you.

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(psCompressed, ps, opts, NULL);

AVIStreamSetFormat(psCompressed, 0,
alpbi[0],     // stream format
alpbi[0]^.biSize +   // format size
alpbi[0]^.biClrUsed * sizeof(TRGBQUAD));

AVIStreamWrite(psCompressed, // stream pointer
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);
This:

AVIMakeCompressedStream(psCompressed, ps, opts, NULL);

Should be

AVIMakeCompressedStream(psCompressed, ps, opts, Nil);

Cheers,

Raymond.

Avatar of sz3905

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


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.
Avatar of sz3905

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
 
Avatar of 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:Thandle; uiFlags:UINT; nStreams:integer; ppavi: PAVIStream;plpOptions:pointer): HResult;

Declared as :

Function AVISaveOptions(HWND:Thandle;uiFlags:UINT;nStreams:integer;
ppavi: PAVIStream;plpOptions:pointer): 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  

Listening..
Avatar of sz3905

ASKER

Brainware,
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(@psCompressed, ps, @opts, Nil);

// No change to the last two lines.

I've been using nice API conversions for too long :-)

Cheers,

Raymond.
Avatar of sz3905

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:Thandle;uiFlags:UINT;nStreams:integer;
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:Thandle;
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(psCompressed, 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.
Everybody's watching Raymond going to the limits,
where are the other Experts,
come on !
Indi
Everybody's watching Raymond going to the limits,
where are the other Experts,
come on !
Indi
Avatar of sz3905

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(FRAME: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(TAVICOMPRESSOPTIONS));
  fillchar(aopts[0]^,sizeof(TAVICOMPRESSOPTIONS),0);
  AVIFileInit;
  if fileExists('e:\avicreate\test.avi') then deletefile('e:\avicreate\test.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:=clblue;
       bm.Canvas.font.color:=clYellow;
       bm.Canvas.font.size:=24;
       bm.Canvas.FillRect(bm.canvas.cliprect);
       GetDIBSizes(bm.Handle,BitmapInfoSize,BitmapSize);
       BitmapInfo := AllocMem(BitmapInfoSize);
       BitmapBits := AllocMem(BitmapSize);
       GetDIB(bm.Handle,0,BitmapInfo^,BitmapBits^);
        FillChar(StdHdr,sizeof(StdHdr),0);
        StdHdr.fccType := streamtypeVIDEO;
        StdHdr.fccHandler := 0;
        StdHdr.dwScale := 1;
        StdHdr.dwRate := 30;
        StdHdr.dwSuggestedBufferSize := 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(psCompressed,ps,
          PAVICOMPRESSOPTIONS(@opts),nil) = AVIERR_OK then
{#5}      IF  AVIStreamSetFormat(psCompressed,0,BitmapInfo,
              (BitmapInfo.biSize+BitmapInfo.biClrUsed)*sizeof(TrgbQuad))
           =  AVIERR_OK   THEN
           begin
             FRAME:=-1;
             FOR X:=0 TO 49 DO  // make 50 frames
               begin
                  FRAME:=FRAME+1;
                  DrawSomeThingOnBitmap(FRAME); // alter the bitmap
                  canvas.draw(100,100,bm); // draw to show it's kinda working
                  GetDIB(bm.Handle,0,BitmapInfo^,BitmapBits^);
                  if AVIStreamWrite(psCompressed,FRAME,1,@BitmapBits,
                  (BitmapInfo^.biSize+BitmapInfo^.biClrUsed)*sizeof(TrgbQuad),
                  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,pointer(aOpts));
         AVIStreamRelease(ps);
         AVIStreamRelease(psCompressed);
         AVIFileRelease(pfile);
         AVIFileExit;
         APPLICATION.PROCESSMESSAGES;
   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-specific 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,lKeyCount:Dword;
    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:Thandle;uiFlags:UINT;nStreams:integer;
 var ppavi:PAVISTREAM;plpOptions:pointer):HResult; stdcall;

 Function AVISaveOptionsFree(nStreams:integer;var plpOptions:pointer):HResult; 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:hwnd;uiflags:UINT;pvln:PVOID;lpdata:Pvoid;pc:Pcompvars;lpsztitle:LPSTR):Bool;stdcall;
 Function ICCompressGetSize(Hic:hwnd; lpbiInput:PBITMAPINFOHEADER;lpbiOutput:PBITMAPINFOHEADER):Dword; stdcall;
 Function ICInfo(fccType,fccHandler:FOURCC;ICINFO:PICINFO):Bool;stdcall;
 Function ICCompress(HIC:Thandle;dwFlags: DWORD; lpbiOutput:PBITMAPINFOHEADER;
         lpData:Pointer;lpbiInput:PBITMAPINFOHEADER;lpBits:pointer;lpckid:LPDWORD;
         lpdwFlags:LPDWORD;lFrameNum: LONG ;dwFrameSize: DWORD ;dwQuality:DWORD ;
         lpbiPrev:PBITMAPINFOHEADER;   lpPrev:PVOID):Dword;stdcall;
Function ICSeqCompressFrame(pc:PCOMPVARS;uiFlags:UINT;lpBits:pointer;Var pfKey:bool; var plSize:LONG):pointer;stdcall;
Function ICSeqCompressFrameStart(pc:PCOMPVARS;lpbiIn:PBITMAPINFO):bool; stdcall;
Function ICSeqCompressFrameEnd( pc:PCOMPVARS):Pvoid;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;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIStream: TGUID = (
    D1:$00020021;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIStreaming: TGUID = (
    D1:$00020022;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IGetFrame: TGUID = (
    D1:$00020023;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  IID_IAVIEditStream: TGUID = (
    D1:$00020024;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));


  CLSID_AVISimpleUnMarshal: TGUID = (
    D1:$00020009;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
  CLSID_AVIFile: TGUID = (
    D1:$00020000;D2:$0;D3:$0;D4:($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:Thandle;uiFlags:UINT;nStreams:integer;
var ppavi: PAVIStream;plpOptions:pointer): HResult;
stdcall; external 'avifil32.dll' name 'AVISaveOptions';

Function AVISaveOptionsFree(nStreams:integer;
var plpOptions:pointer):HResult;
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:PBITMAPINFOHEADER;lpbiOutput:PBITMAPINFOHEADER):Dword; external 'MSVFW32.dll' name 'ICCompressGetSize';
Function ICInfo(fccType,fccHandler:FOURCC;ICINFO:PICINFO):Bool;external 'MSVFW32.dll' name 'ICInfo';
Function ICCompress(HIC:Thandle;dwFlags: DWORD; lpbiOutput:PBITMAPINFOHEADER;
         lpData:Pointer;lpbiInput:PBITMAPINFOHEADER;lpBits:pointer;lpckid:LPDWORD;
         lpdwFlags:PDWORD;lFrameNum: LONG ;dwFrameSize: DWORD ;dwQuality:DWORD ;
         lpbiPrev:PBITMAPINFOHEADER;lpPrev:PVOID):Dword; external 'MSVFW32.dll' name 'ICCompress';

Function ICCompressorChoose(hwnd:hwnd;uiflags:UINT;pvln:PVOID;
lpdata:Pvoid;pc:Pcompvars;lpsztitle:LPSTR):Bool; external 'MSVFW32.dll' name 'ICCompressorChoose';
Function ICSeqCompressFrame(pc:PCOMPVARS;uiFlags:UINT;lpBits:pointer;Var pfKey:bool;var plSize:LONG):pointer;
external 'MSVFW32.dll' name 'ICSeqCompressFrame';
Function ICSeqCompressFrameStart(pc:PCOMPVARS;lpbiIn:PBITMAPINFO):bool;external 'MSVFW32.dll' name 'ICSeqCompressFrameStart';
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.
Avatar of sz3905

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  
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.
DOH! Reading your code again I see you do free them. Sigh!

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(AAviFileHandle: 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(AAviFileName: 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(FAviFileHandle);
        FAviFileHandle := nil;
      end;
    inherited Destroy;
  end;

function TAviFile.OpenAviFile(AAviFileName: 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.Handle, BitmapInfoSize, BitmapSize, 0);

    ZeroMemory(@AviStreamInfo, SizeOf(AviStreamInfo));
    AviStreamInfo.fccType := streamtypeVIDEO;
    AviStreamInfo.fccHandler := 0;
    AviStreamInfo.dwScale := 1;
    AviStreamInfo.dwRate := AFrameRate;
    AviStreamInfo.dwSuggestedBufferSize := BitmapSize;
    AviStreamInfo.rcFrame.Right := ABmp.Width;
    AviStreamInfo.rcFrame.Bottom := 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(FAviStream, 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(AAviFileHandle: PAviFile);
  begin
    AVIStreamRelease(FAviStream);
    FAviStream := nil;
    AVIFileRelease(AAviFileHandle);
    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.Handle, 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(ABmpFileName: string);
  var Bmp: TBitmap;
  begin
    Bmp := TBitmap.Create;
    try
      Bmp.LoadFromFile(ABmpFileName);
      AddFrame(Bmp);
    finally
      Bmp.Free;
    end;
  end;

procedure TAviFile.AddFrames(ABmpFileNames: TStrings);
  var Index: Integer;
  begin
    for Index := 0 to ABmpFileNames.Count - 1 do
      begin
        AddFrame(ABmpFileNames[Index]);
      end;
  end;

end.
<<<<<<<<<<<<<<
Nice piece of code Phil!

Cheers,

Raymond.
Avatar of sz3905

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
 
 
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.
Avatar of sz3905

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.
 
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.
Avatar of sz3905

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

 
Sorry Steve,

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.
Avatar of sz3905

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,NumbEROfColors:Integer;
  bm:Tbitmap;
  Procedure DrawSomeThingOnBitmap(FRAME: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(TAVICOMPRESSOPTIONS),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:=clYellow;Canvas.font.size:=24;
       Canvas.FillRect(canvas.cliprect);end;
      InternalGetDIBSizes(bm.Handle,BitmapInfoSize,BitmapSize,numberOfColors);
      BitmapInfo := AllocMem(BitmapInfoSize); // save bm's params for avistream
      BitmapBits := AllocMem(BitmapSize);
      InternalGetDIB(bm.Handle,0,BitmapInfo^,BitmapBits^,numberOfColors);  //WAS 256
      FillChar(StdHdr,sizeof(StdHdr),0);
      StdHdr.fccType := streamtypeVIDEO;
      StdHdr.fccHandler := 0;StdHdr.dwScale := 1;
      StdHdr.dwRate := 30; //30 frames pers sec
      StdHdr.dwSuggestedBufferSize :=BitmapInfo^.biSizeImage;
      StdHdr.rcFrame.Right := BitmapInfo^.biWidth ;
      StdHdr.rcFrame.Bottom := BitmapInfo^.biHeight;
     if AVIFileCreateStream(pfile,ps,StdHdr)  = AVIERR_OK then
     if AviSaveOptions(handle,Options,1,ps,POINTER(aOpts)) > AVIERR_OK then
          if AviMakeCompressedStream(POINTER(psCompressed),ps,
        @opts,nil) = AVIERR_OK then
     IF AVIStreamSetFormat(psCompressed,0,BitmapInfo,
       (BitmapInfo.biSize+BitmapInfo.biClrUsed)*sizeof(TrgbQuad))=AVIERR_OK   THEN
         begin
           FRAME:=-1;
           FOR X:=0 TO 89 DO  // make 50 frames
              begin
                 FRAME:=FRAME+1;
                 DrawSomeThingOnBitmap(FRAME); // alter the bitmap for this frame
                 canvas.draw(100,100,bm); // draw it to show it's kinda working
                 InternalGetDIB(bm.Handle,0,BitmapInfo^,BitmapBits^,numberOfColors);
                 AVIStreamWrite(psCompressed,FRAME,1,BitmapBits,
                (BitmapInfo^.biSize+BitmapInfo^.biClrUsed)*sizeof(TrgbQuad), AVIIF_KEYFRAME,nul,nul2);
            end;
         end;
         bm.free;// Free leftovers
         FreeMem(BitmapInfo); FreeMem(BitmapBits);
         AVIStreamRelease(PAVIStream(ps));
         AVIStreamRelease(PAVIStream(psCompressed));
         AVIFileRelease(pfile);
         pfile:=nil;ps:=nil;psCompressed:=nil;
         AVIFileExit;
         APPLICATION.PROCESSMESSAGES;
   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,dwSuggestedBufferSize,
                    dwWidth,dwHeight,dwScale,dwRate,
                    dwLength,dwEditCount: DWORD;
                    szFileType: array[0..63] of WideChar;
                  end;
                  PAVIFileInfoW = ^TAVIFileInfoW;
                 TAVICOMPRESSOPTIONS = record       //12/6/99sbs
                    fccType,fccHandler,dwKeyFrameEvery,
                    dwQuality,dwFlags,dwBytesPerSecond :Dword;
                    lpFormat:Pointer;cbFormat:DWORD;
                    lpParms:pointer;cbParms:DWORD;
                    dwInterleaveEvery:DWORD;
                 end;
                 PAVICOMPRESSOPTIONS = ^TAVICOMPRESSOPTIONS;
                  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(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(var 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:Thandle;uiFlags:UINT;nStreams:integer;
                 var ppavi:PAVISTREAM;var plpOptions:pointer):HResult; stdcall;
                 Function AVISaveOptionsFree(nStreams:integer;var plpOptions:pointer):HResult; 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;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
                  IID_IAVIStream: TGUID = (
                    D1:$00020021;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
                  IID_IAVIStreaming: TGUID = (
                    D1:$00020022;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
                  IID_IGetFrame: TGUID = (
                    D1:$00020023;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
                  IID_IAVIEditStream: TGUID = (
                    D1:$00020024;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
                  CLSID_AVISimpleUnMarshal: TGUID = (
                    D1:$00020009;D2:$0;D3:$0;D4:($C0,$0,$0,$0,$0,$0,$0,$46));
                  CLSID_AVIFile: TGUID = (
                    D1:$00020000;D2:$0;D3:$0;D4:($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:Thandle;uiFlags:UINT;nStreams:integer;
                var ppavi: PAVIStream;var plpOptions:pointer): HResult;
                stdcall; external 'avifil32.dll' name 'AVISaveOptions';
                Function AVISaveOptionsFree(nStreams:integer;
                var plpOptions:pointer):HResult;stdcall; external 'avifil32.dll'
                name 'AVISaveOptionsFree';
                Function AVIMakeCompressedStream(var 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 ==========
Thanks for the compression code Steve,

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.
Avatar of sz3905

ASKER

Raymond,

The problem has to do with AVIStreamRelease(PAVIStream(ps)) and                     AVIStreamRelease(PAVIStream(psCompressed)). 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
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.
Avatar of sz3905

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
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(psCompressed,0,BitmapInfo,
       BitmapInfoSize (*(BitmapInfo.biSize+BitmapInfo.biClrUsed)*sizeof(TrgbQuad)*))=AVIERR_OK   THEN
         begin
           FRAME:=-1;
           FOR X:=0 TO 89 DO  // make 50 frames
              begin
                 FRAME:=FRAME+1;
                 DrawSomeThingOnBitmap(FRAME); // alter the bitmap for this frame
                 canvas.draw(100,100,bm); // draw it to show it's kinda working
                 InternalGetDIB(bm.Handle,0,BitmapInfo^,BitmapBits^,numberOfColors);
                 AVIStreamWrite(psCompressed,FRAME,1,BitmapBits,
                BitmapInfoSize (*(BitmapInfo^.biSize+BitmapInfo^.biClrUsed)*sizeof(TrgbQuad)*), AVIIF_KEYFRAME,nul,nul2);
            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.
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.
Avatar of sz3905

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
ASKER CERTIFIED SOLUTION
Avatar of rwilson032697
rwilson032697

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of sz3905

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
 
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.
Avatar of sz3905

ASKER

Raymond,

Yea,  "bit weird" is an putting it mildly. . . .
I'll keep diggin, I'll get it.

thx again
steve