⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 usdk_demo.~pas

📁 一个用Delpi写的视频聊天的SDK
💻 ~PAS
📖 第 1 页 / 共 2 页
字号:
{$DEFINE Debug}

unit uSdk_Demo;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, activex,
  rfClientProj1_TLB, lmEditProj1_TLB, lmViewProj1_TLB, rfListProj1_TLB, rfXmlProj1_TLB,
  ExtCtrls, StdCtrls, Buttons, ComCtrls, OleCtrls, ImgList,
  Menus, AppEvnts, ActnList, SHDocVw,
  ustringfunc, uClientCFG,
  uSkinForm,
  bsSkinCtrls;
const
  Cmd_GetRoomListAns = 1002; //获取房间列表回复
  Cmd_CreateRoomAns = 1004; //创建房间回复
  Cmd_ModifyRoomAns = 1006; //修改房间资料
  Cmd_DeleteRoomAns = 1009; //删除房间
  Cmd_RoomInfoChangedNotify = 1012; // 房间资料修改通知

  Cmd_LoginAns = 2002; //登陆回复
  Cmd_UserLoginNotify = 2005; //用户登陆通知
  Cmd_UserLogoutNotify = 2006; //用户退出通知

  Cmd_MicReqAns = 2021; //申请发言回复
  Cmd_MicCancelAns = 2023; //取消发言回复
  Cmd_SpeakNotify = 2024; //发言通知
  Cmd_MicOrderListChangeNotify = 2026; //麦序变化通知

  Cmd_TransPack = 2040; //收到转发包
  Cmd_Chat = 2041; //文字消息

  Cmd_MngCommandNotify = 2061; //管理命令通知
  //CmdType包含如下类型:
  mcxDropUser = $00000000; //param1 参考TDropUserParam 0:只踢出 1:踢出并禁止登陆xx分钟 2:踢出并禁止相同IP登陆
  mcxSetTempMng = $00000001;
  mcxUnsetTempMng = $00000002;
  mcxCancelMic = $00000003;
  mcxPrepareMic = $00000004;
  mcxAddMic = $00000005;
  mcxAddMicTick = $00000006;

  Cmd_UserToPlugPack = 2300; //请求服务器将包转发给插件
  Cmd_PlugToUserPack = 2301; //插件请求服务器转发给客户端的包

  Html_ChatHeader_Public = '<font color="#000000" size="2" face="宋体"><a href="userid:%d">%s</a>对<a href="userid:%d">%s</a>说:</font>';
type
  pRoomInfo = ^TRoomInfo;
  TRoomInfo = record
    RoomID: Integer;
    NeedPassWord: Boolean;
    RoomName: string;
    RoomMemo: string;
    RoomType: Byte;
    MaxUserCount: Integer;
    ChannelCount: Integer;
    CurUserCount: Integer;
  end;

  TLoginInfo = record
    UserID: Cardinal;
    NickName: string;
    Sex: string;
    PassWord: string;
    RoomPassWord: string;
    MngPassword: string;
  end;

  TForm1 = class(TForm)
    Timer1: TTimer;
    ApplicationEvents1: TApplicationEvents;
    GroupBox1: TGroupBox;
    B_LogOut: TBitBtn;
    Pop_User: TPopupMenu;
    NUserID: TMenuItem;
    ActionList1: TActionList;
    A_AddMic: TAction;
    A_PrepareMic: TAction;
    A_CancelMic: TAction;
    A_SetTempMng: TAction;
    A_UnSetTempMng: TAction;
    A_AddMicTick: TAction;
    A_DropUser: TAction;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    N8: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    FXML: TrfXml;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Panel10: TPanel;
    Panel1: TPanel;
    Panel8: TPanel;
    pnl_Client: TPanel;
    FSDKClient: TrfClient;
    Panel3: TPanel;
    lmView1: TlmView;
    Panel2: TPanel;
    Panel7: TPanel;
    Memo2: TMemo;
    Panel4: TPanel;
    pnl_Video_Back_1: TPanel;
    Panel11: TPanel;
    img_RoomList: TImageList;
    GroupBox2: TGroupBox;
    Label4: TLabel;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    E_Targert: TEdit;
    CheckBox1: TCheckBox;
    GroupBox4: TGroupBox;
    lmEdit1: TlmEdit;
    B_Send: TBitBtn;
    Web_Left: TWebBrowser;
    Button1: TButton;
    Button2: TButton;
    Panel12: TPanel;
    RoomList: TbsSkinListView;
    bsSkinGroupBox1: TbsSkinGroupBox;
    ListMng: TrfList;
    bsSkinGroupBox2: TbsSkinGroupBox;
    ListMic: TrfList;
    bsSkinGroupBox3: TbsSkinGroupBox;
    ListUser: TrfList;
    B_Zoom_1: TSpeedButton;
    B_AudioEnable_1: TSpeedButton;
    PV_1: TPanel;
    Label1: TLabel;
    E_NickName: TEdit;
    C_Mng: TCheckBox;
    E_MngPassWord: TEdit;
    Label2: TLabel;
    P_1: TProgressBar;
    L_Audio_1: TLabel;
    pnl_Video_Back_2: TPanel;
    B_Zoom_2: TSpeedButton;
    B_AudioEnable_2: TSpeedButton;
    L_Audio_2: TLabel;
    PV_2: TPanel;
    P_2: TProgressBar;
    procedure BitBtn4lick(Sender: TObject);
    procedure B_SendClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Bs_2Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ApplicationEvents1Message(var Msg: tagMSG;
      var Handled: Boolean);
    procedure B_TransPackClick(Sender: TObject);
    procedure A_AddMicExecute(Sender: TObject);
    procedure A_AddMicTickExecute(Sender: TObject);
    procedure A_PrepareMicExecute(Sender: TObject);
    procedure A_CancelMicExecute(Sender: TObject);
    procedure A_SetTempMngExecute(Sender: TObject);
    procedure A_UnSetTempMngExecute(Sender: TObject);
    procedure A_DropUserExecute(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FSDKClientMSG(ASender: TObject; const AMsg: WideString);
    procedure FSDKClientLog(ASender: TObject; const ALogMsg: WideString);
    procedure FSDKClientError(ASender: TObject;
      const AErroMsg: WideString);
    procedure FormCreate(Sender: TObject);
    procedure RoomListDblClick(Sender: TObject);
    procedure lmView1BeforeNavigate2(ASender: TObject;
      const AURL: WideString; var cancel: WordBool);
    procedure Web_LeftBeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure ListUserMouseDown(ASender: TObject; AButton: TOleEnum;
      AUserID: Cardinal; const ANickName, AUserInfoStr: WideString);
    procedure Button1Click(Sender: TObject);
    procedure RoomListCustomDrawSubItem(Sender: TCustomListView;
      Item: TListItem; SubItem: Integer; State: TCustomDrawState;
      var DefaultDraw: Boolean);
    procedure Button2Click(Sender: TObject);
    procedure B_Zoom_1Click(Sender: TObject);
    procedure lmEdit1KeyPress(ASender: TObject; var Key: Smallint);
    procedure B_AudioEnable_1Click(Sender: TObject);
    procedure B_Zoom_2Click(Sender: TObject);
  private
    //    FSelfInfo: TUser ;
    FSelUserID: Cardinal;
    FSelUserInfo: string;
    FLogined: Boolean;

    FUserInfo: TLoginInfo; //保存自己的登陆信息
    //////
    procedure DOLoginAns(const Msg: string);
    procedure DoUserLogoutNotify(const Msg: string);
    procedure DOChat(const Msg: string);
    procedure DoTransPack(const msg: string);
    procedure DoMngCommandNotify(const msg: string);
    procedure DoGetRoomListAns(const msg: string);
    procedure DoPlugToUserPack(const msg: string);
  public
    procedure Init(ARoomIP: string; ARoomPort: Word);
  end;

var
  Form1: TForm1;
  FOleInPlaceActiveObject: IOleInPlaceActiveObject;

implementation

uses uPassWordForm;

{$R *.dfm}

procedure TForm1.BitBtn4lick(Sender: TObject);
begin
  ListMic.Clear;
  listuser.Clear;
  ListMng.Clear;

  FSDKClient.LogOut;
  PageControl1.ActivePageIndex := 0;
  TabSheet2.TabVisible := false;
end;

procedure TForm1.B_SendClick(Sender: TObject);
var
  s: string;
begin
  s := lmEdit1.HtmlStr;
  lmEdit1.Clear;
  lmEdit1.SetEditFocus;
  if not FLogined then exit;

  FSDKClient.Chat(StrToInt64Def(E_Targert.Text, 0), s, CheckBox1.Checked);
  s := FSDKClient.MakeChatStr(FUserInfo.UserID, StrToInt64Def(E_Targert.Text, 0), s, CheckBox1.Checked);
  lmView1.AddContent(s);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  B_LogOut.Click;
  Sleep(50);
  Timer1.Enabled := false;
  FCFG.Free;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  i: Integer;
begin
  if FSDKClient <> nil then
  begin
    i := FSDKClient.GetVoiceVolume(1);
    L_Audio_1.Caption := IntToStr(i);
    p_1.Position := (i * 100 div 8000);

    i := FSDKClient.GetVoiceVolume(2);
    L_Audio_2.Caption := IntToStr(i);
    p_2.Position := (i * 100 div 8000);
  end;
end;

procedure TForm1.Bs_2Click(Sender: TObject);
begin
  FSDKClient.ShowScaleForm(2, true);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  lmEdit1.InsertEmotion;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  lmEdit1.ShowFontDialog;
end;

procedure TForm1.DOChat(const Msg: string);
begin
  {<?xml version="1.0" encoding="gb2312"?>
  <Ret Cmd="2041" Silent="False" UserID="2" TargetUserID="0" Broadcast="1" Msg=" test " HtmlMsg='xxx' ListCount="0"/>
 }
  FXML.Clear;
  FXML.XMLStr := Msg;

  lmView1.AddContent(FXML.GetField('HtmlMsg', -1));
end;

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
  var Handled: Boolean);
const
  StdKeys = [VK_TAB, VK_RETURN]; { standard keys }
  ExtKeys = [VK_DELETE, VK_BACK, VK_LEFT, VK_RIGHT, vk_Up, vk_Down]; { extended keys }
  fExtended = $01000000; { extended key flag }
var
  s: string;
begin
  if IsChild(lmView1.Handle, Msg.Hwnd) and (Msg.Message = WM_RBUTTONUP) then
  begin
    Handled := true;
    exit;
  end;

  Handled := False;
  with Msg do
    if ((Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST)) and
      ((wParam in StdKeys) or (wParam in ExtKeys) and ((lParam and fExtended) = fExtended)) then
    try
      if IsChild(lmEdit1.Handle, hWnd) then
      begin
        with lmEdit1.DefaultDispatch as IOleInPlaceActiveObject do
          Handled := TranslateAccelerator(Msg) = S_OK;

        if not Handled then
        begin
          Handled := True;
          TranslateMessage(Msg);
          DispatchMessage(Msg);
          exit;
        end;
      end;
    except
    end;

end;

procedure TForm1.DoTransPack(const msg: string);
begin
  FXML.Clear;
  FXML.XMLStr := Msg;
  Memo2.Lines.Add('transpack:' + FXML.GetField('Data', -1));
end;

procedure TForm1.B_TransPackClick(Sender: TObject);
begin
  //  FSDKClient.TransPack(StrToInt(E_Targert.Text), Edit1.Text);
end;

procedure TForm1.DOLoginAns(const Msg: string);
begin
  //Ret Cmd="2002" UserID="1" ErrorCode="7" ErrorMsg="管理密码错误" ListCount="0"/>
  FXML.Clear;
  FXML.XMLStr := Msg;

  if FXML.GetField('ErrorCode', -1) <> '0' then
  begin
    PageControl1.ActivePageIndex := 0;
    TabSheet2.TabVisible := False;
    ShowMessage(FXML.GetField('ErrorMsg', -1));
  end
  else
  begin
    FLogined := true;
    TabSheet2.TabVisible := True;
    PageControl1.ActivePageIndex := 1;
    FUserInfo.UserID := StrToInt64Def(FXML.GetField('UserID', -1), 0);
  end;
end;

procedure TForm1.A_AddMicExecute(Sender: TObject);
begin
  FSDKClient.Command(mcxAddMic, FSelUserID, 0, 0);
end;

procedure TForm1.A_AddMicTickExecute(Sender: TObject);
begin
  FSDKClient.Command(mcxAddMicTick, FSelUserID, 0, 0);
end;

procedure TForm1.A_PrepareMicExecute(Sender: TObject);
begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -