delphi – 如何将位图转换为视频?

前端之家收集整理的这篇文章主要介绍了delphi – 如何将位图转换为视频?前端之家小编觉得挺不错的,现在分享给大家,也给大家做个参考。
我的应用程序从分形创建图像,我喜欢分形的“飞行”感觉.我曾经将约2000个位图保存到文件中,并使用Premiere创建了一个AVI.虽然我成功地创作了一部电影,但这种经历非常令人沮丧.那是壮观的.当然,我想从我的应用程序创建一个视频.实际上我并不关心编解码器,压缩或其他任何东西的漂亮.我只想有一个视频,我可以在大多数系统上重播.

过去我曾试过,但从未成功.最近我被一个question触发,但是不能让FFMpeg运行.

更新

我决定稍稍适应这个问题,并为此而付出代价.我已经看到几个解决方案,但最有吸引力(因为它很简单)似乎在我的TAviWrite.我试过TAviWriter但没有成功.在程序TAviWriter.Write;函数调用行370

@H_404_8@AVIERR := AVISaveV(s,// pchar(FileName),nil,// File handler nil,// Callback nStreams,// Number of streams Streams,CompOptions); // Compress options for VideoStream

不返回AVIERR_OK.

更新2

上述错误的原因是AVISaveV的错误声明,应该被声明为AVISaveVW,如TLama指出的.用于创建形成BMP文件的AVI filo的正确代码如下.以下的原始代码downloaded from efg,以示例为单位.

在Windows 7上使用Delphi XE.

@H_404_8@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. // ///////////////////////////////////////////////////////////////////////////// interface uses Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Dialogs,StdCtrls,ole2; //////////////////////////////////////////////////////////////////////////////// // // // 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. // // // //////////////////////////////////////////////////////////////////////////////// // Unicode version created by Arnold and TLama (2012) // //////////////////////////////////////////////////////////////////////////////// type LONG = Longint; PVOID = Pointer; const // TAVIFileInfo dwFlag values 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) // TAVIStreamInfo dwFlag values AVISF_DISABLED = $00000001; AVISF_VIDEO_PALCHANGES = $00010000; AVISF_KNOWN_FLAGS = $00010001; 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; TAVIStreamInfoW = record fccType,fccHandler,dwFlags,// Contains AVITF_* flags dwCaps: DWORD; wPriority,wLanguage: WORD; dwScale,// dwRate / dwScale == samples/second dwStart,dwLength,// In units above... dwInitialFrames,dwQuality,dwSampleSize: DWORD; rcFrame: TRect; dwEditCount,dwFormatChangeCount: DWORD; szName: array[0..63] of WideChar; end; TAVIStreamInfo = TAVIStreamInfoW; PAVIStreamInfo = ^TAVIStreamInfo; 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; // 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; 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','s' ) type TPixelFormat = (pfDevice,pf1bit,pf4bit,pf8bit,pf15bit,pf16bit,pf24bit,pf32bit,pfCustom); type TAviWriter = class (TComponent) private TempFileName : string; pFile : PAVIFile; fHeight : integer; fWidth : integer; fStretch : boolean; fFrameTime : integer; fFileName : string; fWavFileName : string; VideoStream : PAVISTREAM; AudioStream : PAVISTREAM; procedure AddVideo; procedure AddAudio; 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); procedure SetWavFileName(value : string); public Bitmaps : TList; constructor Create(AOwner : TComponent); override; destructor Destroy; override; procedure Write; 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 WavFileName : string read fWavFileName write SetWavFileName; end; procedure Register; implementation procedure AVIFileInit; stdcall; external 'avifil32.dll' name 'AVIFileInit'; procedure AVIFileExit; stdcall; external 'avifil32.dll' name 'AVIFileExit'; function AVIFileOpen; external 'avifil32.dll' name 'AVIFileOpenW'; function AVIFileCreateStream; external 'avifil32.dll' name 'AVIFileCreateStreamW'; 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 'AVISaveVW'; 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; TempFileName := {tempdir +} 'temp.avi'; end; destructor TAviWriter.Destroy; begin Bitmaps.free; AviFileExit; inherited; end; procedure TAviWriter.Write; var ExtBitmap : TBitmap; nstreams : integer; i : integer; Streams : APAVISTREAM; CompOptions : APAVICompressOptions; AVIERR : integer; refcount : integer; begin AudioStream := nil; 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; // for try AddVideo; if WavFileName <> '' then AddAudio; // Create the output file. if WavFileName <> '' then nstreams := 2 else nstreams := 1; Streams[0] := VideoStream; Streams[1] := AudioStream; CompOptions[0] := nil; CompOptions[1] := nil; AVIERR := AVISaveV( pchar(FileName),// File handler nil,// Callback nStreams,// Number of streams Streams,CompOptions); // Compress options for VideoStream if AVIERR <> AVIERR_OK then raise Exception.Create('Unable to write output file'); finally if assigned(VideoStream) then AviStreamRelease(VideoStream); if assigned(AudioStream) then AviStreamRelease(AudioStream); try repeat refcount := AviFileRelease(pFile); until refcount <= 0; except // ignore exception end; // try..except DeleteFile(TempFileName); end; // try..finally 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; ok: Int64; mode: uInt32; fn: pChar; err: string; begin // Open AVI file for write pfile := nil; mode := OF_CREATE or OF_WRITE or OF_SHARE_EXCLUSIVE; fn := pchar (TempFileName); ok := AVIFileOpen (pFile,fn,mode,nil); if ok = AVIERR_BADFORMAT then err := 'The file could not be read,indicating a corrupt file or an unrecognized format.'; if ok = AVIERR_MEMORY then err := 'The file could not be opened because of insufficient memory.'; if ok = AVIERR_FILEREAD then err := 'A disk error occurred while reading the file.'; if ok = AVIERR_FILEOPEN then err := 'A disk error occurred while opening the file.'; if ok = REGDB_E_CLASSNOTREG then err := 'According to the registry,the type of file specified in AVIFileOpen does not have a handler to process it.'; if err <> '' then raise Exception.Create (err); // 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); // Set frame rate and scale StreamInfo.dwRate := 1000; StreamInfo.dwScale := fFrameTime; StreamInfo.fccType := streamtypeVIDEO; StreamInfo.fccHandler := 0; StreamInfo.dwFlags := 0; StreamInfo.dwSuggestedBufferSize := 0; 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'); 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,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,Bitmap.Width,Bitmap.Height)); Draw(0,ExtBitmap); end; except Bitmap.Canvas.StretchDraw (Rect(0,ExtBitmap); end; // Determine size of DIB InternalGetDIBSizes(Bitmap.Handle,BitmapInfoSize,BitmapSize,pf8bit); 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,BitmapInfo^,BitmapBits^,pf8bit); // On the first time through,set the stream format. if i = 0 then if (AVIStreamSetFormat(pStream,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,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; // Create the editable VideoStream from pStream. if CreateEditableStream(VideoStream,pStream) <> AVIERR_OK then raise Exception.Create ('Could not create Video Stream'); finally AviStreamRelease(pStream); end; finally Bitmap.free; end; end; procedure TAviWriter.AddAudio; var InputFile : PAVIFILE; InputStream : PAVIStream; err: string; ok: Int64; begin // Open the audio file. ok := AVIFileOpen(InputFile,pchar(WavFileName),OF_READ,the type of file specified in AVIFileOpen does not have a handler to process it.'; if err <> '' then raise Exception.Create (err); // Open the audio stream. try if (AVIFileGetStream(InputFile,InputStream,0) <> AVIERR_OK) then raise Exception.Create('Unable to get audio stream'); try // Create AudioStream as a copy of InputStream if (CreateEditableStream(AudioStream,InputStream) <> AVIERR_OK) then raise Exception.Create('Failed to create editable AVI audio stream'); finally AviStreamRelease(InputStream); end; finally AviFileRelease(InputFile); end; end; // -------------- // InternalGetDIB // -------------- // Converts a bitmap to a DIB of a specified PixelFormat. // // Note: The InternalGetDIBSizes function can be used to calculate the // nescessary sizes of the BitmapInfo and Bits buffers. // // From graphics.pas,"optimized" for our use function TAviWriter.InternalGetDIB ( Bitmap: HBITMAP; // The handle of the source bitmap Palette: HPALETTE; // The handle of the source palette var 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 var Bits; // The buffer that will receive the DIB's pixel data PixelFormat: TPixelFormat // The pixel format of the destination DIB ): Boolean; // True on success,False on failure 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,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. // From graphics.pas,"optimized" for our use procedure TAviWriter.InternalGetDIBSizes ( Bitmap: HBITMAP; // The handle of the source bitmap var InfoHeaderSize: Integer; // The returned size of a buffer that will receive // the DIB's TBitmapInfo structure var ImageSize: longInt; // The returned size of a buffer that will receive the DIB's pixel data PixelFormat: TPixelFormat // The pixel format of the destination DIB ); 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. // From graphics.pas,"optimized" for our use procedure TAviWriter.InitializeBitmapInfoHeader ( Bitmap: HBITMAP; // The handle of the source bitmap var Info: TBitmapInfoHeader; // The TBitmapInfoHeader buffer that will receive the values PixelFormat: TPixelFormat // The pixel format of the destination DIB ); 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 format'); // 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; procedure TAviWriter.SetWavFileName(value : string); begin if lowercase(fWavFileName) <> lowercase(value) then if lowercase(ExtractFileExt(value)) <> '.wav' then raise Exception.Create('WavFileName must name a file ' + 'with the .wav extension') else fWavFileName := value; end; procedure Register; begin RegisterComponents('Samples',[TAviWriter]); end; end.

解决方法

AVISaveV功能的导入部分更改为Unicode版本.当Windows API引用中的函数具有Unicode和ANSI名称时,这意味着您在Delphi中,您必须从Unicode版本的函数或从ANSI中选择一个,具体取决于您将使用什么编译器.

您正在尝试调用AVISaveV,物理上不存在. avifil32.dll中只有AVISaveVA和AVISaveVW,并且因为您要将此代码转换为Unicode,请尝试以这种方式更改函数导入:

@H_404_8@function AVISaveV; external 'avifil32.dll' name 'AVISaveVW';

这只是第一个想法,即使在Delphi的非Unicode版本中,具有定义的代码也不能工作,因为它调用了不存在的函数.

原文链接:https://www.f2er.com/delphi/102818.html

猜你在找的Delphi相关文章