Network MPEG4 Video Transmission (based on Xvid Library) demo

//************************************** * ** Server receiving code ********************************** * ******** </P> <p> unit unit1; </P> <p> interface </P> <p> uses <br/> Windows, messages, sysutils, variants, classes, graphics, controls, forms, <br/> dialogs, extctrls, stdctrls, idbasecomponent, idcomponent, idtcpserver, <br/> dspack, lib_xvid; </P> <p> type <br/> tform1 = Class (tform) <br/> idtcpsrvr1: tidtcpserver; <br/> BTN 1: tbutton; <br/> img1: timage; <br/> mmo1: tmemo; <br/> btn2: tbutton; <br/> lbl1: tlabel; <br/> tmr1: ttimer; <br/> procedure btn1click (Sender: tobject); <br/> procedure idtcpsrvr1connect (athread: tidpeerthread ); <br/> procedure transaction (athread: tidpeerthread); <br/> procedure formcreate (Sender: tobject); <br/> procedure formclosequery (Sender: tobject; var canclose: boolean); <br/> pro Cedure btn2click (Sender: tobject); <br/> procedure tmr1timer (Sender: tobject); <br/> procedure idtcpsrvr1disconnect (athread: tidpeerthread ); <br/> private <br/> {private Declarations} <br/> xvid_version: integer; <br/> xvid_gbl: xvid_gbl_init_t; </P> <p> xvid_decode: xvid_dec_create_t; <br/> xvid_decframe: xvid_dec_frame_t; <br/> Public <br/> {public declarations} </P> <p> end; <br/> type <br/> Ti Mgsendbuf = packed record <br/> imgsize: word; <br/> Buffer: array [0 .. 352*288*3] of byte; <br/> end; <br/> var <br/> form1: tform1; <br/> imgsendbuf: timgsendbuf; <br/> frameimg: array [0 .. 352*288*3] of byte; <br/> framecount: longword = 0; <br/> framebytes: longword = 0; <br/> perframe: longword = 0; <br/> perframebytes: longword = 0; <br/> Implementation </P> <p> {$ R *. DFM} </P> <p> procedure tform1.btn 1 click (Sender: tobject); <br/> begin <br/> idtcpsrvr1.defaport port: = 9001; <br/> idtcpsrvr1.active: = true; <br/> mmo1.lines. add ('service startup! '); <Br/> end; </P> <p> procedure tform1.idtcpsrvr1connect (athread: tidpeerthread); <br/> begin <br/> mmo1.lines. add ('client connection exists! '); <Br/> end; </P> <p> procedure tform1.idtcpsrvr1execute (athread: tidpeerthread); <br/> var <br/> spbmp: tbitmap; <br/> RET: integer; <br/> biinfo: tbitmapinfo; <br/> bitmaphandle: hbitmap; <br/> dibptr: pointer; <br/> dibsize: longint; <br/> begin <br/> try <br/> spbmp: = tbitmap. create; <br/> athread. connection. readbuffer (imgsendbuf. imgsize, 2); <br/> athread. connection. readbuffer (imgsendbuf. buffer, IMGs Endbuf. imgsize); </P> <p> // initialize the decoded data frame structure <br/> xvid_decframe.version: = xvid_version; <br/> xvid_decframe.general: = 0; <br/> xvid_decframe.bitstream: = @ imgsendbuf. buffer [0]; // enter the decompressed bitstream <br/> xvid_decframe.length: = imgsendbuf. imgsize; // input bit stream length <br/> xvid_decframe.output.csp: = xvid_csp_bgr; // color space <br/> xvid_decframe.output.plane [0]: = @ frameimg [0]; // extract the output buffer <br/> xvid_decframe.output.stride [0]: = 320*3; // number of bytes per row <br/> RET: = xvid_decore (xvid_decode.handle, xvid_dec_decode, @ xvid_decframe, nil); <br/> // mmo1.lines. add ('img: '+ inttostr (imgsendbuf. imgsize) + 'ret =: '+ inttostr (RET); <br/> // obtain the current bitmap from the video buffer <br/> biinfo. bmiheader. bisize: = 40; // sizeof (tbitmapinfoheader); <br/> biinfo. bmiheader. biwidth: = 320; <br/> biinfo. bmiheader. biheight: = 240; <br/> biinfo. bmiheader. biplanes: = 1; <br /> Biinfo. bmiheader. bibitcount: = 24; <br/> biinfo. bmiheader. bicompression: = 0; <br/> biinfo. bmiheader. bisizeimage: = 320*240*3; <br/> biinfo. bmiheader. bixpelspermeter: = 0; <br/> biinfo. bmiheader. biypelspermeter: = 0; <br/> biinfo. bmiheader. biclrused: = 0; <br/> biinfo. bmiheader. biclrimportant: = 0; <br/> bitmaphandle: = createdibsection (0, biinfo, dib_rgb_colors, dibptr, 0, 0); <br/> move (F Rameimg, dibptr ^, biinfo. bmiheader. bisizeimage); <br/> spbmp. handle: = bitmaphandle; <br/> img1.canvas. lock; <br/> img1.canvas. draw (0, 0, spbmp); <br/> img1.canvas. unlock; </P> <p> Inc (framecount); // received frame <br/> framebytes: = framebytes + imgsendbuf. imgsize + 2; // received bytes <br/> finally <br/> deleteobject (bitmaphandle); <br/> spbmp. free; <br/> end; </P> <p> procedure tform1.formcreate (Sender: TOB Ject); <br/> begin <br/> // Xvid library initialization operation <br/> xvid_version: = xvid_make_version (, 0); <br/> xvid_gbl.version: = xvid_version; // version: 1.1.0 <br/> xvid_gbl.cpu_flags: = word (xvid_cpu_force or xvid_cpu_asm); // 0: automatically checks the CPU, xvid_cpu_force or xvid_cpu_asm: force use ASM Assembly optimization <br/> xvid_gbl.debug: = 0; // debug level </P> <p> // initialize codec <br/> xvid_global (nil, xvid_gbl_init, @ xvid_gbl, nil); </P> <p> xvid_decode.version: = Xvid _ Version; <br/> xvid_decode.width: = 320; <br/> xvid_decode.height: = 240; <br/> // create a decoder <br/> xvid_decore (nil, xvid_dec_create, @ xvid_decode, nil); <br/> end; </P> <p> procedure tform1.formclosequery (Sender: tobject; var canclose: Boolean ); <br/> begin <br/> if assigned (xvid_decode.handle) Then <br/> xvid_decore (xvid_decode.handle, handle, @ xvid_decode, nil); <br/> end; </P> <p> procedure tform1.btn2c Lick (Sender: tobject); <br/> begin <br/> idtcpsrvr1.active: = false; <br/> end; </P> <p> procedure tform1.tmr1timer (Sender: tobject); <br/> begin <br/> perframe: = framecount-perframe; <br/> perframebytes: = (framebytes-perframebytes) Div 1024; <br/> lbl1.caption: = 'current traffic: '+ inttostr (perframe) + 'frame/second' + inttostr (perframebytes) + 'K/second'; <br/> perframebytes: = framebytes; <br/> perframe: = framecount; <Br/> end; </P> <p> procedure tform1.idtcpsrvr1disconnect (athread: tidpeerthread); <br/> begin <br/> mmo1.lines. Add ('client disconnected! '); <Br/> end; </P> <p> end. </P> <p> //******************************* ************************** * ********************** </P> <p> unit main; </P> <p> interface </P> <p> uses <br/> Windows, messages, sysutils, variants, classes, graphics, controls, forms, <br/> dialogs, dsutil, stdctrls, dspack, directshow9, menus, extctrls, lib_xvid, <br/> idbasecomponent, idcomponent, idtcpserver, idglobal, idtcp Connection, <br/> idtcpclient, idthreadmgr, idthreadmgrdefault, idantifreezebase, <br/> idantifreeze; </P> <p> type <br/> tvideoform = Class (tform) <br/> filtergraph: tfiltergraph; <br/> videowindow: tvideowindow; <br/> mainmenu1: tmainmenu; <br/> devices: tmenuitem; <br/> filter: tfilter; <br/> image: timage; <br/> samplegrabber: tsamplegrabber; <br/> snapshot: tbutton; <br/> callback: tcheckbox; <br /> Mmo1: tmemo; <br/> lbl1: tlabel; <br/> idtcpclnt1: tidtcpclient; <br/> btn1: tbutton; <br/> procedure formcreate (Sender: tobject); <br/> procedure formclosequery (Sender: tobject; var canclose: Boolean); <br/> procedure snapshotclick (Sender: tobject ); <br/> procedure samplegrabberbuffer (Sender: tobject; sampletime: Double; <br/> pbuffer: pointer; bufferlen: integer ); </P> <p> private <br/> // XVI D encoder <br/> xvid_gbl: Large; <br/> xvid_enc: xvid_enc_create_t; <br/> xvid_encframe: xvid_enc_frame_t; <br/> xvid_encstats: large; </P> <p> Public <br/> procedure onselectdevice (Sender: tobject); <br/> end; </P> <p> type <br/> timgsendbuf = packed record <br/> imgsize: word; <br/> Buffer: array [0 .. 352*288*3] of byte; <br/> end; <br/> var <br/> videoform: tvideoform; <br/> sysde V: tsysdevenum; <br/> framebuf: array [0 .. 352*288*3] of byte; <br/> frameimg: array [0 .. 352*288*3] of byte; <br/> framesequece: longword = 0; <br/> xvid_version: integer; <br/> framebytecount: longword = 0; <br/> curframe: longword = 0; <br/> sending: bool = false; <br/> imgsendbuf: timgsendbuf; <br/> Implementation </P> <p> {$ R *. DFM} </P> <p> procedure tvideoform. formcreate (Sender: tobject); <br/> var <br/> I: integer; <br/> device: tmenuitem; <br/> begin <br/> xvid_version: = xvid_make_version (1, 1, 0); <br/> sysdev: = tsysdevenum. create (clsid_videoinputdevicecategory); <br/> If sysdev. countfilters> 0 then <br/> for I: = 0 to sysdev. countfilters-1 do <br/> begin <br/> device: = tmenuitem. create (devices); <br/> device. caption: = sysdev. filters [I]. friendlyname; <br/> device. tag: = I; <br/> device. oncli CK: = onselectdevice; <br/> devices. add (device); <br/> end; </P> <p> procedure tvideoform. onselectdevice (Sender: tobject); <br/> begin <br/> self. doublebuffered: = true; <br/> filtergraph. cleargraph; <br/> filtergraph. active: = false; <br/> filter. basefilter. moniker: = sysdev. getmoniker (tmenuitem (sender ). tag); <br/> filtergraph. active: = true; <br/> with filtergraph as icapturegraphbuilder2 DO <br/> begin <br/> renderstream (@ pin_category_preview, nil, filter as ibasefilter, samplegrabber as ibasefilter, videowindow as ibasefilter); <br/> end; <br/> try <br/> // Xvid library initialization operation <br/> xvid_gbl.version: = xvid_version; // version: 1.1.0 <br/> xvid_gbl.cpu_flags: = word (xvid_cpu_force or xvid_cpu_asm); // 0: automatically checks the CPU, xvid_cpu_force or xvid_cpu_asm: enforces ASM Assembly optimization <br/> xvid_gbl.debug: = 0; // debugging level </P> <p> // Initialize the codec <br/> xvid_global (nil, xvid_gbl_init, @ xvid_gbl, nil); </P> <p> // initialize the Xvid encoder <br/> xvid_enc.version: = xvid_version; <br/> // encoder parameter <br/> xvid_enc.global: = xvid_global_packed; // global flag <br/> xvid_enc.width: = 320; // The width of the compressed video <br/> xvid_enc.height: = 240; // The height of the compressed video <br/> xvid_enc.fbase: = 3; // basic frame rate/second = fbase * 10 = 30 <br/> xvid_enc.fincr: = 1; // frame rate growth step, 0: Variable Step Size,> 1 actual growth step <br/> xvid_enc.profile: = Xvid_profile_as_l4; // compression level, maximum MPEG4-ASP compression level <br/> xvid_enc.max_key_interval: = 0; // maximum key frame interval <br/> xvid_enc.frame_drop_ratio: = 0; // frame drop rate; 0 ~ 100 <br/> xvid_enc.max_bframes: = 0; // whether to use B frames. Generally, I and P frames are used. If 1 = Pb frames, <br/> xvid_enc.bquant_offset: = 0; <br/> xvid_enc.bquant_ratio: = 0; </P> <p> // create an encoder <br/> xvid_encore (nil, xvid_enc_create, @ xvid_enc, nil ); <br/> // initialize the compressed data frame structure <br/> xvid_encframe.version: = xvid_version; <br/> // --- vol flags <br/> xvid_encframe.vol_flags: = 0; // xvid_vol_mpegquant or xvid_vol_quarterpel or xvid_vol_gmc; <br/> // --- v OP flags <br/> xvid_encframe.vop_flags: = 0; // xvid_vop_halfpel or xvid_vop_inter4; </P> <p> xvid_encframe.motion: = 0; // xvid_me_advanceddiamond16 or earlier or <br/> // xvid_me_advanceddiamond8 or later; // motion estimation <br/> xvid_encframe.quant: = 4; // quality control = quantization parameter, 0 ~ 31. The smaller the value, the higher the quality and the bitrate are inversely proportional </P> <p> xvid_encframe.coding_type: = xvid_type_auto; // xvid_type_auto = enables the encoder to automatically determine the I frame encoding is the Key Frame, P frame encoding is intra-Frame Prediction </P> <p> before t <br/> exit; <br/> end; <br/> filtergraph. play; <br/> end; </P> <p> procedure tvideoform. formclosequery (Sender: tobject; var canclose: Boolean); <br/> begin <br/> callback. checked: = false; <br/> sysdev. free; <br/> filtergraph. cleargraph; <br/> filtergraph. active: = false; <br/> // disable the decoder <br/> if assigned (xvid_enc.handle) Then <br/> xvid_encore (xvid_enc.handle, handle, @ xvid_enc, nil ); </P> <p> end; </P> <p> procedure tvideoform. snapshotclick (Sender: tobject); <br/> begin <br/> idtcpclnt1.disconnect; <br/> idtcpclnt1.host: = '2017. 0.0.1 '; <br/> idtcpclnt1.port: = 9001; <br/> idtcpclnt1.connect; <br/> end; </P> <p> procedure tvideoform. samplegrabberbuffer (Sender: tobject; <br/> sampletime: Double; pbuffer: pointer; bufferlen: integer); <br/> var <br/> spbmp: tbitmap; <br/> RET: integer; <br/> begin <br/> If callback. checked then <br/> begin </P> <p> try <br/> xvid_encframe.bitstream: = @ framebuf [0]; <br/> xvid_encframe.input.csp: = xvid_csp_bgr; // The input is an RGB bitmap <br/> xvid_encframe.input.plane [0]: = pbuffer; // RGB bitmap data. Each pixel has three bytes (R, G, B) <br/> xvid_encframe.input.stride [0]: = 320*3; // number of bytes per row </P> <p> // start compression <br/>/RET: = xvid_encore (bytes, xvid_enc_encode, @ xvid_encframe, @ bytes); // return encoded bytes <br/> RET: = xvid_encore (bytes, bytes, @ xvid_encframe, nil ); // return encoded bytes </P> <p> // sent over the network <br/> If idtcpclnt1.connected then <br/> begin <br/> imgsendbuf. imgsize: = ret; <br/> move (framebuf, imgsendbuf. buffer, RET); <br/> idtcpclnt1.writebuffer (imgsendbuf, RET + 2, true); <br/> end; <br/> else t </P> <p> end; <br/> end; </P> <p> end. </P> <p>