?? 用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>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->1->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> </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>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -