bmptoavi.pas

音视频控件SunAM-V1.0 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0 音视频控件SunAM-V1.0

    VideoStream := nil;
    AudioStream := nil;

    Deletefile(TempFileName);
  end;
end;

procedure TWriterAvi.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
  if (AVIFileOpen(pfile, PChar(TempFileName),
    OF_WRITE or OF_CREATE or OF_SHARE_EXCLUSIVE, nil)
    <> AVIERR_OK)
    then
    raise Exception.Create('Failed to create AVI video work file');
  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, 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, 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, 0, BitmapInfo^, BitmapBits^, pf8bit);

               // 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.')
        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 TWriterAvi.AddAudio;
var
  InputFile: PAVIFile;
  hr: HRESULT;
  InputStream: PAVIStream;
begin
   // Open the audio file.
  try
    hr := AVIFileOpen(InputFile, PChar(WavFileName), OF_READ, nil);
    if hr <> 0 then
      fWavFileName := '';
    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.
    if (AVIFileGetStream(InputFile, InputStream, streamtypeAUDIO, 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;

function SortCompare(AList: TStringList; Index1, Index2: integer): integer;
begin
  if integer(AList.Objects[Index1]) < integer(AList.Objects[Index2]) then
    Result := -1 else
    if integer(AList.Objects[Index1]) > integer(AList.Objects[Index2]) then
      Result := 1 else
      Result := 0;
end;

function IsCompatible(si1, si2: TAviStreamInfo): boolean;
//checks compatibility of 2 audiostreams
begin
  Result := false;
  if si1.fccType <> si2.fccType then exit;
  if si1.dwScale <> si2.dwScale then exit;
  if si1.dwRate <> si2.dwRate then exit;
  if si1.dwSampleSize <> si2.dwSampleSize then exit;
  Result := true;
end;

function IsCompatibleWavefmt(w1, w2: TWaveFormatEx): boolean;
begin
  Result := (w1.nChannels = w2.nChannels) and (w1.wBitsPerSample = w2.wBitsPerSample);
end;


procedure TWriterAvi.AddAudioMod;
var
  InputFile: PAVIFile;
  InputStream, AudStream: PAVIStream;
  hr: HRESULT;
  OldInfo, AudStreamInfo: TAviStreamInfo;
  fsize, fNewSize: integer;
  pformat: Pointer;
  i, j, il, jp, jmin, ss: integer;
  SampleSize: integer;
  pSample: Pointer;
  SamplesWritten, BytesWritten: integer;
  SamplesSoFar, l: Cardinal;
  Start, NextStart: Cardinal;
  SampPerSec: double;
  pSilence, pModSilence: PByteArray;
  Wavefmt, NewWavefmt: TWaveFormatEx;
begin
  if fWaveFileList.Count = 0 then
    if fWavFileName <> '' then
      AddWaveFile(fWavFileName, 0);
  if fWaveFileList.Count = 0 then
    exit;
  fWaveFileList.CustomSort(SortCompare);
  //sort by delay


  AudStream := nil;
  InputFile := nil;
  InputStream := nil;


  try
    SamplesSoFar := 0;
    for i := 0 to fWaveFileList.Count - 1 do
    begin
      if InputStream <> nil then AVIStreamRelease(InputStream);
      if InputFile <> nil then AVIFileRelease(InputFile);
      InputFile := nil;
      InputStream := nil;
      hr := AVIFileOpen(InputFile, PChar(fWaveFileList.Strings[i]), OF_READ, nil);
      Assert(hr = 0, 'FileOpen failed. Err: $' + IntToHex(hr, 8));
   // Open the audio stream.
      hr := AVIFileGetStream(InputFile, InputStream, streamtypeAUDIO, 0);
      Assert(hr = 0, 'GetStream failed. Err: $' + IntToHex(hr, 8));
      hr := AVIStreamInfo(InputStream, OldInfo, SizeOf(OldInfo));
      Assert(hr = 0, 'StreamInfo failed. Err: $' + IntToHex(hr, 8));
      if i > 0 then
        if not IsCompatible(OldInfo, AudStreamInfo) then
          Continue; //no sense in writing combined stream wouldn't play. try next one.
      hr := AVIStreamReadFormat(InputStream, 0, nil, fsize);
      Assert(hr = 0, 'ReadFormat failed. Err: $' + IntToHex(hr, 8));
      GetMem(pformat, fsize);
      try
        hr := AVIStreamReadFormat(InputStream, 0, pformat, fsize);
        Assert(hr = 0, 'ReadFormat failed. Err: $' + IntToHex(hr, 8));
        NewWavefmt := TWaveFormatEx(pformat^);
      finally
        FreeMem(pformat);
      end;
      if i > 0 then
        if (not IsCompatibleWavefmt(Wavefmt, NewWavefmt)) then
          Continue; //incompatible files, skip
      with OldInfo do
        SampPerSec := dwRate / dwScale;
      Start := trunc(1 / 1000 * SampPerSec * integer(fWaveFileList.Objects[i]));

      if i = 0 then
      begin
        AudStreamInfo := OldInfo;
        //AudStreamInfo.dwInitialFrames := round(0.75 * 1000 / fFrameTime); //not sure about that one.
        AudStreamInfo.dwLength := 0;
        AudStreamInfo.dwStart := 0;//FirstStart;
        //the rest should be OK from copying from first stream.

        //create the audiostream
        hr := AVIFileCreateStream(pfile, AudStream, AudStreamInfo);
        Assert(hr = 0, 'CreateStream failed. Err: $' + IntToHex(hr, 8));

        //write format to first sample
        hr := AVIStreamReadFormat(InputStream, 0, nil, fsize);
        Assert(hr = 0, 'ReadFormat failed. Err: $' + IntToHex(hr, 8));
        GetMem(pformat, fsize);
        try
          hr := AVIStreamReadFormat(InputStream, 0, pformat, fsize);
          Assert(hr = 0, 'ReadFormat failed. Err: $' + IntToHex(hr, 8));
          hr := AVIStreamSetFormat(AudStream, 0, pformat, fsize);
          Assert(hr = 0, 'SetFormat failed. Err: $' + IntToHex(hr, 8));
          Wavefmt := TWaveFormatEx(pformat^);
        finally
          FreeMem(pformat);
        end;
      end;

      if Start > SamplesSoFar then
        //if i > 0 then
        begin //pad with "silent" samples
          jmin := SamplesSoFar;
          pSilence := GetSilence(AudStreamInfo, Wavefmt, fsize);
          if pSilence <> nil then
          begin
            if fsize < integer(AudStreamInfo.dwSampleSize) then
              fNewSize := AudStreamInfo.dwSampleSize
            else
              fNewSize := fsize;
            GetMem(pModSilence, fNewSize);
            try
              ss := fNewSize div fsize;
            //write pSilence into pModSilence (fNewsize div fSize) times
              for j := 0 to ss - 1 do
                for jp := 0 to fsize - 1 do
                  pModSilence^[ss * j + jp] := pSilence^[jp];
              j := jmin;
              il := fNewSize div integer(AudStreamInfo.dwSampleSize);
              while j + il < integer(Start) do
              //dunno, the avistream things take integers,
              //the format has cardinals. That means,
              //it won't work anyway above the integer range.
              //So I can typecast these guys anywhich way I like.
              begin
                jp := j;
                hr := AVIStreamWrite(AudStream, jp, il, pModSilence, fNewSize, 0, SamplesWritten, BytesWritten);
                Assert(hr = 0, 'StreamWrite failed. Err: $' + IntToHex(hr, 8));
                j := jp + il;
                inc(SamplesSoFar, il);
              end;
              il := Start - Cardinal(j);
              if il > 0 then
              begin
                jp := j;
                hr := AVIStreamWrite(AudStream, jp, il, pModSilence, fNewSize, 0, SamplesWritten, BytesWritten);
                Assert(hr = 0, 'StreamWrite failed. Err: $' + IntToHex(hr, 8));
                inc(SamplesSoFar, il);
              end;
            finally
              FreeMem(pModSilence);
            end;
          end;
        end;
      l := AVIStreamLength(InputStream);

      if i < fWaveFileList.Count - 1 then
      begin
        NextStart := trunc(1 / 1000 * SampPerSec * integer(fWaveFileList.Objects[i + 1]));
        if NextStart < Start + l then
          l := NextStart - Start; //shorten audio length
      end;
      //write next audiofile into audstream.
      //if the silence didn't work, it goes at the end of
      //the previous file.
      SampleSize := l * AudStreamInfo.dwSampleSize;
      GetMem(pSample, SampleSize);
      try
        hr := AVIStreamRead(InputStream, OldInfo.dwStart, l, pSample, SampleSize, nil, nil);
        Assert(hr = 0, 'StreamRead failed. Err: $' + IntToHex(hr, 8));
        hr := AVIStreamWrite(AudStream, SamplesSoFar, l, pSample, SampleSize, 0, SamplesWritten, BytesWritten);
        Assert(hr = 0, 'StreamWrite failed. Err: $' + IntToHex(hr, 8));
        inc(SamplesSoFar, l);
      finally
        FreeMem(pSample);
      end;
    end; //for i looping through the wavefilelist


  finally
    if InputStream <> nil then
      AVIStreamRelease(InputStream);
    if InputFile <> nil then
      AVIFileRelease(InputFile);
    if AudStream <> nil then
      AVIStreamRelease(AudStream);
  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.
//