Delphi操作AVI视频文件单元
2011-01-27 09:26
363 查看
unit AviWriter;
/////////////////////////////////////////////////////////////////////////////
// //
// AviWriter -- a component to create rudimentary AVI files //
// by Elliott Shevin, with large pieces of code //
// stolen from Anders Melander //
// version 1.0. Please send comments, suggestions, and advice //
// to shevine@aol.com. //
/////////////////////////////////////////////////////////////////////////////
// //
// AviWriter will build an AVI file containing one stream of any //
// number of TBitmaps, plus a single WAV file. //
// //
// Properties: //
// Bitmaps : A TList of pointers to TBitmap objects which become //
// frames of the AVI video stream. The component //
// allocates and frees the TList, but the caller //
// is responsible for managing the TBitmaps themselves. //
// Manipulate the list as you would any other TList. //
// At least one bitmap is required. //
// Height, Width: //
// The dimensions of the AVI video, in pixels. //
// FrameTime: //
// The duration of each video frame, in milliseconds. //
// Stretch: If TRUE, each TBitmap on the Bitmaps list is //
// stretches to the dimensions specified in Height //
// and Width. If FALSE, each TBitmap is copied from //
// its upper left corner without stretching. //
// FileName: The name of the AVI file to be written. //
// WAVFileName: //
// The name of a WAV file which will become the audio //
// stream for the AVI. Optional. //
// //
// Method: //
// Write: Creates the AVI file named by FileName. //
/////////////////////////////////////////////////////////////////////////////
// Wish List: //
// I'd like to be able to enhance this component in two ways, but //
// don't know how. Please send ideas to shevine@aol.com. //
// 1. So far, it's necessary to transform the video stream into //
// and AVI file on disk. I'd prefer to do this in memory. //
// 2. MIDI files for audio. //
/////////////////////////////////////////////////////////////////////////////
interface
uses
Windows,Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,unit1,
{$ifdef VER90}
ole2;
{$else}
ActiveX;
{$endif}
////////////////////////////////////////////////////////////////////////////////
// //
// Video for Windows //
// //
////////////////////////////////////////////////////////////////////////////////
// //
// Adapted from Thomas Schimming's VFW.PAS //
// (c) 1996 Thomas Schimming, schimmin@iee1.et.tu-dresden.de //
// (c) 1998,99 Anders Melander //
// //
////////////////////////////////////////////////////////////////////////////////
// //
// Ripped all COM/ActiveX stuff and added some AVI stream functions. //
// //
////////////////////////////////////////////////////////////////////////////////
type
{ TAVIFileInfoW record }
LONG = Longint;
PVOID = Pointer;
// TAVIFileInfo dwFlag values
const
AVIF_HASINDEX = $00000010;
AVIF_MUSTUSEINDEX = $00000020;
AVIF_ISINTERLEAVED = $00000100;
AVIF_WASCAPTUREFILE = $00010000;
AVIF_COPYRIGHTED = $00020000;
AVIF_KNOWN_FLAGS = $00030130;
AVIERR_UNSUPPORTED = $80044065; // MAKE_AVIERR(101)
AVIERR_BADFORMAT = $80044066; // MAKE_AVIERR(102)
AVIERR_MEMORY = $80044067; // MAKE_AVIERR(103)
AVIERR_INTERNAL = $80044068; // MAKE_AVIERR(104)
AVIERR_BADFLAGS = $80044069; // MAKE_AVIERR(105)
AVIERR_BADPARAM = $8004406A; // MAKE_AVIERR(106)
AVIERR_BADSIZE = $8004406B; // MAKE_AVIERR(107)
AVIERR_BADHANDLE = $8004406C; // MAKE_AVIERR(108)
AVIERR_FILEREAD = $8004406D; // MAKE_AVIERR(109)
AVIERR_FILEWRITE = $8004406E; // MAKE_AVIERR(110)
AVIERR_FILEOPEN = $8004406F; // MAKE_AVIERR(111)
AVIERR_COMPRESSOR = $80044070; // MAKE_AVIERR(112)
AVIERR_NOCOMPRESSOR = $80044071; // MAKE_AVIERR(113)
AVIERR_READONLY = $80044072; // MAKE_AVIERR(114)
AVIERR_NODATA = $80044073; // MAKE_AVIERR(115)
AVIERR_BUFFERTOOSMALL = $80044074; // MAKE_AVIERR(116)
AVIERR_CANTCOMPRESS = $80044075; // MAKE_AVIERR(117)
AVIERR_USERABORT = $800440C6; // MAKE_AVIERR(198)
AVIERR_ERROR = $800440C7; // MAKE_AVIERR(199)
type
TAVIFileInfoW = record
dwMaxBytesPerSec, // max. transfer rate
dwFlags, // the ever-present flags
dwCaps,
dwStreams,
dwSuggestedBufferSize,
dwWidth,
dwHeight,
dwScale,
dwRate, // dwRate / dwScale == samples/second
dwLength,
dwEditCount: DWORD;
szFileType: array[0..63] of WideChar; // descriptive string for file type?
end;
PAVIFileInfoW = ^TAVIFileInfoW;
// TAVIStreamInfo dwFlag values
const
AVISF_DISABLED = $00000001;
AVISF_VIDEO_PALCHANGES= $00010000;
AVISF_KNOWN_FLAGS = $00010001;
type
TAVIStreamInfoA = record
fccType,
fccHandler,
dwFlags, // Contains AVITF_* flags
dwCaps: DWORD;
wPriority,
wLanguage: WORD;
dwScale,
dwRate, // dwRate / dwScale == samples/second
dwStart,
dwLength, // In units above...
dwInitialFrames,
dwSuggestedBufferSize,
dwQuality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,
dwFormatChangeCount: DWORD;
szName: array[0..63] of AnsiChar;
end;
TAVIStreamInfo = TAVIStreamInfoA;
PAVIStreamInfo = ^TAVIStreamInfo;
{ TAVIStreamInfoW record }
TAVIStreamInfoW = record
fccType,
fccHandler,
dwFlags, // Contains AVITF_* flags
dwCaps: DWORD;
wPriority,
wLanguage: WORD;
dwScale,
dwRate, // dwRate / dwScale == samples/second
dwStart,
dwLength, // In units above...
dwInitialFrames,
dwSuggestedBufferSize,
dwQuality,
dwSampleSize: DWORD;
rcFrame: TRect;
dwEditCount,
dwFormatChangeCount: DWORD;
szName: array[0..63] of WideChar;
end;
PAVIStream = pointer;
PAVIFile = pointer;
TAVIStreamList = array[0..0] of PAVIStream;
PAVIStreamList = ^TAVIStreamList;
TAVISaveCallback = function (nPercent: integer): LONG; stdcall;
TAVICompressOptions = packed record
fccType : DWORD;
fccHandler : DWORD;
dwKeyFrameEvery : DWORD;
dwQuality : DWORD;
dwBytesPerSecond : DWORD;
dwFlags : DWORD;
lpFormat : pointer;
cbFormat : DWORD;
lpParms : pointer;
cbParms : DWORD;
dwInterleaveEvery : DWORD;
end;
PAVICompressOptions = ^TAVICompressOptions;
psi =^PAVICompressOptions;
// Palette change data record
const
RIFF_PaletteChange: DWORD = 1668293411;
type
TAVIPalChange = packed record
bFirstEntry : byte;
bNumEntries : byte;
wFlags : WORD;
peNew : array[byte] of TPaletteEntry;
end;
PAVIPalChange = ^TAVIPalChange;
APAVISTREAM = array[0..1] of PAVISTREAM;
APAVICompressOptions = array[0..1] of PAVICompressOptions;
procedure AVIFileInit; stdcall;
procedure AVIFileExit; stdcall;
function AVIFileOpen(var ppfile: PAVIFile; szFile: PChar; uMode: UINT; lpHandler: pointer): HResult; stdcall;
function AVIFileCreateStream(pfile: PAVIFile; var ppavi: PAVISTREAM; var psi: TAVIStreamInfo): HResult; stdcall;
function AVIStreamSetFormat(pavi: PAVIStream; lPos: LONG; lpFormat: pointer; cbFormat: LONG): HResult; stdcall;
function AVIStreamReadFormat(pavi: PAVIStream; lPos: LONG; lpFormat: pointer; var cbFormat: LONG): HResult; stdcall;
function AVIStreamWrite(pavi: PAVIStream; lStart, lSamples: LONG; lpBuffer: pointer; cbBuffer: LONG; dwFlags: DWORD; var plSampWritten: LONG; var plBytesWritten: LONG): HResult; stdcall;
function AVIStreamRelease(pavi: PAVISTREAM): ULONG; stdcall;
function AVIFileRelease(pfile: PAVIFile): ULONG; stdcall;
function AVIFileGetStream(pfile: PAVIFile; var ppavi: PAVISTREAM; fccType: DWORD; lParam: LONG): HResult; stdcall;
function CreateEditableStream(var ppsEditable: PAVISTREAM; psSource: PAVISTREAM): HResult; stdcall;
function AVISaveV(szFile: PChar; pclsidHandler: PCLSID; lpfnCallback: TAVISaveCallback;
nStreams: integer; pavi: APAVISTREAM; lpOptions: APAVICompressOptions): HResult; stdcall;
Function AVISaveOptions(si0 :Hwnd;UiFlag :integer;nstreams :integer; ppavi :pointer;var ppoptions :psi ) :Boolean; stdcall;
//b "avifil32.dll" (ByVal hWnd As Long, _
// ByVal uiFlags As Long, _
// ByVal nStreams As Long, _
// ByRef ppavi As Long, _
// ByRef ppOptions As Long) As Long 'TRUE if user pressed OK, False if cancel, or error if error
//'This is actually the AVISaveV function aliased to be called as AVISave from VB because
//'AVISave seems to be compiled using CDECL calling convention ;-(
const
AVIERR_OK = 0;
AVIIF_LIST = $01;
AVIIF_TWOCC = $02;
AVIIF_KEYFRAME = $10;
streamtypeVIDEO = $73646976; // DWORD( 'v', 'i', 'd', 's' )
streamtypeAUDIO = $73647561; // DWORD( 'a', 'u', 'd', 's' )
type
TPixelFormat = (pfDevice, pf1bit, pf4bit, pf8bit, pf15bit, pf16bit,
pf24bit, pf32bit, pfCustom);
type
TProcessNotify=Procedure(sender:TObject;Prent:Byte) of object;
TAviWriter = class(TComponent)
private
pFile : PAVIFile;
fHeight : integer;
fWidth : integer;
fStretch : boolean;
fFrameTime : integer;
fFileName : string;
VideoStream : PAVISTREAM;
FPstream : PAVISTREAM;
Fpsi0 : psi;
FBitmap :TBitmap;
FOnProcess:TProcessNotify;
procedure process(sender:TObject;Prent:Byte);
function getRect(B:TBitmap):TRect;
procedure AddVideo;
procedure InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
var ImageSize: longInt; PixelFormat: TPixelFormat);
function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean;
procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader;
PixelFormat: TPixelFormat);
{ Private declarations }
protected
{ Protected declarations }
public
Bitmaps : TList;
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Write;
procedure EndSave;
procedure WriteHeader(B:TBitmap);
procedure WriteBitmap(B:TBitmap;Index:Integer);
{ Public declarations }
published
property Height : integer read fHeight write fHeight;
property Width : integer read fWidth write fWidth;
property FrameTime: integer read fFrameTime write fFrameTime;
property Stretch : boolean read fStretch write fStretch;
property FileName : string read fFileName write fFileName;
property OnProcess:TProcessNotify read FOnProcess write FOnprocess;
{ Published declarations }
end;
procedure Register;
implementation
constructor TAviWriter.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
fHeight := screen.height div 10;
fWidth := screen.width div 10;
fFrameTime := 1000;
fStretch := true;
fFileName := '';
Bitmaps := TList.create;
AVIFileInit;
FBitmap :=TBitmap.Create;
end;
destructor TAviWriter.Destroy;
begin
Bitmaps.free;
AviFileExit;
FBitmap.Free;
inherited;
end;
procedure TAviWriter.Write;
var
ExtBitmap : TBitmap;
i : integer;
begin
VideoStream := nil;
// If no bitmaps are on the list, raise an error.
if Bitmaps.count < 1 then
raise Exception.Create('No bitmaps on the Bitmaps list');
// If anything on the Bitmaps TList is not a bitmap, raise
// an error.
for i := 0 to Bitmaps.count - 1 do begin
ExtBitmap := Bitmaps[i];
if not(ExtBitmap is TBitmap) then
raise Exception.Create('Bitmaps[' + inttostr(i)+ '] is not a TBitmap');
end;
try
AddVideo;
finally
AVIFileRelease(pFile);
end;
end;
procedure TAviWriter.AddVideo;
var
Pstream : PAVISTREAM;
StreamInfo : TAVIStreamInfo;
BitmapInfo : PBitmapInfoHeader;
BitmapInfoSize : Integer;
BitmapSize : longInt;
BitmapBits : pointer;
Bitmap : TBitmap;
ExtBitmap : TBitmap;
Samples_Written : LONG;
Bytes_Written : LONG;
AVIERR : integer;
i : integer;
begin
// Open AVI file for write
if (AVIFileOpen(pFile, pchar(FileName),OF_WRITE or OF_CREATE OR OF_SHARE_EXCLUSIVE, nil)<> AVIERR_OK) then
raise Exception.Create('Failed to create AVI video work file');
// Allocate the bitmap to which the bitmaps on the Bitmaps Tlist
// will be copied.
Bitmap := TBitmap.create;
Bitmap.Height := self.Height;
Bitmap.Width := self.Width;
// Write the stream header.
try
FillChar(StreamInfo, sizeof(StreamInfo), 0);
InternalGetDIBSizes(Bitmap.Handle,BitmapInfoSize, BitmapSize, pf24bit);
// Set frame rate and scale
StreamInfo.dwRate := 1000;
StreamInfo.dwScale := fFrameTime;
StreamInfo.fccType := streamtypeVIDEO;
StreamInfo.fccHandler := 0;
StreamInfo.dwFlags := 0;
StreamInfo.dwSuggestedBufferSize := BitmapSize;
StreamInfo.rcFrame.Right := self.width;
StreamInfo.rcFrame.Bottom := self.height;
// Open AVI data stream
if (AVIFileCreateStream(pFile, pStream, StreamInfo) <> AVIERR_OK) then
raise Exception.Create('Failed to create AVI video stream');
process(self,0);
try
// Write the bitmaps to the stream.
for i := 0 to Bitmaps.count - 1 do begin
BitmapInfo := nil;
BitmapBits := nil;
try
// Copy the bitmap from the list to the AVI bitmap,
// stretching if desired. If the caller elects not to
// stretch, use the first pixel in the bitmap as a
// background color in case either the height or
// width of the source is smaller than the output.
// If Draw fails, do a StretchDraw.
ExtBitmap := Bitmaps[i];
if fStretch then
Bitmap.Canvas.StretchDraw(Rect(0,0,self.width,self.height),ExtBitmap)
else
try
with Bitmap.Canvas do
begin
Brush.Color := ExtBitmap.Canvas.Pixels[0,0];
Brush.Style := bsSolid;
FillRect(Rect(0,0,Bitmap.Width,Bitmap.Height));
Draw(0,0,ExtBitmap);
end;
except
Bitmap.Canvas.StretchDraw(Rect(0,0,self.width,self.height),ExtBitmap);
end;
// Determine size of DIB
InternalGetDIBSizes(Bitmap.Handle, BitmapInfoSize, BitmapSize, pf24bit);
if (BitmapInfoSize = 0) then
raise Exception.Create('Failed to retrieve bitmap info');
// Get DIB header and pixel buffers
GetMem(BitmapInfo, BitmapInfoSize);
GetMem(BitmapBits, BitmapSize);
InternalGetDIB(Bitmap.Handle, 0, BitmapInfo^, BitmapBits^, pf24bit);
// On the first time through, set the stream format.
if i = 0 then
if (AVIStreamSetFormat(pStream, 0, BitmapInfo, BitmapInfoSize) <> AVIERR_OK) then
raise Exception.Create('Failed to set AVI stream format');
// Write frame to the video stream
AVIERR :=AVIStreamWrite(pStream, i, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME,Samples_Written, Bytes_Written);
if AVIERR <> AVIERR_OK then
raise Exception.Create('Failed to add frame to AVI. Err='+ inttohex(AVIERR,8));
finally
if (BitmapInfo <> nil) then
FreeMem(BitmapInfo);
if (BitmapBits <> nil) then
FreeMem(BitmapBits);
end;
process(self,I*100 div (Bitmaps.Count-1));
end;
finally
AviStreamRelease(pStream);
end;
process(self,100);
finally
Bitmap.free;
end;
end;
// --------------
// InternalGetDIB
// --------------
// Converts a bitmap to a DIB of a specified PixelFormat.
//
// Parameters:
// Bitmap The handle of the source bitmap.
// Pal The handle of the source palette.
// BitmapInfo The buffer that will receive the DIB's TBitmapInfo structure.
// A buffer of sufficient size must have been allocated prior to
// calling this function.
// Bits The buffer that will receive the DIB's pixel data.
// A buffer of sufficient size must have been allocated prior to
// calling this function.
// PixelFormat The pixel format of the destination DIB.
//
// Returns:
// True on success, False on failure.
//
// Note: The InternalGetDIBSizes function can be used to calculate the
// nescessary sizes of the BitmapInfo and Bits buffers.
//
function TAviWriter.InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE;
var BitmapInfo; var Bits; PixelFormat: TPixelFormat): Boolean;
// From graphics.pas, "optimized" for our use
var
OldPal : HPALETTE;
DC : HDC;
begin
InitializeBitmapInfoHeader(Bitmap, TBitmapInfoHeader(BitmapInfo), PixelFormat);
OldPal := 0;
DC := CreateCompatibleDC(0);
try
if (Palette <> 0) then
begin
OldPal := SelectPalette(DC, Palette, False);
RealizePalette(DC);
end;
Result := (GetDIBits(DC, Bitmap, 0, abs(TBitmapInfoHeader(BitmapInfo).biHeight),
@Bits, TBitmapInfo(BitmapInfo), DIB_RGB_COLORS) <> 0);
finally
if (OldPal <> 0) then
SelectPalette(DC, OldPal, False);
DeleteDC(DC);
end;
end;
// -------------------
// InternalGetDIBSizes
// -------------------
// Calculates the buffer sizes nescessary for convertion of a bitmap to a DIB
// of a specified PixelFormat.
// See the GetDIBSizes API function for more info.
//
// Parameters:
// Bitmap The handle of the source bitmap.
// InfoHeaderSize
// The returned size of a buffer that will receive the DIB's
// TBitmapInfo structure.
// ImageSize The returned size of a buffer that will receive the DIB's
// pixel data.
// PixelFormat The pixel format of the destination DIB.
//
procedure TAviWriter.InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer;
var ImageSize: longInt; PixelFormat: TPixelFormat);
// From graphics.pas, "optimized" for our use
var
Info : TBitmapInfoHeader;
begin
InitializeBitmapInfoHeader(Bitmap, Info, PixelFormat);
// Check for palette device format
if (Info.biBitCount > 8) then
begin
// Header but no palette
InfoHeaderSize := SizeOf(TBitmapInfoHeader);
if ((Info.biCompression and BI_BITFIELDS) <> 0) then
Inc(InfoHeaderSize, 12);
end else
// Header and palette
InfoHeaderSize := SizeOf(TBitmapInfoHeader) + SizeOf(TRGBQuad) * (1 shl Info.biBitCount);
ImageSize := Info.biSizeImage;
end;
// --------------------------
// InitializeBitmapInfoHeader
// --------------------------
// Fills a TBitmapInfoHeader with the values of a bitmap when converted to a
// DIB of a specified PixelFormat.
//
// Parameters:
// Bitmap The handle of the source bitmap.
// Info The TBitmapInfoHeader buffer that will receive the values.
// PixelFormat The pixel format of the destination DIB.
//
{$IFDEF BAD_STACK_ALIGNMENT}
// Disable optimization to circumvent optimizer bug...
{$IFOPT O+}
{$DEFINE O_PLUS}
{$O-}
{$ENDIF}
{$ENDIF}
procedure TAviWriter.InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader;
PixelFormat: TPixelFormat);
// From graphics.pas, "optimized" for our use
var
DIB : TDIBSection;
Bytes : Integer;
function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal;
begin
Dec(Alignment);
Result := ((Bits * BitsPerPixel) + Alignment) and not Alignment;
Result := Result SHR 3;
end;
begin
DIB.dsbmih.biSize := 0;
Bytes := GetObject(Bitmap, SizeOf(DIB), @DIB);
if (Bytes = 0) then
raise Exception.Create('Invalid bitmap');
// Error(sInvalidBitmap);
if (Bytes >= (sizeof(DIB.dsbm) + sizeof(DIB.dsbmih))) and
(DIB.dsbmih.biSize >= sizeof(DIB.dsbmih)) then
Info := DIB.dsbmih
else
begin
FillChar(Info, sizeof(Info), 0);
with Info, DIB.dsbm do
begin
biSize := SizeOf(Info);
biWidth := bmWidth;
biHeight := bmHeight;
end;
end;
case PixelFormat of
pf1bit: Info.biBitCount := 1;
pf4bit: Info.biBitCount := 4;
pf8bit: Info.biBitCount := 8;
pf24bit: Info.biBitCount := 24;
else
// Error(sInvalidPixelFormat);
raise Exception.Create('Invalid pixel foramt');
// Info.biBitCount := DIB.dsbm.bmBitsPixel * DIB.dsbm.bmPlanes;
end;
Info.biPlanes := 1;
Info.biCompression := BI_RGB; // Always return data in RGB format
Info.biSizeImage := AlignBit(Info.biWidth, Info.biBitCount, 32) * Cardinal(abs(Info.biHeight));
end;
{$IFDEF O_PLUS}
{$O+}
{$UNDEF O_PLUS}
{$ENDIF}
procedure Register;
begin
RegisterComponents('Custom', [TAviWriter]);
end;
procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit';
procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit';
function AVIFileOpen; external 'avifil32.dll' name 'AVIFileOpenA';
function AVIFileCreateStream; external 'avifil32.dll' name 'AVIFileCreateStreamA';
function AVIStreamSetFormat; external 'avifil32.dll' name 'AVIStreamSetFormat';
function AVIStreamReadFormat; external 'avifil32.dll' name 'AVIStreamReadFormat';
function AVIStreamWrite; external 'avifil32.dll' name 'AVIStreamWrite';
function AVIStreamRelease; external 'avifil32.dll' name 'AVIStreamRelease';
function AVIFileRelease; external 'avifil32.dll' name 'AVIFileRelease';
function AVIFileGetStream; external 'avifil32.dll' name 'AVIFileGetStream';
function CreateEditableStream; external 'avifil32.dll' name 'CreateEditableStream';
function AVISaveV; external 'avifil32.dll' name 'AVISaveV';
Function AVISaveOptions; external 'avifil32.dll' name 'avisaveoptions';
procedure TAviWriter.process(sender: TObject; Prent: Byte);
begin
if Assigned(FOnProcess) then
FOnProcess(self,Prent);
end;
procedure TAviWriter.EndSave;
begin
AviStreamRelease(FpStream);
AVIFileRelease(pFile);
end;
procedure TAviWriter.WriteBitmap(B: TBitmap;Index:Integer);
var
BitmapInfo : PBitmapInfoHeader;
BitmapInfoSize : Integer;
BitmapSize : longInt;
BitmapBits : pointer;
Samples_Written : LONG;
Bytes_Written : LONG;
AVIERR : integer;
begin
BitmapInfo := nil;
BitmapBits := nil;
try
if fStretch then
begin
FBitmap.Canvas.Brush.Color:=clBlack;
FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect);
FBitmap.Canvas.StretchDraw(getRect(B),B);
end
else
try
with FBitmap.Canvas do
begin
Brush.Color := B.Canvas.Pixels[0,0];
Brush.Style := bsSolid;
FillRect(Rect(0,0,FBitmap.Width,FBitmap.Height));
Draw(0,0,B);
end;
except
FBitmap.Canvas.StretchDraw(Rect(0,0,self.width,self.height),B);
end;
InternalGetDIBSizes(FBitmap.Handle, BitmapInfoSize, BitmapSize, pf24bit);
if (BitmapInfoSize = 0) then
raise Exception.Create('Failed to retrieve bitmap info');
GetMem(BitmapInfo, BitmapInfoSize);
GetMem(BitmapBits, BitmapSize);
InternalGetDIB(FBitmap.Handle, 0, BitmapInfo^, BitmapBits^, pf24bit);
AVIERR :=AVIStreamWrite(FpStream, Index, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME,Samples_Written, Bytes_Written);
if AVIERR <> AVIERR_OK then
raise Exception.Create('Failed to add frame to AVI. Err='+ inttohex(AVIERR,8));
finally
if (BitmapInfo <> nil) then
FreeMem(BitmapInfo);
if (BitmapBits <> nil) then
FreeMem(BitmapBits);
end;
end;
procedure TAviWriter.WriteHeader(B: TBitmap);
var
//Pstream : PAVISTREAM;
StreamInfo : TAVIStreamInfo;
BitmapInfo : PBitmapInfoHeader;
BitmapInfoSize : Integer;
BitmapSize : longInt;
BitmapBits : pointer;
Samples_Written : LONG;
Bytes_Written : LONG;
AVIERR : integer;
begin
if (AVIFileOpen(pFile, pchar(FileName),OF_WRITE or OF_CREATE OR OF_SHARE_EXCLUSIVE, nil)<> AVIERR_OK) then
raise Exception.Create('Failed to create AVI video work file');
FBitmap.Height := self.Height;
FBitmap.Width := self.Width;
try
FillChar(StreamInfo, sizeof(StreamInfo), 0);
InternalGetDIBSizes(FBitmap.Handle,BitmapInfoSize, BitmapSize, pf24bit);
StreamInfo.dwRate := 1000;
StreamInfo.dwScale := fFrameTime;
StreamInfo.fccType := streamtypeVIDEO;
StreamInfo.fccHandler := 0;
StreamInfo.dwFlags := 0;
StreamInfo.dwSuggestedBufferSize := BitmapSize;
StreamInfo.rcFrame.Right := self.width;
StreamInfo.rcFrame.Bottom := self.height;
if (AVIFileCreateStream(pFile, FpStream, StreamInfo) <> AVIERR_OK) then
raise Exception.Create('Failed to create AVI video stream');
process(self,0);
BitmapInfo := nil;
BitmapBits := nil;
try
if fStretch then
begin
FBitmap.Canvas.Brush.Color:=clBlack;
FBitmap.Canvas.FillRect(FBitmap.Canvas.ClipRect);
FBitmap.Canvas.StretchDraw(getRect(B),B);
end
else
try
with FBitmap.Canvas do
begin
Brush.Color := B.Canvas.Pixels[0,0];
Brush.Style := bsSolid;
FillRect(Rect(0,0,FBitmap.Width,FBitmap.Height));
Draw(0,0,B);
end;
except
FBitmap.Canvas.StretchDraw(Rect(0,0,self.width,self.height),B);
end;
InternalGetDIBSizes(FBitmap.Handle, BitmapInfoSize, BitmapSize, pf24bit);
if (BitmapInfoSize = 0) then
raise Exception.Create('Failed to retrieve bitmap info');
GetMem(BitmapInfo, BitmapInfoSize);
GetMem(BitmapBits, BitmapSize);
InternalGetDIB(FBitmap.Handle, 0, BitmapInfo^, BitmapBits^, pf24bit);
if AVISaveOptions(form1.Handle,1 ,1,FpStream,fpsi0) Then
Showmessage('success');
//成功
if (AVIStreamSetFormat(FpStream, 0, BitmapInfo, BitmapInfoSize) <> AVIERR_OK) then
raise Exception.Create('Failed to set AVI stream format');
AVIERR :=AVIStreamWrite(FpStream, 0, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME,Samples_Written, Bytes_Written);
if AVIERR <> AVIERR_OK then
raise Exception.Create('Failed to add frame to AVI. Err='+ inttohex(AVIERR,8));
finally
if (BitmapInfo <> nil) then
FreeMem(BitmapInfo);
if (BitmapBits <> nil) then
FreeMem(BitmapBits);
end;
finally
end;
end;
function TAviWriter.getRect(B: TBitmap): TRect;
var
w, h, cw, ch: Integer;
xyaspect: Double;
begin
W:=B.Width;
H:=B.Height;
cw := Width;
ch := Height;
if (w > cw) or (h > ch) then
begin
if (w > 0) and (h > 0) then
begin
xyaspect := w / h;
if w > h then
begin
w := cw;
h := Trunc(cw / xyaspect);
if h > ch then // woops, too big
begin
h := ch;
w := Trunc(ch * xyaspect);
end;
end
else
begin
h := ch;
w := Trunc(ch * xyaspect);
if w > cw then // woops, too big
begin
w := cw;
h := Trunc(cw / xyaspect);
end;
end;
end
else
begin
w := cw;
h := ch;
end;
end;
Result:=Rect((cw - w) div 2, (ch - h) div 2,(cw - w) div 2+W,(ch - h) div 2+H);
//OffsetRect(Result, (cw - w) div 2, (ch - h) div 2);
end;
end.
内容来自用户分享和网络整理，不保证内容的准确性，如有侵权内容，可联系管理员处理 
相关文章推荐
- Delphi操作AVI视频文件单元
- Delphi操作AVI视频文件单元
- Delphi操作AVI视频文件单元
- html制作简单框架网页二 实现自己的影音驿站 操作步骤及源文件下载 （可播放mp4、avi、mpg、asx、swf各种文件的视频播放代码）
- vc++实现avi文件的操作 用于视频解析及录制(转)
- Delphi中的操作二进制文件的两个重要函数
- java文件操作之递归获取视频文件
- 【Opencv3】视频操作 读写avi,mp4,flv
- vc++实现avi文件的操作
- Delphi 文件的操作：重命名、复制、移动、删除（制作一个信息上传控件）
- 解决会声会影X4无法插入AVI视频文件!
- 用OpenCV的VideoCapture类读取avi视频文件,并以帧流的形式显示出来！
- 为什么电脑有时会无法删除avi视频文件呢？
- 使用windows API函数读取AVI视频文件
- rtp,rtcp网络音视频写入（avi）文件，音视频同步方案
- [转]截取视频文件第一桢的图片和转换视频格式文件为flv(支持文件格式:asf,avi,mpg,flv,3gp,mov,wmv)
- delphi 生成xml 方法 与 delphi txt文件操作
- AVI文件数据流操作
- Delphi窗体创建释放过程及单元文件小结
- Delphi 的文件操作和路径操作