LoginSignup
2
0

More than 1 year has passed since last update.

@vram

【Delphi】古すぎて役に立たないAVIFileCreateStreamAPIを今更使ってみる

Posted at

はじめに

最近はYouTubeやニコニコ動画のような動画投稿サイトがあります。
プログラマーの立場としては背景をプログラムで計算した物をCanvasに書いていったら動画に出来たらいいのに？
と思ったことはありませんか？
と考えた時期が私にもありました

注意

この記事でその方法とかを説明しますが役に立ちません。
でもまあどう役に立たないのかを理解することも大事だと思いますので記事にしています。

やりかた

Windowsにはvfw.hに定義されているAPI群があってその中にAVIFileCreateStreamなどのAVIファイルを作るときに必要なAPIがあります。

これを使えば簡単にAVIファイルが作れる！！

と簡単な気持ちで調べ始めて10日目で気づきました
これは役に立たない・・・

サンプルソース

折角作ったのでサンプルソースを公開

vfw.pasは　この辺のをDLして使っています
https://github.com/winddriver/delphi-dspack-video-streaming/blob/master/VfW.pas

まずはAVIファイルに出力するためのクラス

AVICompV.pas
unit AVICompV;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls,vfw;

//--------------------------------------------------------------------------//
//  AVIファイルを作成するクラス                                             //
//--------------------------------------------------------------------------//
type
  TAVICompV = class(TWinControl)
  private
    { Private 宣言 }
    FWidth          : Integer;
    FHeight         : Integer;
    FRGBBit         : Integer;
    FStreamInfo     : TAviStreamInfoW;
    FStreamInfoName : string;
    FBitmapHeader   : TBitmapInfoHeader;
    FAviFile        : PAVIFILE;
    FAviStream      : PAVISTREAM;
    FCmpStream      : PAVISTREAM;
    FStream         : TMemoryStream;
    FBuff           : PAnsiChar;
    FBitmap         : TBitmap;
    FOptions        : TAVICOMPRESSOPTIONS;
    FOpened         : Boolean;
    FFrameSize      : Int64;
    FFrameIndex     : Int64;

    FCodecs: TStringList;

    function RoundEx(e : Extended): Int64;
    function FlameDataSize() : Int64;

    procedure StreamInfoInit();
    procedure BitmapHeaderInit();
    procedure OptionsInit();
    procedure SetStreamInfoName(const Value: string);
  protected

  public
    { Public 宣言 }
    constructor Create(AOwner: TComponent);override;
    destructor Destroy;override;

    procedure Init();

    function FileOpen(const FileName : string) : Boolean;
    function FileClose() : Boolean;
    function StreamWrite() : Boolean;

    procedure FindCompress();
    procedure DialogCompress();

    property Height : Integer read FHeight write FHeight;
    property Width  : Integer read FWidth  write FWidth;

    property RGBBit : Integer read FRGBBit write FRGBBit;

    property StreamInfo : TAviStreamInfoW read FStreamInfo;
    property StreamInfoName : string read FStreamInfoName write SetStreamInfoName;

    property BitmapHeader  : TBitmapInfoHeader read FBitmapHeader;
    property Bitmap : TBitmap read FBitmap;

    property Options :   TAVICOMPRESSOPTIONS read FOptions;
    property Codecs : TStringList read FCodecs;

  end;


implementation

{ TAVICompV }

procedure TAVICompV.BitmapHeaderInit;
var
  bsize : Integer;
begin
  bsize :=  SizeOf(FBitmapHeader);
  FillChar(FBitmapHeader, bsize, 0);
  FBitmapHeader.biSize          := bsize;
  FBitmapHeader.biWidth         := FWidth;
  FBitmapHeader.biHeight        := FHeight;
  FBitmapHeader.biPlanes        := 1;
  FBitmapHeader.biBitCount      := FRGBBit;
  FBitmapHeader.biCompression   := BI_RGB;
  FBitmapHeader.biSizeImage     := 0;
  FBitmapHeader.biXPelsPerMeter := 0;
  FBitmapHeader.biYPelsPerMeter := 0;
  FBitmapHeader.biClrUsed       := 0;
  FBitmapHeader.biClrImportant  := 0;

end;

constructor TAVICompV.Create(AOwner: TComponent);
begin
  inherited;
  FRGBBit := 24;
  FCodecs := TStringList.Create;
end;


destructor TAVICompV.Destroy;
begin
  FCodecs.Free;
  inherited;
end;

procedure TAVICompV.DialogCompress;
var
  pcompOpt:PAVICOMPRESSOPTIONS;
begin
  FileOpen('test.avi');
    pcompOpt:=@FOptions;

    AVISaveOptions(Handle,
      ICMF_CHOOSE_DATARATE or
      ICMF_CHOOSE_KEYFRAME or
      ICMF_CHOOSE_PREVIEW
      ,1,FAviStream,pcompOpt);
    AVISaveOptionsFree(1,pcompOpt);

  FileClose;
end;

function TAVICompV.FileOpen(const FileName: string): Boolean;
var
  pcompOpt:PAVICOMPRESSOPTIONS;
begin
  result := False;

  FFrameSize := FlameDataSize();
  FFrameIndex := 0;

  StreamInfoInit();
  BitmapHeaderInit();

  AVIFileInit;
  if (AVIFileOpenW(FAviFile, PWideChar('test.avi'), OF_CREATE or OF_WRITE or OF_SHARE_DENY_NONE, nil) <> 0) then begin
    Exit;
  end;
  if (AVIFileCreateStreamW(FAviFile, FAviStream, @FStreamInfo) <> 0) then begin
    Exit;
  end;

  pcompOpt:=@FOptions;
  AVIMakeCompressedStream(FCmpStream,FAviStream,pcompOpt,nil);

  if (AVIStreamSetFormat(FCmpStream, 0, @FBitmapHeader, SizeOf(FBitmapHeader)) <> 0) then begin
    Exit;
  end;
  FBitmap := TBitmap.Create;
  FStream := TMemoryStream.Create;
  GetMem(FBuff, FFrameSize);
  FBitmap.HandleType := bmDDB;
  if (FRGBBit = 24) then begin
    FBitmap.PixelFormat := pf24bit;
  end else begin
    FBitmap.PixelFormat := pf32bit;
  end;
  FBitmap.Width  := FWidth;
  FBitmap.Height := FHeight;

  result := true;
end;

procedure TAVICompV.FindCompress;
var
  ii : TICINFO;
  i  : DWord;
  j  : integer;
  ic : THandle;
  Name: WideString;
  BitmapInfoHeader: TBitmapInfoHeader;
begin
  FillChar(BitmapInfoHeader, SizeOf(BitmapInfoHeader), 0);
  with BitmapInfoHeader do begin
    biSize := SizeOf(BitmapInfoHeader);
    biWidth := FWidth;
    biHeight := FHeight;
    biPlanes := 1;
    biCompression := BI_RGB;
    biBitCount := 24;
  end;

  FCodecs.Clear;
  ii.dwSize := SizeOf(ii);
  for i := 0 to 200 do begin
    if ICInfo(ICTYPE_VIDEO, i, @ii) then begin
      ic := ICOpen(ICTYPE_VIDEO, ii.fccHandler, ICMODE_QUERY);
      try
        if ic <> 0 then begin
          if ICCompressQuery(ic, @BitmapInfoHeader, nil) = 0 then begin
            ICGetInfo(ic, @ii, SizeOf(ii));
            Name := '';
            for j := 0 to 15 do begin
              Name := Name + ii.szName[j];
            end;
            FCodecs.AddObject(string(Name),TObject(ii.fccHandler));
          end;
        end;
      finally
        ICClose(ic);
      end;
    end;
  end;
end;

function TAVICompV.FileClose: Boolean;
begin
  FreeMem(FBuff);
  FStream.Free;
  FBitmap.Free;
  AVIStreamRelease(FAviStream);
  AVIStreamRelease(FCmpStream);
  AVIFileRelease(FAviFile);
  AVIFileExit;

  FOpened := False;
  result := True;
end;

function TAVICompV.StreamWrite: Boolean;
begin
  result := False;
  FStream.Position := 0;
  FBitmap.SaveToStream(FStream);
  FStream.Position := SizeOf(TBitmapFileHeader) + SizeOf(FBitmapHeader);
  FStream.Read(FBuff^, FFrameSize);
  if (AVIStreamWrite(FCmpStream, FFrameIndex, 1, FBuff, FFrameSize, AVIIF_KEYFRAME, nil, nil) <> 0) then begin
    exit;
  end;
  Inc(FFrameIndex);
  result := True;
end;


function TAVICompV.FlameDataSize: Int64;
var
  size : Int64;
  bitm : Integer;
  dsize : Integer;
begin
  size  := FWidth * (FRGBBit div 8);
  dsize := SizeOf(DWORD);
  bitm  := size mod dsize;
  if (bitm <> 0) then begin
    size := RoundEx(size / dsize) * dsize;
  end;
  result := FHeight * size;
end;

procedure TAVICompV.Init;
begin
  FFrameSize := FlameDataSize();
  StreamInfoInit();
  BitmapHeaderInit();
end;

procedure TAVICompV.OptionsInit;
begin
  ZeroMemory(@FOptions,sizeof(FOptions));
  FOptions.fccHandler :=1668707181;
  FOptions.dwQuality := 7500;
  FOptions.dwFlags := 8;
end;

function TAVICompV.RoundEx(e: Extended): Int64;
var
  d : Int64;
begin
  if (e >= 0) then begin
    d := Trunc(e);
    if (Frac(e) > 0) then Inc(d);
  end
  else begin
   d := Trunc(e);
   if (Frac(e) < 0) then Dec(d);
  end;
  result := d;
end;

procedure TAVICompV.SetStreamInfoName(const Value: string);
var
  i,j : Integer;
  wc : WideChar;
begin
  FStreamInfoName := Value;
  j := 0;
  for i := 1 to Length(Value) do begin
    if j > High(FStreamInfo.szName) then break;
    wc := value[i];
    FStreamInfo.szName[j] := wc;
    Inc(j);
  end;

end;

procedure TAVICompV.StreamInfoInit;
begin
  FillChar(FStreamInfo, SizeOf(FStreamInfo), 0);
  with FStreamInfo do begin
    fccType               := streamtypeVIDEO;
    fccHandler            := comptypeDIB;
    dwFlags               := 0;
    dwCaps                := 0;
    wPriority             := 0;
    wLanguage             := 0;
    dwScale               := 30;
    dwRate                := 900;
    dwStart               := 0;
    dwLength              := 1;
    dwInitialFrames       := 0;
    dwSuggestedBufferSize := 0;
    dwQuality             := 80*100;
    dwSampleSize          := 0;
    rcFrame               := Rect(0, 0, FWidth, FHeight);
    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;
end;

AVI出力処理

こっちがAVIファイルに出力している部分
初期設定した後にビットマップに絵を描いては出力しているってことが伝わるかと思います

main.pas
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs,AVICompression, AVIFile32, AVIReading, vfw,
  Vcl.StdCtrls,AviCompV,AviCompCaptureV;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }

    FAviCmpV : TAVICompV;

    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }


procedure TForm1.FormCreate(Sender: TObject);
begin
  FAviCmpV := TAVICompV.Create(Self);
  FAviCmpV.Parent := Self;
end;


procedure TForm1.FormDestroy(Sender: TObject);
begin
  FAviCmpV.Free;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  FAviCmpV.FindCompress();
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  i : Integer;
  bmp : TBitmap;
  r : TRect;
  cv : TCanvas;
begin
  r := Rect(0,0,640,480);
  FAviCmpV.Width := (r.Width div 16) * 16;
  FAviCmpV.Height := (r.Height div 16) * 16;
  FAviCmpV.Init();
  FAviCmpV.FileOpen('test.avi');
  bmp := FAviCmpV.Bitmap;
  for i := 0 to 30*10 do begin
    cv := bmp.Canvas;
    cv.Brush.Color := clWhite;
    cv.Font.Color := clBlack;
    cv.Font.Size := 16;
    cv.FillRect(r);
    cv.Pen.Color := clRed;
    cv.MoveTo(i,0);
    cv.LineTo(639-i,479);
    cv.TextOut(100,100,IntToStr(i));
    FAviCmpV.StreamWrite();
  end;
  FAviCmpV.FileClose();
end;

問題点

コンパイルして実行すると実行ファイルのパスにAVIファイルが作られます、10秒の動画ですが容量は400Mbyteを軽く超えてます。全然ダメです、ファイルが大きすぎます。

ビットマップのサイズ定義のところを見ると 640 x 480とVGAサイズになっているのにこの有様です。
サイズを大きくするとエラーになります

圧縮方式を選べばいいのでは？というのも踏まえてオプションとかその表示も用意しましたが、まあ使えません。

20年ぐらい昔であればVGAやさらに小さいカメラなどの画像を一定時間録画するといった用途に使えたのかと思います、調べるとそういう使用例がほとんどでした。

結論

今や1920 x 1080サイズが当たり前でMP4形式でもっと圧縮率の高いものが定番となっている現在では素直にFFmpegあたりを使うのが無難です。

なので次回からはFFmpegとかを触っていきたいと思います。

2
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
2
0