sysaviwriter.pas

一个不出名的GBA模拟器

    Result := ((Bits * BitsPerPixel) + Alignment) and not Alignment;
    Result := Result shr 3;
  end;
begin
  DIB.dsbmih.biSize := 0;
  size := GetObject(Bitmap, SizeOf(DIB), @DIB);

  if (size >= (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;
    pf15bit: Info.biBitCount := 15;
    pf16bit: Info.biBitCount := 16;
    pf24bit: Info.biBitCount := 24;
    pf32bit: Info.biBitCount := 32;
  end;

  Info.biPlanes := 1;
  Info.biCompression := BI_RGB;
  Info.biSizeImage := AlignBit(Info.biWidth, Info.biBitCount, 32) * Cardinal(Abs(Info.biHeight));
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.
function InternalGetDIB(Bitmap: HBITMAP; Palette: HPALETTE; var BitmapInfo; var Bits; PixelFormat: TPixelFormat): boolean;
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 InternalGetDIBSizes(Bitmap: HBITMAP; var InfoHeaderSize: Integer; var ImageSize: longInt; PixelFormat: TPixelFormat);
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;

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

procedure aviStartCapture(filename: string);
var
  StreamInfo: TAVIStreamInfo;
  tempdir: string;
  l: integer;
begin
  MBitmap := TBitmap.Create;
  MBitmap.Width := 240;
  MBitmap.Height := 160;
  MBitmap.PixelFormat := pf15bit;

  MBitmap.Canvas.Font.Name := 'Fixedsys';
  MBitmap.Canvas.Font.Color := clBlack;
  MBitmap.Canvas.Font.Size := 9;
{  MBitmap.Canvas.TextFlags := MBitmap.Canvas.TextFlags and not ETO_OPAQUE;
  MBitmap.Canvas.brush.Style := bsClear;}

  FFilename := filename;
  DeleteFile(filename);

  AVIFileInit;

  // Create a temporary file
  SetLength(tempdir, MAX_PATH + 1);
  l := GetTempPath(MAX_PATH, PChar(tempdir));
  SetLength(tempdir, l);
  if Copy(tempdir,length(tempdir),1) <> '\' then tempdir := tempdir + '\';
  TempFileName := tempdir + '~AWTemp.avi';

  AudioStream := nil;
  VideoStream := nil;

  // Set the fields in the stream header
  FillChar(StreamInfo, sizeof(StreamInfo), 0);
  StreamInfo.dwScale := Max(1000 div Max(captureRate, 1), 1);
  StreamInfo.dwRate := 1000;
  StreamInfo.fccType := streamTypeVIDEO;
  StreamInfo.fccHandler := 0;
  StreamInfo.dwFlags := 0;
  StreamInfo.dwSuggestedBufferSize := 0;
  StreamInfo.rcFrame.Right := 240;
  StreamInfo.rcFrame.Bottom := 160;

  // Open AVI file for write
  AVIFileOpen(PFile, PChar(TempFileName), OF_WRITE or OF_CREATE OR OF_SHARE_EXCLUSIVE, nil);

  // Open AVI data stream
  AVIFileCreateStream(PFile, PStream, StreamInfo);

  numFrames := 0;
end;

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

procedure aviCompleteFile;
var
  nstreams: integer;
  Streams: APAVISTREAM;
  CompOptions: APAVICompressOptions;
begin
  if numFrames > 0 then begin
    FreeMem(BitmapBits, BitmapSize);
    FreeMem(BitmapInfo, BitmapInfoSize);
  end;
  MBitmap.Free;

  // Create the editable VideoStream
  CreateEditableStream(VideoStream, PStream);
  AviStreamRelease(PStream);

  // Create the output file
  //if FWavFileName <> '' then nstreams := 2 else
  nstreams := 1;

  Streams[0] := VideoStream;
  Streams[1] := AudioStream;

  CompOptions[0] := nil;
  CompOptions[1] := nil;

  AVISaveV(PChar(FFileName), nil, nil, nStreams, Streams, CompOptions);

  if Assigned(VideoStream) then AviStreamRelease(VideoStream);
  if Assigned(AudioStream) then AviStreamRelease(AudioStream);

  while AviFileRelease(pFile) > 0 do ;
  DeleteFile(TempFileName);

  AviFileExit;
end;

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

procedure aviAddFrame(bitmap: TBitmap);
var
  Samples_Written: LONG;
  Bytes_Written: LONG;
  color: uint16;
  x, y: integer;
  src, dest: Puint16;
begin
  for y := 0 to 159 do begin
    src := bitmap.ScanLine[y];
    dest := MBitmap.ScanLine[y];
    for x := 0 to 239 do begin
      color := src^;
      dest^ := (color shr 10) and 31 + (color and 31) shl 10 + color and (31 shl 5);
//      dest^ := src^;
      Inc(dest);
      Inc(src);
    end;
  end;

//  MBitmap.Canvas.Draw(0, 0, Bitmap);
  MBitmap.Canvas.TextOut(238-MBitmap.Canvas.TextWidth('Mappy VM'), 158-MBitmap.Canvas.TextHeight('Mappy VM'), 'Mappy VM');

  if numFrames = 0 then begin
    BitmapInfo := nil;
    BitmapBits := nil;

    // Determine size of DIB
    InternalGetDIBSizes(MBitmap.Handle, BitmapInfoSize, BitmapSize, pf16bit);

    // Get DIB header and pixel buffers
    GetMem(BitmapInfo, BitmapInfoSize);
    GetMem(BitmapBits, BitmapSize);
  end;

  // Acquire the image data
  InternalGetDIB(MBitmap.Handle, 0, BitmapInfo^, BitmapBits^, pf16bit);

  // On the first time through, set the stream format
  if numFrames = 0 then AVIStreamSetFormat(PStream, 0, BitmapInfo, BitmapInfoSize);

  // Write the frame to the video stream
  AVIStreamWrite(PStream, numFrames, 1, BitmapBits, BitmapSize, AVIIF_KEYFRAME, Samples_Written, Bytes_Written);
  Inc(numFrames);
end;

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

{
procedure AddAudio;
var
  InputFile: PAVIFILE;
  hr: longword;
  InputStream: PAVIStream;
  avisClip: TAVISTREAMINFO;
  l, selstart: DWORD;
  pastecode: integer;
begin
  // Open the audio file
  hr := AVIFileOpen(InputFile, PChar(FWavFileName), OF_READ, nil);
  case hr of
    0: ;
    AVIERR_BADFORMAT: raise Exception.Create('The file could not be read, indicating a corrupt file or an unrecognized format.');
    AVIERR_MEMORY: raise Exception.Create('The file could not be opened because of insufficient memory.');
    AVIERR_FILEREAD: raise Exception.Create('A disk error occurred while reading the audio file.');
    AVIERR_FILEOPEN: raise Exception.Create('A disk error occurred while opening the audio file.');
    REGDB_E_CLASSNOTREG: raise Exception.Create('According to the registry, the type of audio file specified in AVIFileOpen does not have a handler to process it.');
  else
    raise Exception.Create('Unknown error opening audio file');
  end;

  // Open the audio stream
  try
    if (AVIFileGetStream(InputFile, InputStream, 0, 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;}

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

end.

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