//*****************************************服务器接收代码*******************************************
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPServer,
DSPack,lib_xvid;
type
TForm1 = class(TForm)
idtcpsrvr1: TIdTCPServer;
btn1: TButton;
img1: TImage;
mmo1: TMemo;
btn2: TButton;
lbl1: TLabel;
tmr1: TTimer;
procedure btn1Click(Sender: TObject);
procedure idtcpsrvr1Connect(AThread: TIdPeerThread);
procedure idtcpsrvr1Execute(AThread: TIdPeerThread);
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure btn2Click(Sender: TObject);
procedure tmr1Timer(Sender: TObject);
procedure idtcpsrvr1Disconnect(AThread: TIdPeerThread);
private
{ Private declarations }
xvid_Version:Integer;
xvid_gbl: xvid_gbl_init_t;
xVid_decode : xvid_dec_create_t;
xvid_decFrame: xvid_dec_frame_t;
public
{ Public declarations }
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;
mmo1.Lines.Add('服务启动!');
end;
procedure TForm1.idtcpsrvr1Connect(AThread: TIdPeerThread);
begin
mmo1.Lines.Add('有客户端连接!');
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] := 320 * 3; //每行字节数
ret := xvid_decore(xVid_decode.handle , XVID_DEC_DECODE, @xvid_decFrame, nil);
//mmo1.Lines.Add('Img:'+ IntToStr(imgSendBuf.ImgSize) + ' Ret=:' + IntToStr(Ret));
//从视频缓冲区中取得当前位图
BIInfo.bmiHeader.biSize := 40; // SizeOf(TBitmapInfoHeader);
BIInfo.bmiHeader.biWidth := 320;
BIInfo.bmiHeader.biHeight := 240;
BIInfo.bmiHeader.biPlanes := 1;
BIInfo.bmiHeader.biBitCount := 24;
BIInfo.bmiHeader.biCompression := 0;
BIInfo.bmiHeader.biSizeImage := 320 * 240 * 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 := 320;
xVid_decode.height := 240;
//创建解码器
xvid_decore(nil,XVID_DEC_CREATE,@xVid_decode, nil);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
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
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;
procedure TForm1.idtcpsrvr1Disconnect(AThread: TIdPeerThread);
begin
mmo1.Lines.Add('客户端断开连接!');
end;
end.
//*****************************************客户端发送视频部分*************************************************
unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, DSUtil, StdCtrls, DSPack, DirectShow9, Menus, ExtCtrls,lib_xvid,
IdBaseComponent, IdComponent, IdTCPServer,IdGlobal, IdTCPConnection,
IdTCPClient, IdThreadMgr, IdThreadMgrDefault, IdAntiFreezeBase,
IdAntiFreeze;
type
TVideoForm = class(TForm)
FilterGraph: TFilterGraph;
VideoWindow: TVideoWindow;
MainMenu1: TMainMenu;
Devices: TMenuItem;
Filter: TFilter;
Image: TImage;
SampleGrabber: TSampleGrabber;
SnapShot: TButton;
CallBack: TCheckBox;
mmo1: TMemo;
lbl1: TLabel;
idtcpclnt1: TIdTCPClient;
btn1: TButton;
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);
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;
public
procedure OnSelectDevice(sender: TObject);
end;
type
TimgSendBuf = packed record
ImgSize:Word;
Buffer:array [0..352*288*3] of Byte;
end;
var
VideoForm: TVideoForm;
SysDev: TSysDevEnum;
FrameBuf:array [0..352*288*3 ] of Byte;
FrameImg:array [0..352*288*3 ] of Byte;
FrameSequece : LongWord= 0;
xvid_Version:Integer;
FrameByteCount : LongWord = 0;
CurFrame: LongWord = 0;
Sending:BOOL=False;
imgSendBuf:TimgSendBuf;
implementation
{$R *.dfm}
procedure TVideoForm.FormCreate(Sender: TObject);
var
i: integer;
Device: TMenuItem;
begin
xvid_Version :=XVID_MAKE_VERSION(1,1,0);
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);
begin
Self.DoubleBuffered := True;
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
//XVID库初始化操作
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编码器初始化
xvid_enc.version := xvid_Version;
//编码器参数
xvid_enc.global := XVID_GLOBAL_PACKED; //全局标志
xvid_enc.width := 320; //压缩视频宽度
xvid_enc.height := 240; //压缩视频高度
xvid_enc.fbase := 3; //基本帧率/每秒 = fbase * 10 = 30
xvid_enc.fincr := 1; //帧率增长步长,0:可变步长,>1实际增长步长
xvid_enc.profile := XVID_PROFILE_AS_L4; //压缩级别,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;
// --- VOL FLAGS
xvid_encFrame.vol_flags := 0;//XVID_VOL_MPEGQUANT OR XVID_VOL_QUARTERPEL OR XVID_VOL_GMC;
// --- VOP FLAGS
xvid_encFrame.vop_flags := 0;//XVID_VOP_HALFPEL or XVID_VOP_INTER4V;
xvid_encFrame.motion := 0;//XVID_ME_ADVANCEDDIAMOND16 or XVID_ME_HALFPELREFINE16 or
//XVID_ME_ADVANCEDDIAMOND8 or XVID_ME_HALFPELREFINE8; //运动估计
xvid_encFrame.quant := 4; //质量控制=量化参数,0~31,数值越小质量越高和码率成反比
xvid_encFrame.coding_type := XVID_TYPE_AUTO; //XVID_TYPE_AUTO=让编码器自动决定,I帧编码是关键帧,P帧编码是帧内预测
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);
end;
procedure TVideoForm.SnapShotClick(Sender: TObject);
begin
idtcpclnt1.Disconnect;
idtcpclnt1.Host:='127.0.0.1';
idtcpclnt1.Port:=9001;
idtcpclnt1.Connect;
end;
procedure TVideoForm.SampleGrabberBuffer(sender: TObject;
SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
SpBmp:TBitmap;
Ret:Integer;
begin
if CallBack.Checked then
begin
try
xvid_encFrame.bitstream := @FrameBuf[0];
xvid_encFrame.input.csp := XVID_CSP_BGR; //输入是rgb位图
xvid_encFrame.input.plane[0] := pBuffer; //RGB位图数据,每个像素有3个字节,(R,G,B)
xvid_encFrame.input.stride[0] := 320 * 3; //每行字节数
//开始压缩
//Ret := xvid_encore(xvid_enc.handle, XVID_ENC_ENCODE, @xvid_encFrame,@xvid_encStats); //返回编码之后的字节
Ret := xvid_encore(xvid_enc.handle, XVID_ENC_ENCODE, @xvid_encFrame,nil); //返回编码之后的字节
//网络发送
if idtcpclnt1.Connected then
begin
imgSendBuf.ImgSize := Ret;
Move(FrameBuf,imgSendBuf.Buffer,Ret);
idtcpclnt1.WriteBuffer(imgSendBuf,Ret+2,True);
end;
except
end;
end;
end;
end.