ICDecompress problem

Tech-Archive recommends: Repair Windows Errors & Optimize Windows Performance

Hello,

Here is some code i've made.
The ICDecompress method fails but i don't understand why .... anyone knows ?

Kyle


unit U_AVIViewer;

interface

uses classes, VFW, Windows, SysUtils;

type

LONG = longint;

PDIB = ^TDIB;
TDIB = record
DC : HDC;
BITMAP : HBITMAP;
Bits : Pointer;
Width : Integer;
Height : Integer;
Pitch : Integer;
end;

TAVIViewer=class
private
AVIHandle : PAVIStream;
AVIFrames : Long;
AVICurrentFrame : Long;
AVIHeader : TBitmapInfoHeader;
AVIDecompressor : HIC;
AVIOutput : TBitmapInfoHeader;
AVIBufferOut : Pointer;
AVIBufferIn : Pointer;
AVIDIB : TDIB;
function DIBCreate(AWidth, AHeight : Integer; AWithDC : Boolean) : TDIB;
procedure DIBDestroy(var ADIB : TDIB);
function AVILoad(AFileName : String) : boolean;
procedure AVICreateOutputFormat;
function AVIMaxFrames : Integer;
procedure DoneAVI;
function InitAVI : Boolean;
public
constructor Create(const sFileName : String);
destructor Destroy; override;
function AVIHeight : Integer;
function AVIWidth : Integer;
procedure AVIGetFrame(AX,AY : Integer; ADC : HDC);
procedure AVIGetFirstFrame(AX,AY : Integer; ADC : HDC);
function AVIIsFinished : boolean;
end;

implementation

{ TAVIViewer }

procedure TAVIViewer.AVICreateOutputFormat;
begin
FillChar(AVIOutput,Sizeof(AVIOutput),0);
with AVIOutput do
begin
biSize := SizeOf(AVIOutput);
biWidth := AVIHeader.biWidth;
biHeight := AVIHeader.biHeight;
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
end;
AVIDIB := DIBCreate(AVIHeader.biWidth,AVIHeader.biHeight,True);
AVIBufferIn := AllocMem(AVIDIB.Pitch*AVIDIB.Height);
AVIBufferOut := AVIDIB.Bits;

end;

procedure TAVIViewer.AVIGetFirstFrame(AX, AY: Integer; ADC: HDC);
begin
AVICurrentFrame := 0;
AVIGetFrame(AX,AY,ADC);

end;

procedure TAVIViewer.AVIGetFrame(AX, AY: Integer; ADC: HDC);
var
nBufLen:Cardinal;
dwRes:DWORD;
begin
if (AVICurrentFrame < AVIFrames-1) then
Inc(AVICurrentFrame)
else
AVICurrentFrame := -1;

nBufLen := AVIDIB.Pitch*AVIDIB.Height;
AVIStreamRead(AVIHandle,AVICurrentFrame,1,AVIBufferIn,nBufLen,@nBufLen,nil);

dwres :=
ICDecompress(AVIDecompressor,0,@AVIHeader,AVIBufferIn,@AVIOutput,AVIBufferOut);
Assert(dwres=ICERR_OK,'ICDecompress Failed');
BitBlt(ADC,AX,AY,AVIDIB.Width,AVIDIB.Height,AVIDIB.DC,0,0,SRCCOPY);

end;

function TAVIViewer.AVIHeight: Integer;
begin
Result := AVIDIB.Height;
end;

function TAVIViewer.AVIIsFinished: boolean;
begin
Result := (AVICurrentFrame = -1);
end;

function TAVIViewer.AVILoad(AFileName: String): boolean;
var
Info : TAVIStreamInfo;
Size : Long;
Format : Pointer;
dwRes : DWORD;
begin
Result :=
(AVIStreamOpenFromFile(AVIHandle,PAnsiChar(AFileName),streamtypeVIDEO,0,OF_READ,nil)
= 0);
if Result then
begin
AVIStreamInfo(AVIHandle,@Info,SizeOf(Info));
AVIStreamReadFormat(AVIHandle,0,nil,@Size);
Format := AllocMem(Size);
AVIStreamReadFormat(AVIHandle,0,Format,@Size);
AVIHeader := PBitmapInfoHeader(Format)^;
FreeMem(Format);
AVIFrames := AVIStreamLength(AVIHandle);
AVICreateOutputFormat;
AVIDecompressor :=
ICDecompressOpen(ICTYPE_VIDEO,Info.fccHandler,@AVIHeader,@AVIOutput);
assert(AVIDecompressor <> 0,'ICDecompressOpen Failed');
dwres := ICDecompressBegin(AVIDecompressor,@AVIHeader,@AVIOutput);
assert(dwres = ICERR_OK,'ICDecompressOpen Failed');

AVICurrentFrame := -1;
end;


end;

function TAVIViewer.AVIMaxFrames: Integer;
begin
Result := AVIFrames;
end;

function TAVIViewer.AVIWidth: Integer;
begin
Result := AVIDIB.Width;
end;

constructor TAVIViewer.Create(const sFileName: String);
begin
InitAVI;
AVILoad(sFileName);
end;

destructor TAVIViewer.Destroy;
begin
DoneAVI;
inherited;
end;

function TAVIViewer.DIBCreate(AWidth, AHeight: Integer;
AWithDC: Boolean): TDIB;
var
DC : HDC;
BitInfo : TBitmapInfo;
begin
Result.Width := AWidth;
Result.Height := AHeight;
Result.Pitch := AWidth shl 2;
if AWithDC then
begin
FillChar(BitInfo,SizeOf(BitInfo),0);
with BitInfo.bmiHeader do
begin
biSize := SizeOf(BitInfo.bmiHeader);
biPlanes := 1;
biBitCount := 32;
biCompression := BI_RGB;
biWidth := AWidth;
biHeight := AHeight;
biSizeImage := 0;
biXPelsPerMeter := 0;
biYPelsPerMeter := 0;
biClrUsed := 0;
biClrImportant := 0;
end;
DC := GetDC(0);
Result.DC := CreateCompatibleDC(DC);
Result.BITMAP :=
CreateDIBSection(Result.DC,BitInfo,DIB_RGB_COLORS,Result.Bits,0,0);
SelectObject(Result.DC,Result.BITMAP);
if DC <> 0 then
ReleaseDC(0,DC);
end
else
begin
Result.DC := 0;
Result.BITMAP := 0;
GetMem(Result.Bits,Result.Pitch*Result.Height);
end;
end;

procedure TAVIViewer.DIBDestroy(var ADIB: TDIB);
begin
if ADIB.BITMAP > 0 then
begin // delete bitmap
if ADIB.DC > 0 then
DeleteDC(ADIB.DC);
ADIB.DC := 0;
DeleteObject(ADIB.BITMAP);
ADIB.BITMAP := 0;
ADIB.Bits := nil;
ADIB.Width := 0;
ADIB.Height := 0;
ADIB.Pitch := 0;
end
else
begin
ADIB.DC := 0;
ADIB.BITMAP := 0;
if ADIB.Bits <> nil then
FreeMem(ADIB.Bits);
ADIB.Bits := nil;
ADIB.Width := 0;
ADIB.Height := 0;
ADIB.Pitch := 0;
end;

end;

procedure TAVIViewer.DoneAVI;
begin
if AVIDecompressor <> 0 then
begin
ICDecompressEnd(AVIDecompressor);
ICClose(AVIDecompressor);
AVIDecompressor := 0;
end;
AVIHandle := nil;
AVIFileExit;
if AVIBufferIn <> nil then
FreeMem(AVIBufferIn);
AVIBufferIn := nil;
AVIBufferOut := nil;
DIBDestroy(AVIDIB);

end;

function TAVIViewer.InitAVI: Boolean;
begin
AVIFileInit;
AVIHandle := nil;
Result := True;
FillChar(AVIDIB,SizeOf(TDIB),0);
end;

end.


.

Relevant Pages

  • Re: SBM2 programming error
    ... Microsoft defines NULL as zero. ... Checking a pointer for "NIL" is simply a boolean test of that value. ... This would let you define types as boolean types and not ...
    (comp.lang.modula2)
  • Re: Overloaded logic operators
    ... x and x.foo# if x is not nil, ... In languages such as Ruby, Lua, Io, Python and JavaScript, does the ... Let the default boolean type be a type with more than two values, ... includes sequential logical operators that are not bitwise). ...
    (comp.compilers)
  • Re: Why not a setf-able NIL ?
    ... i'd say using 0 and 1 as boolean values *is* a workaround. ... setfable NIL simply does not make sense, ... here i meant binding in general rather than imperatively setting value. ... binding NIL does not have sense. ...
    (comp.lang.lisp)
  • Re: boolean annoyance
    ... If you are inspecting a integer against nothing end everything is just ... Ruby just takes the stance that there ... And nil could be ... boolean because zero is treated as false. ...
    (comp.lang.ruby)