Форум программистов [Powered by Invision Power Board]

Код

uses vfw;
function ExtractFrames(avifn: string; ToFileName: TFileName) : Boolean;
var   Error: Integer;  
pFile: PAVIFile;   
AVIStream: PAVIStream;   
gapgf: PGETFRAME;   
lpbi: PBITMAPINFOHEADER;   
bits: PChar; hBmp: HBITMAP; 
AviInfo: TAVIFILEINFOW; 
sError: string; TmpBmp: TBitmap; 
DC_Handle: HDC; fr1, fr2, fr : integer; 
s : string;
begin 
Result := False; AVIFileInit; 
Error := AVIFileOpen(pFile, PChar(avifn), 0, nil);
 if Error <> 0 then begin   AVIFileExit;   
case Error of     
AVIERR_BADFORMAT: sError := 'The file couldnot be read';     
AVIERR_MEMORY: sError := 'The file could not be opened because of insufficient memory.';       
AVIERR_FILEREAD: sError := 'A disk error occurred while reading the file.';       
AVIERR_FILEOPEN: sError := 'A disk error occurred while opening the file.';   
end;     
ShowMessage(sError);   Exit;   
end; 
if AVIFileInfo(pFile, @AVIINFO, SizeOf(AVIINFO)) <> AVIERR_OK then 
begin   AVIFileRelease(pFile);   AVIFileExit;   Exit; end; 
Error := AVIFileGetStream(pFile, AVIStream, streamtypeVIDEO, 0); 
if Error <> AVIERR_OK then begin   AVIFileRelease(pFile);   
AVIFileExit;   Exit; end; 
gapgf := AVIStreamGetFrameOpen(AVIStream, nil); 
if gapgf = nil then begin   AVIStreamRelease(AVIStream);  
AVIFileRelease(pFile);   
AVIFileExit;   Exit; end; 
fr1 := AVIStreamStart(AVIStream); 
fr2 := AVIStreamEnd(AVIStream); 
for fr := fr1 to fr2 do begin   
lpbi := AVIStreamGetFrame(gapgf, fr);   
if lpbi = nil then   begin     AVIStreamGetFrameClose(gapgf);     
AVIStreamRelease(AVIStream);     AVIFileRelease(pFile);     
AVIFileExit;     Exit;   end;   
TmpBmp := TBitmap.Create;   
try TmpBmp.Height := lpbi.biHeight;     
TmpBmp.Width  := lpbi.biWidth;     
bits := Pointer(Integer(lpbi) + SizeOf(TBITMAPINFOHEADER));     
DC_Handle := CreateDC('Display', nil, nil, nil);     
try       hBmp := CreateDIBitmap(DC_Handle,       lpbi^,       CBM_INIT,       bits,       PBITMAPINFO(lpbi)^,       DIB_RGB_COLORS);    
 finally       
DeleteDC(DC_Handle);     end;     
TmpBmp.Handle := hBmp;    
 try       s := IntToStr(fr);      
 while Length(s)<6 do s := '0'+s;       TmpBmp.SaveToFile(ToFileName + s + '.bmp');
Result := True;     except     end;   
finally     TmpBmp.Free;   end; 
end; AVIStreamGetFrameClose(gapgf); 
AVIStreamRelease(AVIStream); 
AVIFileRelease(pfile); AVIFileExit;
end;