unit1.~pas

基于xvid 视频的捕获压缩传输

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs

  ,lib_xvid, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,
  StdCtrls, ExtCtrls, IdTCPServer;

type
  TForm1 = class(TForm)
    btn1: TButton;
    Img1: TImage;
    btn2: TButton;
    lbl1: TLabel;
    Tmr1: TTimer;
    idtcpsrvr1: TIdTCPServer;
    procedure btn1Click(Sender: TObject);
    procedure idtcpsrvr1Execute(AThread: TIdPeerThread);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btn2Click(Sender: TObject);
    procedure Tmr1Timer(Sender: TObject);
  private
    xvid_Version  : Integer;
    xvid_gbl      : xvid_gbl_init_t;

    xVid_decode   : xvid_dec_create_t;
    xvid_decFrame : xvid_dec_frame_t;
 public

 end;

type
  TimgSendBuf = packed record
    ImgSize:Word;
    Buffer:array [0..352*288*3] of Byte;
  end;

var
  Form1: TForm1;

  imgSendBuf    : TimgSendBuf;
  FrameImg      : array [0..352*288*3 ] of Byte;
  FrameCount    : LongWord  = 0;
  FrameBytes    : LongWord  = 0;
  PerFrame      : LongWord  = 0;
  PerFrameBytes : LongWord  =0;

implementation

{$R *.dfm}

procedure TForm1.btn1Click(Sender: TObject);
begin
  idtcpsrvr1.DefaultPort  := 9001;
  idtcpsrvr1.Active       := True;
  sleep(50);
  Tmr1.Enabled := true;
end;

procedure TForm1.idtcpsrvr1Execute(AThread: TIdPeerThread);
var
  SpBmp   : TBitmap;
  Ret     : Integer;
  BIInfo  : TBitmapInfo;
  BitmapHandle: HBitmap;
  DIBPtr  : Pointer;
  DIBSize : LongInt;
begin
  try
    SpBmp := TBitmap.Create;
    AThread.Connection.ReadBuffer(imgSendBuf.ImgSize,2);
    AThread.Connection.ReadBuffer(imgSendBuf.Buffer,imgSendBuf.ImgSize);
    
    //初始化解码数据帧结构
    xvid_decFrame.version     := xvid_Version;
    xvid_decFrame.general     := 0;
    xvid_decFrame.bitstream   := @imgSendBuf.Buffer[0];   //输入解压的位流
    xvid_decFrame.length      := imgSendBuf.ImgSize;         //输入位流长度
    xvid_decFrame.output.csp  := XVID_CSP_BGR;  //色彩空间
    xvid_decFrame.output.plane[0]  := @FrameImg[0];   //解压后输出的缓冲区
    xvid_decFrame.output.stride[0] := 160 * 3;       //每行字节数
    ret := xvid_decore(xVid_decode.handle , XVID_DEC_DECODE, @xvid_decFrame, nil);
    
    //从视频缓冲区中取得当前位图
    BIInfo.bmiHeader.biSize :=  SizeOf(TBitmapInfoHeader);
    BIInfo.bmiHeader.biWidth := 160;
    BIInfo.bmiHeader.biHeight := 120;
    BIInfo.bmiHeader.biPlanes := 1;
    BIInfo.bmiHeader.biBitCount := 24;
    BIInfo.bmiHeader.biCompression := 0;
    BIInfo.bmiHeader.biSizeImage := 160 * 120 * 3;
    BIInfo.bmiHeader.biXPelsPerMeter := 0;
    BIInfo.bmiHeader.biYPelsPerMeter := 0;
    BIInfo.bmiHeader.biClrUsed := 0;
    BIInfo.bmiHeader.biClrImportant := 0;
    BitmapHandle := CreateDIBSection(0, BIInfo,DIB_RGB_COLORS, DIBPtr, 0, 0);
    Move(FrameImg, DIBPtr^, BIInfo.bmiHeader.biSizeImage );
    SpBmp.Handle := BitmapHandle;
    Img1.Canvas.Lock;
    Img1.Canvas.Draw(0,0,SpBmp);
    Img1.Canvas.Unlock;

    Inc(FrameCount);      //接收的帧
    FrameBytes := FrameBytes + imgSendBuf.ImgSize + 2; //接收的字节
  finally
    DeleteObject(BitmapHandle);
    SpBmp.Free;
  end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  //XVID库初始化操作
  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_decode.version := xvid_Version;
  xVid_decode.width := 160;
  xVid_decode.height := 120;

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

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Assigned(xVid_decode.handle) then
    xvid_decore(xVid_decode.handle,XVID_DEC_DESTROY,@xvid_decode,nil);
end;

procedure TForm1.btn2Click(Sender: TObject);
begin
  Tmr1.Enabled := false;
  idtcpsrvr1.Active := False;
end;

procedure TForm1.Tmr1Timer(Sender: TObject);
begin
  PerFrame      := FrameCount - PerFrame;
  PerFrameBytes := (FrameBytes - PerFrameBytes) div 1024;
  lbl1.Caption  := '当前流量：' +  IntToStr(PerFrame) + '帧/秒' + IntToStr(PerFrameBytes) +  'k/秒';
  PerFrameBytes := FrameBytes;
  PerFrame      := FrameCount;
end;

end.