ビットマップからAVIファイルを作成

function gfniRoundUp(fNum: Extended): Int64;
//fNumを切り上げて返す
begin
  if (fNum >= 0) then begin
    Result := Trunc(X);
    if (Frac(X) > 0) then begin
      Inc(Result);
    end;
  end else begin
   Result := Trunc(X);
    if (Frac(X) < 0) then begin
      Dec(Result);
    end;
  end;
end;

procedure SaveAvi(AImageList : TImageList; sFile : WideString; iRate : DWORD = 15; iScale : DWORD = 1);
//ビットマップから無圧縮AVIファイルを作成して保存する
//http://www.ecoop.net/coop/vfw/avi.html
//http://www.ecoop.net/coop/vfw/aviapi.html#S_AVISTREAMINFO
const
  lci_BITCOUNT = 24; //RGB24形式
//  lci_BITCOUNT = 32; //RGB32形式
var
  l_StreamInfo : TAviStreamInfoW;
  l_BmpHeader  : TBitmapInfoHeader;
  li_Size      : Int64;
  li_Mod       : Integer;
  lp_Buff      : PAnsiChar;
  i            : Integer;
  li_Width     : Integer;
  li_Height    : Integer;
  l_AviFile    : PAVIFILE;
  l_AviStream  : PAVISTREAM;
  l_Bitmap     : TBitmap;
  l_Stream     : TMemoryStream;
begin
  li_Width  := AImageList.Width;
  li_Height := AImageList.Height;

  li_Size := li_Width * (lci_BITCOUNT div 8); //RGB24 or RGB32形式
  li_Mod  := li_Size mod SizeOf(DWORD);
  if (li_Mod <> 0) then begin
    //DWORDにアライメントされているための調整
    // Inc(li_Size, SizeOf(DWORD) - li_Mod);
    li_Size := gfniRoundUp(li_Size / SizeOf(DWORD)) * SizeOf(DWORD);
  end;
  li_Size := li_Height * li_Size;

  FillChar(l_StreamInfo, SizeOf(l_StreamInfo), 0);
  with l_StreamInfo do begin
    fccType               := streamtypeVIDEO;
    fccHandler            := comptypeDIB;
    dwFlags               := 0;                // Contains AVITF_* flags
    dwCaps                := 0;
    wPriority             := 0;
    wLanguage             := 0;
    dwScale               := iScale;
    dwRate                := iRate;            // dwRate / dwScale = フレームレート
    dwStart               := 0;
    dwLength              := AImageList.Count; // In units above...
    dwInitialFrames       := 0;
    dwSuggestedBufferSize := 0;
    dwQuality             := DWORD(-1);
    dwSampleSize          := 0;
    rcFrame               := Rect(0, 0, li_Width, li_Height);
    dwEditCount           := 0;
    dwFormatChangeCount   := 0;
    szName[0] := '#';
    szName[1] := 'V';
    szName[2] := 'i';
    szName[3] := 'd';
    szName[4] := 'e';
    szName[5] := 'o';
    szName[6] := '1';
  end;

  FillChar(l_BmpHeader, SizeOf(l_BmpHeader), 0);
  with l_BmpHeader do begin
    biSize          := SizeOf(l_BmpHeader);
    biWidth         := li_Width;
    biHeight        := li_Height;
    biPlanes        := 1;
    biBitCount      := lci_BITCOUNT;
    biCompression   := BI_RGB;
    biSizeImage     := 0;
    biXPelsPerMeter := 0;
    biYPelsPerMeter := 0;
    biClrUsed       := 0;
    biClrImportant  := 0;
  end;

  //初期化
  AVIFileInit;
  try
    //ファイルを開く
    if (AVIFileOpenW(l_AviFile, PWideChar(sFile), OF_CREATE or OF_WRITE or OF_SHARE_DENY_NONE, nil) <> 0) then begin
      Exit;
    end;
    //ストリームを開く
    if (AVIFileCreateStreamW(l_AviFile, l_AviStream, @l_StreamInfo) <> 0) then begin
      Exit;
    end;
    //フォーマットをセット
    if (AVIStreamSetFormat(l_AviStream, 0, @l_BmpHeader, SizeOf(l_BmpHeader)) <> 0) then begin
      Exit;
    end;
    l_Bitmap := TBitmap.Create;
    l_Stream := TMemoryStream.Create;
    GetMem(lp_Buff, li_Size);
    try
      l_Bitmap.HandleType := bmDDB;
      if (lci_BITCOUNT = 24) then begin
        l_Bitmap.PixelFormat := pf24bit;
      end else begin
        l_Bitmap.PixelFormat := pf32bit;
      end;
      l_Bitmap.Width  := AImageList.Width;
      l_Bitmap.Height := AImageList.Height;
      for i := 0 to AImageList.Count-1 do begin
        AImageList.GetBitmap(i, l_Bitmap); //この中でビットマップの幅と高さがセットされる
        l_Stream.Position := 0;
        l_Bitmap.SaveToStream(l_Stream);
        l_Stream.Position := SizeOf(TBitmapFileHeader) + SizeOf(l_BmpHeader);
        l_Stream.Read(lp_Buff^, li_Size);
        //ストリームにビットマップを書き込む
        if (AVIStreamWrite(l_AviStream, i, 1, lp_Buff, li_Size, AVIIF_KEYFRAME, nil, nil) <> 0) then begin
          Exit;
        end;
      end;
    finally
      FreeMem(lp_Buff);
      l_Stream.Free;
      l_Bitmap.Free;
    end;
  finally
    AVIStreamRelease(l_AviStream); //ストリームを閉じる
    AVIFileRelease(l_AviFile);     //ファイルを閉じる
    AVIFileExit;                   //終了処理
  end;
end;