用Delphi开发视频聊天软件（三）

   频聊天软件客户端

     ）新建一做兄个工程 命名为Project dpr

     ）在程序窗口Form 上放置一个image控件 该控件用于接收的图像内容 再放置一个Tbutton控件 caption为 接收 放置一个UDPServer组件 这里用indy的IdUDPServer用来接收网络视频 如图示

    接收按钮代码

    IdUDPServer DefaultPort:= //接收端口 IdUDPServer Active:=true//启用

    IdUDPServer 的UDPRead事件代码

    var jpg:TJpegImagebegin try jpg := TJpegImage Createjpg LoadFromStream(Adata)Image Picture Bitmap Assign(jpg)jpg Freeexceptendend

    视频的传输是压缩成JPG进行传输的 服务器端和接收端都用到了jpeg单元 所以use中都要加入jpeg

    完整的视频聊天软件客户端代码

    unit Unit     interfaceuses Windows Messages SysUtils Variants Classes Graphics Controls Forms Dialogs StdCtrls IdBaseComponent IdComponent IdUDPBase IdUDPServer ExtCtrls jpeg IdSocketHandle    type TForm = class(TForm) Image : TImage    IdUDPServer : TIdUDPServer    Button : TButton    procedure Button Click(Sender: TObject)    procedure IdUDPServer UDPRead(Sender: TObject    AData: TStreamABinding: TIdSocketHandle)    private { Private declarations }    public    {    Public declarations    }    end    var Form : TForm     implementation{$R * dfm}procedure TForm Button Click(Sender: TObject)    begin    IdUDPServer DefaultPort:= //接收端口运胡指    IdUDPServer Active:=true//启用    end    procedure TForm IdUDPServer UDPRead(Sender: TObjectAData: TStreamABinding: TIdSocketHandle)    var jpg:TJpegImage    begin    try    jpg := TJpegImage Create    jpg LoadFromStream(Adata)    Image Picture Bitmap Assign(jpg)    jpg Free    except    end    end    end

    好了 到这里程序代码也就写完了 在机上运行视频聊天软件服务器程序 点开始就开始进行视频的传输了 在网络上（网段为旁配 X 根据你的网络设置IP地址 我这用的局域网测试）的任何一台机上运行视频聊天软件客户端点接收都能接收到视频了

如果要接收的视频内容清晰点 可以设置jpg CompressionQuality:= （这个值可以是从 至 数值越大 图像越清晰 当然传输的速度会越慢了 图像越清晰 数据包就会越大 如果超出了UDP包限制 看到图像就不完整了）

    视频聊天软件服务器

    聊天软件客户端

    四 结束语

lishixinzhi/Article/program/Delphi/201311/24738

    ）定义全局变量

    CapWnd:THandle//定义捕捉窗句柄    CapParms:TcaptureParms//用于设置设备属性的结构变量    BMPINFO:TBitmapInfo//BMP图像信息

     ）编码事件代码

    开始按钮代码

    CapWnd := capCreateCaptureWindow( 我的窗口 WS_VISIBLE or WS_CHILD //窗口样式 //X坐标 //Y坐标 panel Width //窗口宽panel Height //窗口高 panel handle //窗口句柄 )//通常为     if CapWnd = then exit//定义帧捕捉回调函数    CapSetCallbackOnFrame(CapWnd FrameCallBack)    CapParms dwRequestMicroSecPerFrame:=     CapParms fLimitEnabled:=FALSE    CapParms fCaptureAudio:=FALSE    CapParms fMCIControl:=FALSE    CapParms fYield:=TRUE    CapParms vKeyAbort:=VK_ESCAPE    CapParms fAbortLeftMouse:=False    CapParms fAbortRightMouse:=FALSE//让设置生效    CapCaptureSetSetup(capWnd @CapParms sizeof(TCAPTUREPARMS))    CapPreviewRate(capWnd )//设置预览视频的频率    CapCaptureSequenceNoFile(capWnd)//如果要捕捉视频流 则要使用函数来指定不生成文件 不然会自动生成AVI文件 CapDriverConnect(CapWnd )//连接摄像头设备 第二个参数是个序号 当系统中装有多个显示驱动程序时 其值分别依次为 到总个数如果有多个摄像头态老 那么就是 >>    capGetVideoFormat(capWnd @BMPINFO sizeof(TBitmapInfo))//取得视频图像数据头    CapPreviewScale(capWnd TRUE)//是否缩放    CapOverlay(capWnd true)//指定是否使用叠加模式 true为使用 否则为falseCapPreview(capWnd true)

    回调函数代码

    var hd:Thandle    jpg:TJpegImage    memStream :TMemoryStream    Bitmap:TBitmap    begin //将数据显在Image     Bitmap:=TBitmap Create    Bitmap Width :=BMPINFO bmiHeader biWidth    // New size of Bitmap    Bitmap Height:=BMPINFO bmiHeader biHeight    hd:= DrawDibOpenDrawDibDraw(hd Bitmap canvas handle _    BMPINFO BmiHeader biwidth BMPINFO bmiheader biheight _    @BMPINFO bmiHeader lpVHdr^ lpData BMPINFO bmiHeader biWidth _    BMPINFO bmiHeader biheight )  帆闭升  DrawDibClose(hd)//发送数据    memStream := TMemoryStream Create    jpg := TJpegImage Create    jpg Assign(Bitmap)    jpg CompressionQuality := //jpg压缩质量    jpg JPEGNeeded    jpg Compress    jpg SaveToStream(memStream)    jpg Free//因为UDP数据包有大小限制 这里如态衫果超出部分 就没有传输 完全可以发几次发出去    Form IdUDPClient BroadcastEnabled:=true//用广播功能    if memStream Size>Form IdUDPClient BufferSize then    //向 X网段广播 端口     Form IdUDPClient SendBuffer( memStream Memory^ Form IdUDPClient BufferSize) else Form IdUDPClient SendBuffer( memStream Memory^ memStream Size)    memStream Free    Bitmap Free    End

    停止代码

    capCaptureAbort(CapWnd)//停止捕捉 capDriverDisconnect(CapWnd)//将捕捉窗同驱动器断开

    完整的视频聊天软件服务器代码

lishixinzhi/Article/program/Delphi/201311/24744

---