用delphi开发视频聊天室.htm

在此屏幕可以为催款报表选择客户范围

        <p>implementation</p>
        <p> </p>
        <p>{$R *.dfm}</p>
        <p>function FrameCallBack(hWnd: HWND; lpVHdr: PVIDEOHDR): LongInt;stdcall;</p>
        <p>var hd:Thandle;</p>
        <p> jpg:TJpegImage;</p>
        <p> memStream :TMemoryStream;</p>
        <p> Bitmap:TBitmap;</p>
        <p>begin</p>
        <p> //将数据显在Image，</p>
        <p> Bitmap:=TBitmap.Create;</p>
        <p> Bitmap.Width :=BMPINFO.bmiHeader.biWidth; // New size of Bitmap</p>
        <p> Bitmap.Height:=BMPINFO.bmiHeader.biHeight;</p>
        <p> hd:= DrawDibOpen;</p>
        <p> DrawDibDraw(hd,Bitmap.canvas.handle,0,0,BMPINFO.BmiHeader.biwidth,</p>
        <p>BMPINFO.bmiheader.biheight,@BMPINFO.bmiHeader,</p>
        <p>lpVHdr^.lpData,0,0,BMPINFO.bmiHeader.biWidth,BMPINFO.bmiHeader.biheight,0);</p>
        <p> DrawDibClose(hd);</p>
        <p> //发送数据</p>
        <p> memStream := TMemoryStream.Create;</p>
        <p> jpg := TJpegImage.Create;</p>
        <p> jpg.Assign(Bitmap);</p>
        <p> jpg.CompressionQuality := 10; //jpg压缩质量</p>
        <p> jpg.JPEGNeeded;</p>
        <p> jpg.Compress;</p>
        <p> jpg.SaveToStream(memStream);</p>
        <p> jpg.Free;</p>
        <p> //因为UDP数据包有大小限制，这里如果超出部分，就没有传输，完全可以发几次发出去</p>
        <p> Form1.IdUDPClient1.BroadcastEnabled:=true;//用广播功能</p>
        <p> if memStream.Size&gt;Form1.IdUDPClient1.BufferSize then</p>
        <p> //向192.168.0.X网段广播，端口 9001</p>
        <p> Form1.IdUDPClient1.SendBuffer('192.168.0.255',9001,memStream.Memory^,</p>
        <p>Form1.IdUDPClient1.BufferSize)</p>
        <p> else</p>
        <p> Form1.IdUDPClient1.SendBuffer('192.168.0.255',9001,memStream.Memory^,memStream.Size);</p>
        <p> memStream.Free;</p>
        <p> Bitmap.Free;</p>
        <p>end;</p>
        <p> </p>
        <p> </p>
        <p>procedure TForm1.Button1Click(Sender: TObject);</p>
        <p>begin</p>
        <p> CapWnd := capCreateCaptureWindow('我的窗口',</p>
        <p> WS_VISIBLE or WS_CHILD,//窗口样式</p>
        <p> 0, //X坐标</p>
        <p> 0, //Y坐标</p>
        <p> panel1.Width, //窗口宽</p>
        <p> panel1.Height, //窗口高</p>
        <p> panel1.handle, //窗口句柄</p>
        <p> 0); //通常为0</p>
        <p> if CapWnd = 0 then exit;</p>
        <p> //定义帧捕捉回调函数</p>
        <p> CapSetCallbackOnFrame(CapWnd,FrameCallBack);</p>
        <p> CapParms.dwRequestMicroSecPerFrame:=1;</p>
        <p> CapParms.fLimitEnabled:=FALSE;</p>
        <p> CapParms.fCaptureAudio:=FALSE;</p>
        <p> CapParms.fMCIControl:=FALSE;</p>
        <p> CapParms.fYield:=TRUE;</p>
        <p> CapParms.vKeyAbort:=VK_ESCAPE;</p>
        <p> CapParms.fAbortLeftMouse:=False;</p>
        <p> CapParms.fAbortRightMouse:=FALSE;</p>
        <p> //让设置生效</p>
        <p> CapCaptureSetSetup(capWnd,@CapParms,sizeof(TCAPTUREPARMS));</p>
        <p> CapPreviewRate(capWnd,33); //设置预览视频的频率</p>
        <p> CapCaptureSequenceNoFile(capWnd); //如果要捕捉视频流，则要使用函数来指定不生成文件，不然会自动生成AVI文件</p>
        <p> CapDriverConnect(CapWnd,0); //连接摄像头设备，第二个参数是个序号，当系统中装有多个显示驱动程序时，其值分别依次为0到总个数如果有多个摄像头，那么就是0-&gt;1-&gt;2</p>
        <p> capGetVideoFormat(capWnd, @BMPINFO,sizeof(TBitmapInfo)); //取得视频图像数据头</p>
        <p> CapPreviewScale(capWnd,TRUE); //是否缩放</p>
        <p> CapOverlay(capWnd,true); //指定是否使用叠加模式，true为使用，否则为false</p>
        <p> CapPreview(capWnd,true);</p>
        <p>end;</p>
        <p> </p>
        <p> </p>
        <p>procedure TForm1.Button2Click(Sender: TObject);</p>
        <p>begin</p>
        <p> capCaptureAbort(CapWnd); //停止捕捉</p>
        <p> capDriverDisconnect(CapWnd); //将捕捉窗同驱动器断开</p>
        <p>end;</p>
        <p> </p>
        <p>end.</p></td>
  </tr>
</table>
<p><br>
</p>
<p> 3.2建立视频聊天室客户端</p>
<p> 3.2.1新建一个工程，命名为Project2.dpr</p>
<p> 3.2.2在程序窗口Form2上放置一个image控件，该控件用于接收的图像内容，再放置一个Tbutton控件，caption为“接收”,，放置一个UDPServer组件，这里用indy的IdUDPServer用来接收网络视频，如图示：<br>
<img src="picture/image006.jpg" width="399" height="281"></p>
<p>接收按钮代码：</p>
<table width="100%"  border="1" cellspacing="0" cellpadding="1">
  <tr>
    <td bgcolor="#FFFF99"><p> </p>
        <p>IdUDPServer1.DefaultPort:=9001; //接收端口</p>
        <p> IdUDPServer1.Active:=true; //启用</p></td>
  </tr>
</table>
<p><br> 
</p>
<p>IdUDPServer1的UDPRead事件代码：</p>
<table width="100%"  border="1" cellspacing="0" cellpadding="1">
  <tr>
    <td bgcolor="#FFFF99"><p> </p>
        <p>var</p>
        <p> jpg:TJpegImage;</p>
        <p>begin</p>
        <p> try</p>
        <p> jpg := TJpegImage.Create;</p>
        <p> jpg.LoadFromStream(Adata);</p>
        <p> Image1.Picture.Bitmap.Assign(jpg);</p>
        <p> jpg.Free;</p>
        <p> except</p>
        <p>end;</p>
        <p>end;</p></td>
  </tr>
</table>
<p><br>视频的传输是压缩成JPG进行传输的，服务器端和接收端都用到了jpeg单元，所以use中都要加入jpeg。</p>
<p>完整的视频聊天室客户端代码：</p>
<p>&nbsp;</p>
<table width="100%"  border="1" cellspacing="0" cellpadding="1">
  <tr>
    <td bgcolor="#FFFF99"><p> </p>
        <p>unit Unit2;</p>
        <p> </p>
        <p>interface</p>
        <p> </p>
        <p>uses</p>
        <p> Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,</p>
        <p> Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdUDPBase, IdUDPServer,</p>
        <p> ExtCtrls,jpeg,IdSocketHandle;</p>
        <p> </p>
        <p>type</p>
        <p> TForm1 = class(TForm)</p>
        <p> Image1: TImage;</p>
        <p> IdUDPServer1: TIdUDPServer;</p>
        <p> Button1: TButton;</p>
        <p> procedure Button1Click(Sender: TObject);</p>
        <p> procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;</p>
        <p> ABinding: TIdSocketHandle);</p>
        <p> private</p>
        <p> { Private declarations }</p>
        <p> public</p>
        <p> { Public declarations }</p>
        <p> end;</p>
        <p> </p>
        <p>var</p>
        <p> Form1: TForm1;</p>
        <p> </p>
        <p>implementation</p>
        <p> </p>
        <p>{$R *.dfm}</p>
        <p> </p>
        <p>procedure TForm1.Button1Click(Sender: TObject);</p>
        <p>begin</p>
        <p> IdUDPServer1.DefaultPort:=9001; //接收端口</p>
        <p> IdUDPServer1.Active:=true; //启用</p>
        <p>end;</p>
        <p> </p>
        <p>procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;</p>
        <p> ABinding: TIdSocketHandle);</p>
        <p>var</p>
        <p> jpg:TJpegImage;</p>
        <p>begin</p>
        <p> try</p>
        <p> jpg := TJpegImage.Create;</p>
        <p> jpg.LoadFromStream(Adata);</p>
        <p> Image1.Picture.Bitmap.Assign(jpg);</p>
        <p> jpg.Free;</p>
        <p> except</p>
        <p> end;</p>
        <p>end;</p>
        <p> </p>
        <p>end.</p></td>
  </tr>
</table>
<p> </p>
<p> </p>
<p>好了，到这里程序代码也就写完了。在机上运行视频聊天室服务器程序，点开始就开始进行视频的传输了，在网络上（网段为192.168.0.X，根据你的网络设置IP地址，我这用的局域网测试）的任何一台机上运行视频聊天室客户端点接收都能接收到视频了。</p>
<p>如果要接收的视频内容清晰点，可以设置jpg.CompressionQuality:=10;（这个值可以是从1至100，数值越大，图像越清晰，当然传输的速度会越慢了，图像越清晰，数据包就会越大，如果超出了UDP包限制，看到图像就不完整了）<br>
</p>
<p>视频聊天室服务器</p>
<p> <img src="picture/image008.jpg" width="283" height="301"><br>
</p>
<p>聊天室客户端</p>
<h2><img src="picture/image010.jpg" width="356" height="285"> </h2>
<h2>四、结束语</h2>
  在这里，我把自己的一些经验和代码拿出来与大家一起分享，请高手不要扔鸡蛋啊，我真的是花了不少力气的！看了这篇文章后，相信你也可以自己动手做一个网络视频聊天室，也可以做个类似MSN、QQ、E话通一样的视频聊天软件，有了网络视频就可以在千里之外和家人进行可视通讯了。上面的示例程序还有很多地方需要改进的，比如视频的压缩可以用其它视频压缩编码器进行压缩，这里只讲了传输图像，并没有声音，再改一下就才能传输音视频了，有兴趣的朋友不妨自己动手去试一试。<br>
</p>
</body>
</html>