main.pas

xvid库调用来压缩视频编码实例

unit main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls, lib_xvid;

type
  TVideoForm = class(TForm)
    FilterGraph: TFilterGraph;
    VideoWindow: TVideoWindow;
    MainMenu1: TMainMenu;
    Devices: TMenuItem;
    Filter: TFilter;
    Image: TImage;
    SnapShot: TButton;
    CallBack: TCheckBox;
    mmo1: TMemo;
    Button1: TButton;
    Button2: TButton;
    Timer1: TTimer;
    SampleGrabber: TSampleGrabber;
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure SnapShotClick(Sender: TObject);
    procedure SampleGrabberBuffer(Sender: TObject; SampleTime: Double;
      pBuffer: Pointer; BufferLen: Integer);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    // XVID ENCODER
    xvid_gbl: xvid_gbl_init_t;
    xvid_enc: xvid_enc_create_t;
    xvid_encFrame: xvid_enc_frame_t;
    xvid_encStats: xvid_enc_stats_t;

    xVid_decode: xvid_dec_create_t;
    xvid_decFrame: xvid_dec_frame_t;
    xvid_decStats: xvid_dec_stats_t;
  public
    procedure OnSelectDevice(Sender: TObject);
  end;

const
  MaxPixelCount = 65536;
type
   //Pf24bit真彩色位图像素数据结构体
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = array[0..MaxPixelCount - 1] of TRGBTriple;
var
  VideoForm: TVideoForm;
  SysDev: TSysDevEnum;
  FrameBuf: array[0..352 * 288 * 3] of Byte;
  FrameImg: array[0..352 * 288 * 3] of Byte;
  FrameSequece: LongWord = 0;
  spf, mpf: TFileStream;
  xvid_Version: Integer;
  you: Boolean;
  wei: Integer;
  SpBmp: TBitmap;
implementation

{$R *.dfm}

procedure TVideoForm.FormCreate(Sender: TObject);
var
  i: Integer;
  Device: TMenuItem;
begin
  SpBmp := TBitmap.Create;

  you := false;
  xvid_Version := XVID_MAKE_VERSION(1, 1, 0);
  xvid_gbl.version := xvid_Version; //Version:1.1.0
  xvid_gbl.cpu_flags := Word(XVID_CPU_FORCE or XVID_CPU_ASM); //0:自动检查CPU，XVID_CPU_FORCE or XVID_CPU_ASM：强制使用ASM汇编优化
  xvid_gbl.debug := 0; //调试级别
  xvid_global(nil, XVID_GBL_INIT, @xvid_gbl, nil);
  xvid_enc.version := xvid_Version;
  xvid_enc.global := XVID_GLOBAL_PACKED; //全局标志
  xvid_enc.width := 640; //压缩视频宽度
  xvid_enc.height := 480; //压缩视频高度
  xvid_enc.fbase := 3; //基本帧率/每秒  = fbase * 10 = 30
  xvid_enc.fincr := 1; //帧率增长步长，0：可变步长，>1实际增长步长
  xvid_enc.profile := XVID_PROFILE_AS_L2; //压缩级别，MPEG4-ASP最高压缩级别
  xvid_enc.max_key_interval := 0; //最大关键帧间隔
  xvid_enc.frame_drop_ratio := 0; //丢帧率；0~100
  xvid_enc.max_bframes := 0; //是否采用B帧，一般采用I，P帧，如果1=PB帧
  xvid_enc.bquant_offset := 0;
  xvid_enc.bquant_ratio := 0;
  xvid_encore(nil, XVID_ENC_CREATE, @xvid_enc, nil);
  xvid_encFrame.version := xvid_Version;
  xvid_encFrame.vol_flags := XVID_VOL_MPEGQUANT or XVID_VOL_QUARTERPEL or XVID_VOL_GMC;
  xvid_encFrame.vop_flags := XVID_VOP_INTER4V or XVID_VOP_CHROMAOPT;
  xvid_encFrame.motion := XVID_ME_HALFPELREFINE16 or XVID_ME_CHROMA_PVOP or XVID_ME_ADVANCEDDIAMOND16; //运动估计
  xvid_encFrame.quant := 4; //质量控制=量化参数，0~31，数值越小质量越高和码率成反比
  xvid_encFrame.coding_type := XVID_TYPE_AUTO; //XVID_TYPE_AUTO=让编码器自动决定，I帧编码是关键帧，P帧编码是帧内预测

// XVID解码器初始化
  xVid_decode.version := xvid_Version;
  xVid_decode.width := 640;
  xVid_decode.height := 480;

//创建解码器
  xvid_decore(nil, XVID_DEC_CREATE, @xVid_decode, nil);



  SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  if SysDev.CountFilters > 0 then
    for i := 0 to SysDev.CountFilters - 1 do
    begin
      Device := TMenuItem.Create(Devices);
      Device.Caption := SysDev.Filters[i].FriendlyName;
      Device.Tag := i;
      Device.OnClick := OnSelectDevice;
      Devices.Add(Device);
    end;
end;

procedure TVideoForm.OnSelectDevice(Sender: TObject);
var
  vd: vid_r;
begin
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;
  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).Tag);
  FilterGraph.Active := true;
  with FilterGraph as ICaptureGraphBuilder2 do
  begin
    RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, SampleGrabber as IBaseFilter, VideoWindow as IBaseFilter);
  end;
  try
    spf := TFileStream.Create('c:\1test.mp4', fmCreate or fmOpenReadWrite);
    vd.width := 640;
    vd.height := 480;
    vd.rate := 25;
    vd.PFormat := Ord(pf24bit);
    spf.Write(vd, 9999);
  except
    Exit;
  end;
  FilterGraph.Play;
end;

procedure TVideoForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  CallBack.Checked := false;
  SysDev.Free;
  FilterGraph.ClearGraph;
  FilterGraph.Active := false;

  if Assigned(xvid_enc.handle) then
    xvid_encore(xvid_enc.handle, XVID_ENC_DESTROY, @xvid_enc, nil);

  if Assigned(xVid_decode.handle) then
    xvid_decore(xVid_decode.handle, XVID_DEC_DESTROY, @xVid_decode, nil);

end;

procedure TVideoForm.SnapShotClick(Sender: TObject);
begin
  SampleGrabber.GetBitmap(Image.Picture.Bitmap);
end;

procedure TVideoForm.SampleGrabberBuffer(Sender: TObject;
  SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
  SpBmp: TBitmap;
  BmpLineData: pRGBTripleArray;
  yCount, uCount, vCount: Integer;
  Row, Col: Integer;
  Ret: Integer;
begin
  if CallBack.Checked then
  begin
    try
      xvid_encFrame.bitstream := @FrameBuf[0];
      xvid_encFrame.Length := BufferLen;
      xvid_encFrame.input.csp := XVID_CSP_BGR; //输入是rgb位图
      xvid_encFrame.input.plane[0] := pBuffer; //RGB位图数据，每个像素有3个字节,(R,G,B)
      xvid_encFrame.input.stride[0] := 640* 3; //每行字节数
      Ret := xvid_encore(xvid_enc.handle, XVID_ENC_ENCODE, @xvid_encFrame, nil); //返回编码之后的字节
      spf.Write(FrameBuf, Ret);
      mmo1.Lines.Add('Codec_num=' + IntToStr(FrameSequece) + ' Len=' + IntToStr(Ret));
      Inc(FrameSequece);
      if Ret > 0 then
      begin
        try
          SpBmp := TBitmap.Create;
          SpBmp.PixelFormat := pf24bit;
          xvid_decFrame.version := xvid_Version;
          xvid_decFrame.general := 640 * 480;
          xvid_decFrame.bitstream := @FrameBuf[0]; //输入解压的位流
          xvid_decFrame.Length := Ret; //输入位流长度
          xvid_decFrame.output.csp := XVID_CSP_BGR; //色彩空间
          xvid_decFrame.output.plane[0] := @FrameImg[0]; //解压后输出的缓冲区
          xvid_decFrame.output.stride[0] := 640 * 3; //每行字节数
          Ret := xvid_decore(xVid_decode.handle, XVID_DEC_DECODE, @xvid_decFrame, nil);
          if Ret > 0 then
          begin
            try
              SampleGrabber.GetBitmap(SpBmp, @FrameImg, Ret); //从解码出来的RGB缓冲区中画出原始bmp位图
              Image.Picture.Bitmap := SpBmp;
            except
            end;
          end;
        finally
          SpBmp.Free;
        end;
      end else
      begin

      end;

    except

    end;
  end;

end;

procedure TVideoForm.Button1Click(Sender: TObject);
var
  vd: vid_r;
begin
  mpf := TFileStream.Create('c:\test.mp4', fmOpenRead);
  mpf.Read(vd, SizeOf(vd));
  SpBmp.PixelFormat := TPixelFormat(vd.PFormat);
  SpBmp.height := vd.height;
  SpBmp.width := vd.width;
  Timer1.Interval:= Round(1000 / vd.rate);
end;

procedure TVideoForm.Button2Click(Sender: TObject);
var
  SpBmp: TBitmap;
  Ret: Integer;
  FrameA: array[0..352 * 288 * 3] of Byte;
  Framec: array[0..352 * 288 * 3] of Byte;
begin
  Timer1.Enabled := not Timer1.Enabled;
  wei := 1000;
  you := false;
end;

procedure TVideoForm.Timer1Timer(Sender: TObject);
var
  Ret, w, h, i: Integer;
  FrameA: array[0..352 * 288 * 3] of Byte;
  Framec: array[0..352 * 288 * 3] of Byte;
  SS: pRGBTripleArray;
begin
  if wei >= mpf.Size then
  begin
    Timer1.Enabled := false;
    Exit;
  end;
  mpf.Position := wei;
  mpf.Read(FrameA, 352 * 288 * 3);
  try

//初始化解码数据帧结构
    xvid_decFrame.version := xvid_Version;
    xvid_decFrame.general := 0;
    xvid_decFrame.bitstream := @FrameA[0]; //输入解压的位流
    xvid_decFrame.Length := 352 * 288 * 3; //输入位流长度
    xvid_decFrame.output.csp := XVID_CSP_BGR; //色彩空间
    xvid_decFrame.output.plane[0] := @Framec[0]; //解压后输出的缓冲区
    xvid_decFrame.output.stride[0] := 320 * 3; //每行字节数
    Ret := xvid_decore(xVid_decode.handle, XVID_DEC_DECODE, @xvid_decFrame, nil);
    if not you then
    begin
      wei := Ret;
      you := true;
    end else
    begin
      wei := wei + Ret;
    end;
    if Ret > 0 then
    begin
      i := 0;
      try
        for h := SpBmp.height - 1 downto 0 do
        begin
          SS := SpBmp.ScanLine[h];
          for w := 0 to SpBmp.width - 1 do
          begin
            SS[w].rgbtBlue := Framec[i];
            Inc(i);
            SS[w].rgbtGreen := Framec[i];
            Inc(i);
            SS[w].rgbtRed := Framec[i];
            Inc(i);
          end;
        end;
         // SampleGrabber.GetBitmap(SpBmp, @Framec, 352 * 288 *3); //从解码出来的RGB缓冲区中画出原始bmp位图
        Image.Picture.Bitmap := SpBmp;
       // SpBmp.FreeImage;
      except
      end;
    end;
  finally
  end;

end;

procedure TVideoForm.FormDestroy(Sender: TObject);
begin
  SpBmp.Free;
end;

end.