⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 sysaviwriter.pas

📁 一个不出名的GBA模拟器
💻 PAS
📖 第 1 页 / 共 2 页
字号:
//////////////////////////////////////////////////////////////////////
//                                                                  //
// sysAviWriter.pas: AVI output unit                                //
//                                                                  //
// Author(s):                                                       //
//   Elliott Shevin, shevine@aol.com, wrote a component called      //
//   AviWriter, which was itself based on code from Anders          //
//   Melander.  This unit is a de-componentized version of          //
//   AviWriter which supports writing frames intermittently (i.e.   //
//   keeping the AVI stream open over a period of time, rather than //
//   converting a bunch of stills into an AVI all at once),         //
//   modified by Michael Noland (joat), michael@bottledlight.com    //
//                                                                  //
// Notes:                                                           //
//   Currently does not support audio capture in the AVI in any     //
//   meaningful way.                                                //
//   Needs replacing with a version that supports video             //
//   compression and audio encoding.                                //
//                                                                  //
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
unit sysAviWriter; ///////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
interface ////////////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, Math, StdCtrls, ActiveX, comctrls, nexus, AddressSpace;

//////////////////////////////////////////////////////////////////////

var
  captureFilename: string;
  captureRate: integer;
  captureIndex, captureTarget: single;
  captureToggleKey: integer;
  capturing: boolean;

//////////////////////////////////////////////////////////////////////

procedure aviStartCapture(filename: string);
procedure aviAddFrame(bitmap: TBitmap);
procedure aviCompleteFile;

////////////////////////////////////////////////////////////////////////////////
//                                                                            //
//                      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: uint32;
    dwFlags: uint32;
    dwCaps: uint32;
    dwStreams: uint32;
    dwSuggestedBufferSize: uint32;
    dwWidth: uint32;
    dwHeight: uint32;
    dwScale: uint32;
    dwRate: uint32;	// dwRate / dwScale == samples/second
    dwLength: uint32;
    dwEditCount: uint32;
    szFileType: array[0..63] of WideChar;
  end;
  PAVIFileInfoW = ^TAVIFileInfoW;

//////////////////////////////////////////////////////////////////////

// TAVIStreamInfo dwFlag values
const
  AVISF_DISABLED	= $00000001;
  AVISF_VIDEO_PALCHANGES= $00010000;
  AVISF_KNOWN_FLAGS	= $00010001;

//////////////////////////////////////////////////////////////////////

type
  TAVIStreamInfoA = record
    fccType: uint32;
    fccHandler: uint32;
    dwFlags: uint32;        // Contains AVITF_* flags
    dwCaps: uint32;
    wPriority: uint16;
    wLanguage: uint16;
    dwScale: uint32;
    dwRate: uint32; // dwRate / dwScale == samples/second
    dwStart: uint32;
    dwLength: uint32; // In units above...
    dwInitialFrames: uint32;
    dwSuggestedBufferSize: uint32;
    dwQuality: uint32;
    dwSampleSize: uint32;
    rcFrame: TRect;
    dwEditCount: uint32;
    dwFormatChangeCount: uint32;
    szName: array[0..63] of AnsiChar;
  end;
  TAVIStreamInfo = TAVIStreamInfoA;
  PAVIStreamInfo = ^TAVIStreamInfo;

  { TAVIStreamInfoW record }
  TAVIStreamInfoW = record
    fccType: uint32;
    fccHandler: uint32;
    dwFlags: uint32;        // Contains AVITF_* flags
    dwCaps: uint32;
    wPriority: uint16;
    wLanguage: uint16;
    dwScale: uint32;
    dwRate: uint32; // dwRate / dwScale == samples/second
    dwStart: uint32;
    dwLength: uint32; // In units above...
    dwInitialFrames: uint32;
    dwSuggestedBufferSize: uint32;
    dwQuality: uint32;
    dwSampleSize: uint32;
    rcFrame: TRect;
    dwEditCount: uint32;
    dwFormatChangeCount: uint32;
    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: uint32;
    fccHandler: uint32;
    dwKeyFrameEvery: uint32;
    dwQuality: uint32;
    dwBytesPerSecond: uint32;
    dwFlags: uint32;
    lpFormat: pointer;
    cbFormat: uint32;
    lpParms: pointer;
    cbParms: uint32;
    dwInterleaveEvery: uint32;
  end;
  PAVICompressOptions = ^TAVICompressOptions;

// Palette change data record
const
  RIFF_PaletteChange: DWORD = 1668293411;

type
  TAVIPalChange = packed record
    bFirstEntry: byte;
    bNumEntries: byte;
    wFlags: uint16;
    peNew: array[0..255] 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', 'd', 's' )
  streamTypeMPEG =  $4745504D; // DWORD( 'M', 'P', 'E', 'G' )

//////////////////////////////////////////////////////////////////////

//////////////////////////////////////////////////////////////////////
implementation ///////////////////////////////////////////////////////
//////////////////////////////////////////////////////////////////////

  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';

//////////////////////////////////////////////////////////////////////

var
  TempFileName: string;
  FFileName: string;
//  FWavFileName: string;

  VideoStream: PAVISTREAM;
  AudioStream: PAVISTREAM;

  numFrames: integer;
  BitmapBits: pointer;
  PFile: PAVIFile;
  PStream: PAVIStream;
  BitmapInfo: PBitmapInfoHeader;
  BitmapInfoSize: integer;
  BitmapSize: integer;
  MBitmap: TBitmap;

//////////////////////////////////////////////////////////////////////

// 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.

procedure InitializeBitmapInfoHeader(Bitmap: HBITMAP; var Info: TBitmapInfoHeader; PixelFormat: TPixelFormat);
var
  DIB: TDIBSection;
  size: integer;

  function AlignBit(Bits, BitsPerPixel, Alignment: Cardinal): Cardinal;
  begin
    Dec(Alignment);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -