开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Delphi控件源码 > 查看源码
ChatingFrm.pas
资源名称：qqdelphiprog.rar　[点击查看]
上传用户：hylc_2004
上传日期：2014-01-23
资源大小：46800k
文件大小：88k
源码类别：

Delphi控件源码

开发平台：

Delphi

ChatingFrm.pas：源码内容
  1. unit ChatingFrm;
  3. interface
  5. uses
  6.   SysUtils, Windows, Menus, MMDevice, MMMixer, MMObj, Dialogs,
  7.   ExtCtrls, ImgList, Controls, StdCtrls, RxRichEd, MMSlider, MMMixCtl,
  8.   OleCtrls, SHDocVw, ComCtrls, Graphics, Classes,
  9.   Forms, UrlMon, Gauges,Messages,ShellApi,Color,
  10.   Global,MSHTML,VFW,Registry,StrUtils,Variants,ActiveX,MMSystem,
  11.   MMHook,WNDES, AppEvnts, StdActns, ActnList, Videocap, MMDesign, MMDIBCv, MMLevel,
  12.   MMConect, MMDSPObj, MMWavIn, MMACMCvt, ACMWaveOut,MySocket, ACMWaveIn, bsSkinCtrls,
  13.   BusinessSkinForm, fcButton, fcImgBtn;
  15. const
  16.   CGID_MSHTML: TGUID = '{DE4BA900-59CA-11CF-9592-444553540000}';  
  18. type
  19.   TChatingForm = class(TForm)
  20.     PnlLeftTop: TPanel;
  21.     Image10: TImage;
  22.     Image11: TImage;
  23.     Image12: TImage;
  24.     Image13: TImage;
  25.     Image14: TImage;
  26.     Image15: TImage;
  27.     PnlLeftBottom: TPanel;
  28.     Image16: TImage;
  29.     Image17: TImage;
  30.     Image18: TImage;
  31.     Image19: TImage;
  32.     Image20: TImage;
  33.     Image21: TImage;
  34.     ImgArrow: TImage;
  35.     ImgListSend: TImageList;
  36.     ImgListClose: TImageList;
  37.     ImgListHistory: TImageList;
  38.     ImgListArrow: TImageList;
  39.     ImgFont: TImage;
  40.     ImgSelFace: TImage;
  41.     ImgListMax: TImageList;
  42.     FontDialog1: TFontDialog;
  43.     lblState: TLabel;
  44.     ImgAddNew: TImage;
  45.     ImgSendFile: TImage;
  46.     ImgVoice: TImage;
  47.     ImgVideo: TImage;
  48.     TimerTopBar: TTimer;
  49.     SaveDialog: TSaveDialog;
  50.     ImgListInfo: TImageList;
  51.     MMVolumeControl1: TMMVolumeControl;
  52.     MMAudioLine2: TMMAudioLine;
  53.     MMMixerDevice1: TMMMixerDevice;
  54.     MMAudioLine1: TMMAudioLine;
  55.     MMVolumeControl2: TMMVolumeControl;
  56.     MMAudioLine3: TMMAudioLine;
  57.     Panel1: TPanel;
  58.     MsgContent: TWebBrowser;
  59.     MsgInput: TRxRichEdit;
  60.     TempRxRichEdit: TRxRichEdit;
  61.     ImgSelBack: TImage;
  62.     ImgBottomDraw: TImage;
  63.     TimerBottomBar: TTimer;
  64.     PnlSpplit: TPanel;
  65.     WebPopupMenu: TPopupMenu;
  66.     Copy1: TMenuItem;
  67.     SelectAll1: TMenuItem;
  68.     MMMixerSliderIn: TMMMixerSlider;
  69.     ImgMic: TImage;
  70.     MMMixerSliderOut: TMMMixerSlider;
  71.     ImgSpk: TImage;
  72.     ImgSpkDisabled: TImage;
  73.     ImgMicDisabled: TImage;
  74.     LblQuitAudio: TLabel;
  75.     PnlYourCamera: TPanel;
  76.     Image8: TImage;
  77.     Image9: TImage;
  78.     Image22: TImage;
  79.     Image23: TImage;
  80.     Image25: TImage;
  81.     Image26: TImage;
  82.     Image27: TImage;
  83.     PnlRightBottom: TPanel;
  84.     Image32: TImage;
  85.     Image33: TImage;
  86.     Image34: TImage;
  87.     Image35: TImage;
  88.     Image36: TImage;
  89.     Image37: TImage;
  90.     lblUserListTitle: TLabel;
  91.     TimerShowInputing: TTimer;
  92.     ImgSelColor: TImage;
  93.     ImgListSendType: TImageList;
  94.     SendTypePopupMenu: TPopupMenu;
  95.     TMEnter: TMenuItem;
  96.     TMCtrlEnter: TMenuItem;
  97.     ImgGroupMsg: TImage;
  98.     ApplicationEvents1: TApplicationEvents;
  99.     MainMenu1: TMainMenu;
  100.     ImgCopyScreen: TImage;
  101.     PopupMenu1: TPopupMenu;
  102.     A1: TMenuItem;
  103.     B1: TMenuItem;
  104.     C1: TMenuItem;
  105.     D1: TMenuItem;
  106.     E1: TMenuItem;
  107.     F1: TMenuItem;
  108.     G1: TMenuItem;
  109.     H1: TMenuItem;
  110.     O1: TMenuItem;
  111.     B2: TMenuItem;
  112.     X1: TMenuItem;
  113.     X2: TMenuItem;
  114.     OpenDialog: TOpenDialog;
  115.     ActionList1: TActionList;
  116.     EditCut1: TEditCut;
  117.     EditCopy1: TEditCopy;
  118.     EditPaste1: TEditPaste;
  119.     EditSelectAll1: TEditSelectAll;
  120.     EditUndo1: TEditUndo;
  121.     EditDelete1: TEditDelete;
  122.     PopupMenuEdit: TPopupMenu;
  123.     Undo1: TMenuItem;
  124.     N3: TMenuItem;
  125.     Cut1: TMenuItem;
  126.     Copy2: TMenuItem;
  127.     Paste1: TMenuItem;
  128.     Delete1: TMenuItem;
  129.     N4: TMenuItem;
  130.     SelectAll2: TMenuItem;
  131.     ImgHaveVideoDevice: TImage;
  132.     PnlMyCamera: TPanel;
  133.     Image1: TImage;
  134.     Image3: TImage;
  135.     Image4: TImage;
  136.     Image5: TImage;
  137.     Image2: TImage;
  138.     Image6: TImage;
  139.     Image7: TImage;
  140.     AviPanel: TPanel;
  141.     AviPanelOut: TPanel;
  142.     VideoCap: TVideoCap;
  143.     LblFPS: TLabel;
  144.     MMDesigner1: TMMDesigner;
  145.     ImgOpenVideoForm: TImage;
  146.     MMMixerDevice2: TMMMixerDevice;
  147.     ACMWaveOut: TACMWaveOut;
  148.     ACMWaveIn: TACMWaveIn;
  149.     CopyScreenTypePopupMenu: TPopupMenu;
  150.     MDirectCopyScreen: TMenuItem;
  151.     MCopyScreenAfterMinWindow: TMenuItem;
  152.     CopyScreenTimer: TTimer;
  153.     TVUserList: TbsSkinTreeView;
  154.     bsBusinessSkinForm1: TbsBusinessSkinForm;
  155.     Image24: TImage;
  156.     fcImageBtn1: TfcImageBtn;
  157.     fcImageBtn2: TfcImageBtn;
  158.     fcImageBtn3: TfcImageBtn;
  159.     fcImageBtn4: TfcImageBtn;
  160.     fcImageBtn5: TfcImageBtn;
  161.     Label1: TLabel;
  162.     Label2: TLabel;
  163.     Label3: TLabel;
  164.     Label4: TLabel;
  165.     Label5: TLabel;
  166.     bsSkinPanel1: TbsSkinPanel;
  167.     ImgHistory: TImage;
  168.     ImgClose: TImage;
  169.     ImgSend: TImage;
  170.     ImgSendType: TImage;
  171.     procedure FormCreate(Sender: TObject);
  172.     procedure ImgSendMouseDown(Sender: TObject; Button: TMouseButton;
  173.       Shift: TShiftState; X, Y: Integer);
  174.     procedure ImgSendMouseUp(Sender: TObject; Button: TMouseButton;
  175.       Shift: TShiftState; X, Y: Integer);
  176.     procedure ImgCloseMouseDown(Sender: TObject; Button: TMouseButton;
  177.       Shift: TShiftState; X, Y: Integer);
  178.     procedure ImgCloseMouseUp(Sender: TObject; Button: TMouseButton;
  179.       Shift: TShiftState; X, Y: Integer);
  180.     procedure ImgHistoryMouseDown(Sender: TObject; Button: TMouseButton;
  181.       Shift: TShiftState; X, Y: Integer);
  182.     procedure ImgHistoryMouseUp(Sender: TObject; Button: TMouseButton;
  183.       Shift: TShiftState; X, Y: Integer);
  184.     procedure ImgArrowClick(Sender: TObject);
  185.     procedure ImgCloseClick(Sender: TObject);
  186.     procedure ImgFontMouseDown(Sender: TObject; Button: TMouseButton;
  187.       Shift: TShiftState; X, Y: Integer);
  188.     procedure ImgFontMouseUp(Sender: TObject; Button: TMouseButton;
  189.       Shift: TShiftState; X, Y: Integer);
  190.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  191.     procedure ImgTitleMouseDown(Sender: TObject; Button: TMouseButton;
  192.       Shift: TShiftState; X, Y: Integer);
  193.     procedure ImgClosedClick(Sender: TObject);
  194.     procedure ImgMaxClick(Sender: TObject);
  195.     procedure ImgMinClick(Sender: TObject);
  196.     procedure MsgInputChange(Sender: TObject);
  197.     procedure ImgSendClick(Sender: TObject);
  198.     procedure ImgHistoryClick(Sender: TObject);
  199.     procedure FormResize(Sender: TObject);
  200.     procedure ImgFontClick(Sender: TObject);
  201.     procedure FormShow(Sender: TObject);
  202.     procedure TVUserListCustomDrawItem(Sender: TCustomTreeView;
  203.       Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
  204.     procedure ImgAddNewClick(Sender: TObject);
  205.     procedure ImgSendFileClick(Sender: TObject);
  206.     procedure ImgAddNewMouseMove(Sender: TObject; Shift: TShiftState; X,
  207.       Y: Integer);
  208.     procedure TimerTopBarTimer(Sender: TObject);
  209.     procedure ImgAddNewMouseDown(Sender: TObject; Button: TMouseButton;
  210.       Shift: TShiftState; X, Y: Integer);
  211.     procedure ImgAddNewMouseUp(Sender: TObject; Button: TMouseButton;
  212.       Shift: TShiftState; X, Y: Integer);
  213.     procedure ImgVideoClick(Sender: TObject);
  214.     procedure ImgVoiceClick(Sender: TObject);
  215.     procedure ImgSelFaceClick(Sender: TObject);
  216.     procedure ImgFontMouseMove(Sender: TObject; Shift: TShiftState; X,
  217.       Y: Integer);
  218.     procedure TimerBottomBarTimer(Sender: TObject);
  219.     procedure ImgSelBackMouseDown(Sender: TObject; Button: TMouseButton;
  220.       Shift: TShiftState; X, Y: Integer);
  221.     procedure ImgSelBackMouseUp(Sender: TObject; Button: TMouseButton;
  222.       Shift: TShiftState; X, Y: Integer);
  223.     procedure ImgSelBackClick(Sender: TObject);
  224.     procedure PnlSpplitMouseMove(Sender: TObject; Shift: TShiftState; X,
  225.       Y: Integer);
  226.     procedure PnlSpplitMouseDown(Sender: TObject; Button: TMouseButton;
  227.       Shift: TShiftState; X, Y: Integer);
  228.     procedure PnlSpplitMouseUp(Sender: TObject; Button: TMouseButton;
  229.       Shift: TShiftState; X, Y: Integer);
  230.     procedure Copy1Click(Sender: TObject);
  231.     procedure SelectAll1Click(Sender: TObject);
  232.     procedure MsgContentBeforeNavigate2(Sender: TObject;
  233.       const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  234.       Headers: OleVariant; var Cancel: WordBool);
  235.     procedure WebPopupMenuPopup(Sender: TObject);
  236.     procedure FormActivate(Sender: TObject);
  237.     procedure FormDeactivate(Sender: TObject);
  238.     procedure MMMixerSliderInChange(Sender: TObject);
  239.     procedure ImgMicClick(Sender: TObject);
  240.     procedure ImgSpkClick(Sender: TObject);
  241.     procedure LblQuitAudioClick(Sender: TObject);
  242.     procedure TimerShowInputingTimer(Sender: TObject);
  243.     procedure MsgContentDocumentComplete(Sender: TObject;
  244.       const pDisp: IDispatch; var URL: OleVariant);
  245.     procedure ImgSelColorClick(Sender: TObject);
  246.     procedure ImgSendTypeMouseDown(Sender: TObject; Button: TMouseButton;
  247.       Shift: TShiftState; X, Y: Integer);
  248.     procedure ImgSendTypeMouseUp(Sender: TObject; Button: TMouseButton;
  249.       Shift: TShiftState; X, Y: Integer);
  250.     procedure ImgSendTypeClick(Sender: TObject);
  251.     procedure TMEnterClick(Sender: TObject);
  252.     procedure TMCtrlEnterClick(Sender: TObject);
  253.     procedure ImgGroupMsgClick(Sender: TObject);
  254.     procedure TVUserListGetImageIndex(Sender: TObject; Node: TTreeNode);
  255.     procedure ApplicationEvents1Message(var Msg: tagMSG;
  256.       var Handled: Boolean);
  257.     procedure X1Click(Sender: TObject);
  258.     procedure X2Click(Sender: TObject);
  259.     procedure MsgInputMouseDown(Sender: TObject; Button: TMouseButton;
  260.       Shift: TShiftState; X, Y: Integer);
  261.     procedure VideoCapVideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
  262.     procedure AviPanelOutDblClick(Sender: TObject);
  263.     procedure ACMWaveInData(data: Pointer; size: Integer);
  264.     procedure MDirectCopyScreenClick(Sender: TObject);
  265.     procedure ImgCopyScreenClick(Sender: TObject);
  266.     procedure MCopyScreenAfterMinWindowClick(Sender: TObject);
  267.     procedure CopyScreenTimerTimer(Sender: TObject);
  268.     procedure lblTitleClick(Sender: TObject);
  269.     procedure TVUserListClick(Sender: TObject);
  270.     procedure fcImageBtn3Click(Sender: TObject);
  271.     procedure fcImageBtn2Click(Sender: TObject);
  272.     procedure fcImageBtn4Click(Sender: TObject);
  273.     procedure fcImageBtn1Click(Sender: TObject);
  274.     procedure fcImageBtn5Click(Sender: TObject);
  275.     procedure Label1Click(Sender: TObject);
  276.     procedure Label2Click(Sender: TObject);
  277.     procedure Label3Click(Sender: TObject);
  278.     procedure Label4Click(Sender: TObject);
  279.     procedure Label5Click(Sender: TObject);
  280.   protected
  281.   private
  282.     ShowInputingTimes,LastInputing:Cardinal;
  283.     ImgIndex,LastImgIndex:Integer;
  284.     CanMove: Boolean;
  285.     OX,OY,OldTop:Integer;
  286.     procedure CopyScreen;
  287.   public
  288.     Pushed:Boolean;
  289.     Img:TImage;
  290.     Lbl:TLabel;
  291.     IsSystemMsg,
  292.     InGroupMsg,
  293.     AudioIsOn,
  294.     VideoIsOn:Boolean;
  295.     RoomInfo:ChatRoom;
  296.     procedure CreateParams(var Params:TCreateParams);override;
  297.     procedure ShowTitle(ShowList:Boolean=True);
  298.     procedure SetBrowserStyle();
  299.     procedure SetBrowserBg(Url:String);
  300.     procedure SetDOMStyle(Doc:IHTMLDocument2);
  301.     procedure ShowInputing(Show:Boolean);
  302.     procedure ShowOffline(Name:String);
  303.     procedure ShowInfo(Info:String);
  304.   end;
  306. implementation
  308. uses
  309.   SelUserFrm,SelFaceFrm, SelBackFrm,SelColorFrm,HistoryFrm,RealMessengerUnit,
  310.   RealMessengerImpl,CopyScreenFrm, VideoFrm;
  312. {$R *.DFM}
  314. {------------------------------------------------------------------------------}
  315. procedure TChatingForm.TimerShowInputingTimer(Sender: TObject);
  316. begin
  317.   if GetTickCount-ShowInputingTimes>TimerShowInputing.Interval then
  318.   begin
  319.     ShowInputing(False);
  320.     TimerShowInputing.Enabled:=False;
  321.   end;
  322. end;
  324. {------------------------------------------------------------------------------}
  325. procedure TChatingForm.ShowInfo(Info:String);
  326. begin
  327.     if Img=nil then
  328.     begin
  329.       Img:=TImage.Create(Self);
  330.       Img.Left:=4;
  331.       Img.Top:=4;
  332.       Img.AutoSize:=True;
  333.       Img.Transparent:=True;
  334.       PnlLeftTop.InsertControl(Img);
  335.       Img.Refresh;
  336.     end;
  337.     
  338.     ImgListInfo.GetBitmap(0,Img.Picture.Bitmap);
  339.     if Lbl=nil then
  340.     begin
  341.       Lbl:=TLabel.Create(Self);
  342.       Lbl.Left:=Img.Width + 8;
  343.       Lbl.Top:=6;
  344.       Lbl.Transparent:=True;
  345.       PnlLeftTop.InsertControl(Lbl);
  346.     end;
  347.     Lbl.Caption:=Info;
  348.     Lbl.Refresh;
  349. end;
  351. {------------------------------------------------------------------------------}
  352. procedure TChatingForm.ShowOffline(Name:String);
  353. begin
  354.     if Img=nil then
  355.     begin
  356.       Img:=TImage.Create(Self);
  357.       Img.Left:=4;
  358.       Img.Top:=4;
  359.       Img.AutoSize:=True;
  360.       Img.Transparent:=True;
  361.       PnlLeftTop.InsertControl(Img);
  362.     end;
  363.     
  364.     ImgListInfo.GetBitmap(0,Img.Picture.Bitmap);
  365.     if Lbl=nil then
  366.     begin
  367.       Lbl:=TLabel.Create(Self);
  368.       Lbl.Left:=Img.Width + 8;
  369.       Lbl.Top:=6;
  370.       Lbl.Transparent:=True;
  371.       PnlLeftTop.InsertControl(Lbl);
  372.     end;
  373.     Lbl.Caption:='因为没有联机，'+Name+' 可能无法收到您的消息！';
  374. end;
  376. {------------------------------------------------------------------------------}
  377. procedure TChatingForm.ShowInputing(Show:Boolean);
  378. begin
  379.   ShowInputingTimes:=GetTickCount;
  380.   if Show then
  381.   begin
  382.     if Not TimerShowInputing.Enabled then TimerShowInputing.Enabled:=True;
  383.     if Img=nil then
  384.     begin
  385.       Img:=TImage.Create(Self);
  386.       Img.Left:=4;
  387.       Img.Top:=4;
  388.       Img.AutoSize:=True;
  389.       Img.Transparent:=True;
  390.       PnlLeftTop.InsertControl(Img);
  391.     end;
  392.     ImgListInfo.GetBitmap(0,Img.Picture.Bitmap);
  394.     if Lbl=nil then
  395.     begin
  396.       Lbl:=TLabel.Create(Self);
  397.       Lbl.Left:=Img.Width + 8;
  398.       Lbl.Top:=6;
  399.       Lbl.Transparent:=True;
  400.       PnlLeftTop.InsertControl(Lbl);
  401.     end;
  402.     Lbl.Caption:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name+' 正在输入消息...';
  403.   end
  404.   else
  405.   begin
  406.     if Lbl<>nil then
  407.     begin
  408.       PnlLeftTop.RemoveControl(Lbl);
  409.       Lbl.Free;
  410.       Lbl:=nil;
  411.     end;
  412.     if Img<>nil then
  413.     begin
  414.       PnlLeftTop.RemoveControl(Img);
  415.       Img.Free;
  416.       Img:=nil;
  417.     end;
  418.   end;
  419. end;
  421. {------------------------------------------------------------------------------}
  422. {
  423. 功能：设置窗口样式（无标题栏，有边框）
  424. }
  425. procedure TChatingForm.CreateParams(var Params: TCreateParams);
  426. begin
  427.   inherited;
  428.    Params.Style :=WS_THICKFRAME OR WS_POPUP OR WS_BORDER OR WS_SYSMENU or WS_MINIMIZEBOX;
  429.    Params.wndParent := GetDesktopwindow; end;
  431. {------------------------------------------------------------------------------}
  432. procedure TChatingForm.ShowTitle(ShowList:Boolean=True);
  433. var
  434.   iLoop:Integer;
  435.   HaveOfflineUser:Integer;
  436.   Node:TTreeNode;
  437.   EmployeePointer,PEmployeeData:PEmployee;
  438. begin
  439.   if IsSystemMsg then Exit;
  441.   Caption:='';
  442.   if InGroupMsg then
  443.   begin
  444.     Caption:='群发消息';
  445. //    lblTitle.Caption:=Caption;
  446.     lblUserListTitle.Caption:='当前对话（'+IntToStr(TVUserList.Items.Count) + '）';
  447.     exit;
  448.   end;
  450.   if ShowList then
  451.   begin
  452.     for iLoop:=0 to TVUserList.Items.Count-1 do FreeMem(TVUserList.Items[iLoop].Data,SizeOf(Employee));
  453.     TVUserList.Items.Clear;
  454.     ImgHaveVideoDevice.Visible:=False;
  455.   end;
  456.   
  457.   lblUserListTitle.Caption:='当前对话（'+IntToStr(RoomInfo.UserCount - 1) + '）';
  458.   HaveOfflineUser:=0;
  459.   for iLoop:=1 to RoomInfo.UserCount do
  460.   begin
  461.     if RoomInfo.Users[iLoop] = Me.ID then continue;
  462.     if RoomInfo.Users[iLoop] = -1 then
  463.     begin
  464.       Caption:='系统消息';
  465. //      lblTitle.Caption:=Caption;
  466.       ImgArrowClick(ImgArrow);
  467.       ImgArrow.Visible:=False;
  468.       IsSystemMsg:=True;
  469.       PnlLeftBottom.Visible:=False;
  470.       ImgClose.Visible:=False;
  471.       ImgSend.Visible:=False;
  472.       Self.ImgSendType.Visible:=False;
  473.       ConvertBitmapToColor(ImgAddNew.Picture.Bitmap,$DEDEDE);
  474.       ConvertBitmapToColor(ImgSendFile.Picture.Bitmap,$DEDEDE);
  475.       ConvertBitmapToColor(ImgVoice.Picture.Bitmap,$DEDEDE);
  476.       ConvertBitmapToColor(ImgVideo.Picture.Bitmap,$DEDEDE);
  477.       ConvertBitmapToColor(ImgGroupMsg.Picture.Bitmap,$DEDEDE);
  478.       ImgAddNew.Enabled:=False;
  479.       ImgSendFile.Enabled:=False;
  480.       ImgVoice.Enabled:=False;
  481.       ImgVideo.Enabled:=False;
  482.       ImgGroupMsg.Enabled:=False;
  483.       PnlSpplit.Visible:=False;
  484.       PnlLeftTop.Height:=PnlLeftTop.Height+PnlLeftBottom.Height+PnlSpplit.Height;
  485.       Exit;
  486.     end;
  488.     PEmployeeData:=FindEmployeeByID(RoomInfo.Users[iLoop]);
  489.     if PEmployeeData=nil then continue;
  491.     Caption:=Caption+PEmployeeData.Name+' ';
  492.     if ShowList then
  493.     begin
  494.       ShowInputing(False);
  495.       GetMem(EmployeePointer,SizeOf(Employee));
  496.       CopyMemory(EmployeePointer,PEmployeeData,SizeOf(Employee));
  497.       Node:=TVUserList.Items.AddChildObject(nil,EmployeePointer.Name,EmployeePointer);
  498.       Node.StateIndex:=2;
  499.       EmployeePointer.Node:=Node;
  500.       RealMessengerX.UpdateListViewStates(TVUserList,Node);
  501.       if AnsiSameText(PEmployeeData.State,'断开') or (AnsiSameText(PEmployeeData.State,'显示为脱机')) then HaveOfflineUser:=HaveOfflineUser+1;
  502.       if (PEmployeeData.State<>'断开') and PEmployeeData.HaveVideoDevice and (RoomInfo.UserCount = 2) then ImgHaveVideoDevice.Visible:=True;
  503.     end;
  505.   end;
  507.   if HaveOfflineUser>0 then
  508.   begin
  509.     if RoomInfo.UserCount = 2 then
  510.       ShowOffline(PEmployee(TVUserList.Items.GetFirstNode.Data).Name)
  511.     else
  512.       if HaveOfflineUser = 1 then
  513.         ShowOffline('某个用户')
  514.       else
  515.         ShowOffline('某些用户');
  516.   end;
  518.   Caption:=Caption+'- 对话';
  520. end;
  522. {------------------------------------------------------------------------------}
  523. {
  524. 功能：对话窗口的OnCreate事件
  525. }
  526. procedure TChatingForm.FormCreate(Sender: TObject);
  527. var
  528.   TempReg:TRegistry;
  529. begin
  530.   try
  531.     ImgArrow.OnClick(ImgArrow);
  532.     DragAcceptFiles(MsgContent.handle,true);
  533.     DoubleBuffered:=True;
  534.     PnlLeftBottom.DoubleBuffered:=True;
  535.     PnlLeftTop.DoubleBuffered:=True;
  536.     PnlRightBottom.DoubleBuffered:=True;
  537.     PnlSpplit.DoubleBuffered:=True;
  538.     AviPanel.DoubleBuffered:=True;
  539.     AviPanelOut.DoubleBuffered:=True;
  540.     PnlYourCamera.DoubleBuffered:=True;
  541.     MsgContent.DoubleBuffered:=False;
  542.     MsgInput.DoubleBuffered:=False;
  544.     MsgContent.Navigate('about:blank');
  546.     TVUserList.Images:=ImgListMain;
  548.     TempReg:=TRegistry.Create;
  549.     try
  550.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  551.       if TempReg.OpenKey(AppKey+''+LoginName+'ChatingFormStore', True) then
  552.       begin
  553.         if trim(TempReg.ReadString('Width')) <>''    then Width:=StrToInt(TempReg.ReadString('Width'));
  554.         if trim(TempReg.ReadString('Height'))<>''    then Height:=StrToInt(TempReg.ReadString('Height'));
  555.         if ChatingFormList.Count <= 0 then
  556.         begin
  557.           Left:=(Screen.WorkAreaWidth-Width) div 2;
  558.           Top:=(Screen.WorkAreaHeight-Height) div 2;
  559.         end
  560.         else
  561.         begin
  562.           Left:=TForm(ChatingFormList.Items[ChatingFormList.Count - 1]).Left + 20;
  563.           Top:=TForm(ChatingFormList.Items[ChatingFormList.Count - 1]).Top + 20;
  564.           if (Left > Screen.WorkAreaWidth - Width) or (Top > Screen.WorkAreaHeight - Height) then
  565.           begin
  566.             Left:=0;
  567.             Top:=0;
  568.           end;
  569.         end;
  570.         if trim(TempReg.ReadString('SpplitTop'))<>'' then
  571.         begin
  572.           Self.PnlSpplitMouseDown(nil,mbLeft,[],0,0);
  573.           PnlSpplit.Top:=StrToInt(TempReg.ReadString('SpplitTop'));
  574.           Self.PnlSpplitMouseMove(nil,[],0,OY+1);
  575.           Self.PnlSpplitMouseMove(nil,[],0,OY-1);
  576.           Self.PnlSpplitMouseUp(nil,mbLeft,[],0,0);
  577.         end;
  579.         if trim(TempReg.ReadString('SendType'))='Enter' then
  580.         begin
  581.           TMEnter.Checked:=True;
  582.           TMEnter.Enabled:=False;
  583.         end
  584.         else
  585.         begin
  586.           TMCtrlEnter.Checked:=True;
  587.           TMCtrlEnter.Enabled:=False;
  588.         end;
  590.       end;
  592.       if TempReg.OpenKey(AppKey+''+LoginName+'Font', True) then
  593.       begin
  594.         if trim(TempReg.ReadString('Name'))='' then
  595.             TempReg.WriteString('Name','宋体');
  596.         if trim(TempReg.ReadString('Color'))='' then
  597.             TempReg.WriteString('Color','0');
  598.         if trim(TempReg.ReadString('Size'))='' then
  599.             TempReg.WriteString('Size','9');
  600.         if trim(TempReg.ReadString('fsBold'))='' then
  601.             TempReg.WriteString('fsBold','0');
  602.         if trim(TempReg.ReadString('fsItalic'))='' then
  603.             TempReg.WriteString('fsItalic','0');
  604.         if trim(TempReg.ReadString('fsUnderline'))='' then
  605.             TempReg.WriteString('fsUnderline','0');
  606.         if trim(TempReg.ReadString('fsStrikeOut'))='' then
  607.             TempReg.WriteString('fsStrikeOut','0');
  608.         
  609.         MsgInput.Font.Name  :=TempReg.ReadString('Name');
  610.         MsgInput.Font.Color :=StrToInt(TempReg.ReadString('Color'));
  611.         MsgInput.Font.Size  :=StrToInt(TempReg.ReadString('Size'));
  612.         if trim(TempReg.ReadString('fsBold'))='1' then MsgInput.Font.Style := MsgInput.Font.Style+[fsBold];
  613.         if trim(TempReg.ReadString('fsItalic'))='1' then MsgInput.Font.Style := MsgInput.Font.Style+[fsItalic];
  614.         if trim(TempReg.ReadString('fsUnderline'))='1' then MsgInput.Font.Style := MsgInput.Font.Style+[fsUnderline];
  615.         if trim(TempReg.ReadString('fsStrikeOut'))='1' then MsgInput.Font.Style := MsgInput.Font.Style+[fsStrikeOut];
  617.      end;
  618.     finally
  619.       TempReg.Free;
  620.     end;
  621.   except
  622.   end;
  623. end;
  625. {------------------------------------------------------------------------------}
  626. procedure TChatingForm.ImgSendMouseDown(Sender: TObject;
  627.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  628. begin
  629.   ImgListSend.GetBitmap(1,ImgSend.Picture.Bitmap);
  630.   ConvertBitmapToColor(ImgSend.Picture.Bitmap,EndColor);
  631.   ImgSend.Refresh;
  632. end;
  634. {------------------------------------------------------------------------------}
  635. procedure TChatingForm.ImgSendMouseUp(Sender: TObject;
  636.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  637. begin
  638.   ImgListSend.GetBitmap(0,ImgSend.Picture.Bitmap);
  639.   ConvertBitmapToColor(ImgSend.Picture.Bitmap,EndColor);
  640.   ImgSend.Refresh;
  641. end;
  643. {------------------------------------------------------------------------------}
  644. procedure TChatingForm.ImgCloseMouseDown(Sender: TObject;
  645.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  646. begin
  647.   ImgListClose.GetBitmap(1,ImgClose.Picture.Bitmap);
  648.   ConvertBitmapToColor(ImgClose.Picture.Bitmap,EndColor);
  649.   ImgClose.Refresh;
  650. end;
  652. {------------------------------------------------------------------------------}
  653. procedure TChatingForm.ImgCloseMouseUp(Sender: TObject;
  654.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  655. begin
  656.   ImgListClose.GetBitmap(0,ImgClose.Picture.Bitmap);
  657.   ConvertBitmapToColor(ImgClose.Picture.Bitmap,EndColor);
  658.   ImgClose.Refresh;
  659. end;
  661. {------------------------------------------------------------------------------}
  662. procedure TChatingForm.ImgHistoryMouseUp(Sender: TObject;
  663.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  664. begin
  665.   ImgListHistory.GetBitmap(0,ImgHistory.Picture.Bitmap);
  666.   ConvertBitmapToColor(ImgHistory.Picture.Bitmap,EndColor);
  667.   ImgHistory.Refresh;
  668. end;
  670. {------------------------------------------------------------------------------}
  671. procedure TChatingForm.ImgHistoryMouseDown(Sender: TObject;
  672.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  673. begin
  674.   ImgListHistory.GetBitmap(1,ImgHistory.Picture.Bitmap);
  675.   ConvertBitmapToColor(ImgHistory.Picture.Bitmap,EndColor);
  676.   ImgHistory.Refresh;
  677. end;
  679. {------------------------------------------------------------------------------}
  680. procedure TChatingForm.ImgArrowClick(Sender: TObject);
  681. begin
  682.   PnlRightBottom.Visible := not PnlRightBottom.Visible;
  683.   (Sender As TImage).Picture.Bitmap.Canvas.Pen.Style:=psClear;
  684.   (Sender As TImage).Picture.Bitmap.Canvas.Rectangle(0,0,20,20);
  685.   if (PnlRightBottom.Visible = False) and (Width-PnlLeftBottom.Width>PnlRightBottom.Width)  then
  686.   begin
  687.     PnlLeftBottom.Width    :=PnlLeftBottom.Width + PnlRightBottom.Width + 2;
  688.     ImgSendType.Left       :=ImgSendType.Left + PnlRightBottom.Width + 2;
  689.     ImgSend.Left           :=ImgSend.Left + PnlRightBottom.Width + 2;
  690.     ImgClose.Left          :=ImgClose.Left + PnlRightBottom.Width + 2;
  691.     ImgListArrow.GetBitmap(1,(Sender As TImage).Picture.Bitmap);
  692.     ConvertBitmapToColor((Sender As TImage).Picture.Bitmap,EndColor);
  693.     (Sender As TImage).Refresh;
  694.   end
  695.   else if (Width-PnlLeftBottom.Width<PnlRightBottom.Width) then
  696.   begin
  697.     PnlLeftBottom.Width    :=PnlLeftBottom.Width - PnlRightBottom.Width - 2;
  698.     ImgSendType.Left       :=ImgSendType.Left - PnlRightBottom.Width - 2;
  699.     ImgSend.Left           :=ImgSend.Left - PnlRightBottom.Width - 2;
  700.     ImgClose.Left          :=ImgClose.Left - PnlRightBottom.Width - 2;
  701.     ImgListArrow.GetBitmap(0,(Sender As TImage).Picture.Bitmap);
  702.     ConvertBitmapToColor((Sender As TImage).Picture.Bitmap,EndColor);
  703.     (Sender As TImage).Refresh;
  704.   end;
  705. end;
  707. {------------------------------------------------------------------------------}
  708. procedure TChatingForm.ImgCloseClick(Sender: TObject);
  709. begin
  710.   Close;
  711. end;
  713. {------------------------------------------------------------------------------}
  714. procedure TChatingForm.ImgFontMouseDown(Sender: TObject;
  715.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  716. begin
  717.   (Sender as TImage).Left:=(Sender as TImage).Left+1;
  718.   (Sender as TImage).Top:=(Sender as TImage).Top+1;
  719. end;
  721. {------------------------------------------------------------------------------}
  722. procedure TChatingForm.ImgFontMouseUp(Sender: TObject;
  723.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  724. begin
  725.   (Sender as TImage).Left:=(Sender as TImage).Left-1;
  726.   (Sender as TImage).Top:=(Sender as TImage).Top-1;
  727. end;
  729. {------------------------------------------------------------------------------}
  730. {
  731. 功能：对话窗口的OnClose事件
  732. }
  733. procedure TChatingForm.FormClose(Sender: TObject; var Action: TCloseAction);
  734. var
  735.   iLoop,MissionCount:Integer;
  736.   TransmitFile:TTransmitFile;
  737.   AudioHandShake:TAudioHandShake;
  738.   VideoHandShake:TVideoHandShake;
  739. begin
  740.   try
  741.     MissionCount:=0;
  742.     with TransmitFiles.LockList do
  743.     try
  744.       for iLoop:=0 to Count - 1 do
  745.       begin
  746.         TransmitFile:=Items[iLoop];
  747.         if TransmitFile.ChatingForm = Self then MissionCount:=MissionCount+1;
  748.       end;
  749.     finally
  750.       TransmitFiles.UnlockList;
  751.     end;
  753.     with AudioHandShakes.LockList do
  754.     try
  755.       for iLoop:=0 to Count - 1 do
  756.       begin
  757.         AudioHandShake:=Items[iLoop];
  758.         if AudioHandShake.ChatingForm = Self then MissionCount:=MissionCount+1;
  759.       end;
  760.     finally
  761.       AudioHandShakes.UnlockList;
  762.     end;
  764.     with VideoHandShakes.LockList do
  765.     try
  766.       for iLoop:=0 to Count - 1 do
  767.       begin
  768.         VideoHandShake:=Items[iLoop];
  769.         if VideoHandShake.ChatingForm = Self then MissionCount:=MissionCount+1;
  770.       end;
  771.     finally
  772.       VideoHandShakes.UnlockList;
  773.     end;
  775.     if MissionCount>0 then
  776.     begin
  777.       if MessageBox(Handle,PChar('有 '+IntToStr(MissionCount)+' 个任务在本窗口还未结束，确定要关闭吗！'),'提示',MB_ICONQUESTION or MB_OKCANCEL) <> ID_OK then
  778.       begin
  779.         Action:=caNone;
  780.         exit;
  781.       end
  782.       else
  783.       begin
  784.         with TransmitFiles.LockList do
  785.         try
  786.           for iLoop:=Count - 1 downto 0  do
  787.           begin
  788.             TransmitFile:=Items[iLoop];
  789.             if TransmitFile.ChatingForm = Self then TransmitFile.Close;
  790.           end;
  791.         finally
  792.           TransmitFiles.UnlockList;
  793.         end;
  795.         with AudioHandShakes.LockList do
  796.         try
  797.           for iLoop:=Count - 1 downto 0  do
  798.           begin
  799.             AudioHandShake:=Items[iLoop];
  800.             if AudioHandShake.ChatingForm = Self then AudioHandShake.Close;
  801.           end;
  802.         finally
  803.           AudioHandShakes.UnlockList;
  804.         end;
  806.         with VideoHandShakes.LockList do
  807.         try
  808.           for iLoop:=Count - 1 downto 0  do
  809.           begin
  810.             VideoHandShake:=Items[iLoop];
  811.             if VideoHandShake.ChatingForm = Self then VideoHandShake.Close;
  812.           end;
  813.         finally
  814.           VideoHandShakes.UnlockList;
  815.         end;
  816.       end;
  817.     end;
  818.     ChatingFormList.Remove(Self);
  819.     Action:=caFree;
  820.   except
  821.   end;
  822. end;
  824. {------------------------------------------------------------------------------}
  825. procedure TChatingForm.ImgTitleMouseDown(Sender: TObject; Button: TMouseButton;
  826.       Shift: TShiftState; X, Y: Integer);
  827. begin
  828.   if (Button = mbLeft) then
  829.   begin
  830.     ReleaseCapture;
  831.     self.Perform(WM_SYSCOMMAND, $F012, 0);
  832.     FormResize(nil);
  833.   end;
  834. end;
  836. {------------------------------------------------------------------------------}
  837. {
  838. 功能：关闭窗口
  839. }
  840. procedure TChatingForm.ImgClosedClick(Sender: TObject);
  841. begin
  842. //  Close;
  843. end;
  845. {------------------------------------------------------------------------------}
  846. {
  847. 功能：最大化
  848. }
  849. procedure TChatingForm.ImgMaxClick(Sender: TObject);
  850. begin
  851. {  if WindowState = wsNormal then
  852.   begin
  853.     ImgListMax.GetBitmap(1,ImgMax.Picture.Bitmap);
  854.     WindowState := wsMaximized;
  855.     Left:=0;
  856.     Top:=0;
  857.     Width:=Screen.WorkAreaWidth;
  858.     Height:=Screen.WorkAreaHeight;
  859.   end
  860.   else
  861.   begin
  862.     ImgListMax.GetBitmap(0,ImgMax.Picture.Bitmap);
  863.     WindowState := wsNormal;
  864.   end;
  866.   ConvertBitmapToColor(ImgMax.Picture.Bitmap,EndColor);
  867.   ImgMax.Refresh; }
  868. end;
  870. {------------------------------------------------------------------------------}
  871. {
  872. 功能：最小化
  873. }
  874. procedure TChatingForm.ImgMinClick(Sender: TObject);
  875. begin
  876. //  WindowState := wsMinimized;
  877. end;
  879. {------------------------------------------------------------------------------}
  880. procedure TChatingForm.MsgInputChange(Sender: TObject);
  881. var
  882.   I,L,S:Integer;
  883.   Buffer        :array[1..2048]of char;
  884.   CBInputing    :TCBInputing;
  885.   EmployeeData  :PEmployee;
  886. begin
  887.   L:=Length(TRxRichEdit(Sender).Text);
  888.   for I:=1 to Length(Faces) do
  889.   begin
  890.     S:=TRxRichEdit(Sender).FindText(FacesChar[I],0,L,[]);
  891.     While S>=0 do
  892.     begin
  893.       TRxRichEdit(Sender).SelStart:=S;
  894.       TRxRichEdit(Sender).SelLength:=Length(FacesChar[I]);
  895.       TRxRichEdit(Sender).SelText:=Faces[I];
  896.       TRxRichEdit(Sender).SelStart:=TRxRichEdit(Sender).SelStart+1;
  897.       TRxRichEdit(Sender).SelLength:=0;
  898.       S:=TRxRichEdit(Sender).FindText(FacesChar[I],TRxRichEdit(Sender).SelStart,L,[]);
  899.     end;
  900.   end;
  901.   if (not InGroupMsg) and ((L=0) or ((GetTickCount-LastInputing>5000) and (TVUserList.Items.Count = 1) and (not AudioIsOn) and (not VideoIsOn) and (PEmployee(TVUserList.Items.GetFirstNode.Data).State<>'断开') and (PEmployee(TVUserList.Items.GetFirstNode.Data).State<>'显示为脱机'))) then
  902.   begin
  903.     LastInputing:=GetTickCount;
  904.     CBInputing.Sender:=Me.ID;
  905.     CBInputing.Receiver:=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  906.     CBInputing.Inputing:=(L>0);
  907.     CBInputing.Room:=RoomInfo;
  908.     Buffer[1]:=skInputing;
  909.     CopyMemory(@Buffer[2],@CBInputing,SizeOf(CBInputing));
  911.     EmployeeData:=FindEmployeeByID(CBInputing.Receiver);
  912.     if EmployeeData=nil then exit;
  913.     if EmployeeData.MySocket=nil then  EmployeeData.MySocket:=TMySocket.Create(EmployeeData.ID,RealMessengerX.ClientTCP,True);
  914.     EmployeeData.MySocket.SendBuffer(Buffer,SizeOf(CBInputing)+1);  {正在输入消息}
  915.   end;
  916. end;
  918. {------------------------------------------------------------------------------}
  919. procedure TChatingForm.ImgSendClick(Sender: TObject);
  920. var
  921.   StreamContent :array[1..99999] of Char;
  922.   Buffer        :array[1..2048]of char;
  923.   Stream        :TMemoryStream;
  924.   Content       :String;
  925.   CB            :TCBMessage;
  926.   PCB           :PCBMessage;
  927.   i             :Integer;
  928.   EmployeeData  :PEmployee;
  929. begin
  931.   CB.Sender        :=Me.ID;
  932.   CB.SendDateTime  :=Now;
  933.   CB.Room:=RoomInfo;
  935.   Stream:=TMemoryStream.Create;
  936.   MsgInput.Lines.SaveToStream(Stream);
  937.   Stream.Position:=0;
  938.   
  939.   if stream.Size > SizeOf(StreamContent) then
  940.   begin
  941.     messagebox(handle,'图标数量过多！','提示',MB_OK OR MB_ICONINFORMATION);
  942.     exit;
  943.   end;
  945.   stream.Read(StreamContent,stream.Size);
  946.   Content:=Copy(StreamContent,1,stream.Size);
  948.   for i:=1 to Length(Faces) do
  949.       Content:=AnsiReplaceStr(Content,FaceCodes[i],FacesChar[i]);
  951.   for i:=1 to Length(Content) do  StreamContent[i]:=Content[i];
  952.   
  953.   stream.Clear;
  954.   stream.Write(StreamContent,Length(Content));
  955.   stream.Position:=0;
  956.   TempRxRichEdit.Clear;
  957.   TempRxRichEdit.Lines.LoadFromStream(stream);
  959.   if Length(Trim(TempRxRichEdit.Text)) <= 0 then
  960.   begin
  961.     messagebox(handle,'消息内容不能为空！','提示',MB_OK OR MB_ICONINFORMATION);
  962.     exit;
  963.   end;
  965.   Content:=EncryStr(Copy(TempRxRichEdit.Text,1,SizeOf(CB.Content)-10),DESKEY);
  966.   for i:=1 to Length(Content) do
  967.   begin
  968.     if i<SizeOf(CB.Content) then
  969.       CB.Content[i]:=Content[i]
  970.     else
  971.       break;
  972.   end;
  974.   CB.Length :=Length(Content);
  976.   CB.Name   :=MsgInput.Font.Name;
  977.   CB.Color  :=MsgInput.Font.Color;
  978.   CB.Size   :=MsgInput.Font.Size;
  979.   if fsBold in MsgInput.Font.Style then
  980.     CB.fsBold:=True
  981.   else
  982.     CB.fsBold:=False;
  984.   if fsItalic in MsgInput.Font.Style then
  985.     CB.fsItalic:=True
  986.   else
  987.     CB.fsItalic:=False;
  988.     
  989.   if fsUnderline in MsgInput.Font.Style then
  990.     CB.fsUnderline:=True
  991.   else
  992.     CB.fsUnderline:=False;
  994.   if fsStrikeOut in MsgInput.Font.Style then
  995.     CB.fsStrikeOut:=True
  996.   else
  997.     CB.fsStrikeOut:=False;
  999.   MsgInput.Clear;
  1000.   Stream.Free;
  1001.   ShowMsg(Self,Self.MsgContent,Me.Name,CB,false);
  1003.   if InGroupMsg then //群发消息
  1004.   begin
  1005.     try
  1006.       for i:=0 to TVUserList.Items.Count - 1 do
  1007.       begin
  1008.         CB.Room.UserCount:=2;
  1009.         CB.Room.Users[1]:=Me.ID;
  1010.         CB.Room.Users[2]:=TVUserList.Items[i].StateIndex;
  1011.         CB.Receiver:=TVUserList.Items[i].StateIndex;
  1012.         CB.SendTicket:=GetTickCount;
  1013.         Buffer[1]:=skMessage;
  1014.         CopyMemory(@Buffer[2],@CB,SizeOf(CB));
  1016.         EmployeeData:=FindEmployeeByID(CB.Receiver);
  1017.         if EmployeeData=nil then continue;        
  1018.         if EmployeeData.MySocket=nil then  EmployeeData.MySocket:=TMySocket.Create(EmployeeData.ID,RealMessengerX.ClientTCP,True);
  1020.         EmployeeData.MySocket.SendBuffer(Buffer,SizeOf(CB)+1);  {发送消息}
  1021.         if TVUserList.Items.Count>1 then
  1022.         begin
  1023.           Sleep(10);
  1024.           Application.ProcessMessages;
  1025.         end;
  1027.         GetMem(PCB,SizeOf(TCBMessage));
  1028.         CopyMemory(PCB,@CB,SizeOf(TCBMessage));
  1029.         MsgReturnCheck.Add(PCB);
  1030.         if not RealMessengerX.MsgTimer.Enabled then RealMessengerX.MsgTimer.Enabled:=True;
  1032.         SaveHistory(CB);
  1033.       end;
  1034.     finally
  1035.     end;
  1036.   end
  1037.   else
  1038.   begin
  1039.     try
  1040.       for i:=1 to CB.Room.UserCount do
  1041.       begin
  1042.         if CB.Room.Users[i]=Me.ID then continue;
  1043.         CB.Receiver:=CB.Room.Users[i];
  1044.         CB.SendTicket:=GetTickCount;
  1045.         Buffer[1]:=skMessage;
  1046.         CopyMemory(@Buffer[2],@CB,SizeOf(CB));
  1047.         
  1048.         EmployeeData:=FindEmployeeByID(CB.Receiver);
  1049.         if EmployeeData=nil then continue;        
  1050.         if EmployeeData.MySocket=nil then  EmployeeData.MySocket:=TMySocket.Create(EmployeeData.ID,RealMessengerX.ClientTCP,True);
  1052.         EmployeeData.MySocket.SendBuffer(Buffer,SizeOf(CB)+1);  {发送消息}
  1053.         if CB.Room.UserCount>2 then
  1054.         begin
  1055.           Sleep(10);
  1056.           Application.ProcessMessages;
  1057.         end;
  1059.         GetMem(PCB,SizeOf(TCBMessage));
  1060.         CopyMemory(PCB,@CB,SizeOf(TCBMessage));
  1061.         MsgReturnCheck.Add(PCB);
  1062.         if not RealMessengerX.MsgTimer.Enabled then RealMessengerX.MsgTimer.Enabled:=True;
  1064.         SaveHistory(CB);
  1065.       end;
  1066.     finally
  1067.     end;
  1068.   end;
  1069.   MsgInput.SetFocus();
  1070. end;
  1072. {------------------------------------------------------------------------------}
  1073. procedure TChatingForm.ImgHistoryClick(Sender: TObject);
  1074. begin
  1075.   if TVUserList.Items.Count > 1 then exit;
  1077.   if HistoryForm<>nil then HistoryForm.Close;
  1078.   HistoryForm:=THistoryForm.Create(Application);
  1079.   if IsSystemMsg then
  1080.   begin
  1081.     HistoryForm.ID:=-1;
  1082.     HistoryForm.Name:='系统消息';
  1083.   end
  1084.   else
  1085.   begin
  1086.     HistoryForm.ID:=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  1087.     HistoryForm.Name:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  1088.   end;
  1089.   HistoryForm.Show;
  1090. end;
  1092. {------------------------------------------------------------------------------}
  1093. procedure TChatingForm.FormResize(Sender: TObject);
  1094. var
  1095.   TempReg:TRegistry;
  1096.   OT,OH:Integer;
  1097. begin
  1098.     ShowTitle(False);
  1099.     
  1100.     if PnlLeftTop.Height<145 then
  1101.     begin
  1102.       PnlLeftTop.Height:=145;
  1103.       OT:=PnlSpplit.Top;
  1104.       PnlSpplit.Top:=PnlLeftTop.Top+PnlLeftTop.Height;
  1105.       PnlLeftBottom.Top:=PnlLeftBottom.Top+(PnlSpplit.Top-OT);
  1106.       PnlRightBottom.Top:=PnlLeftBottom.Top;
  1107.       PnlMyCamera.Top:=PnlLeftBottom.Top;
  1108.       PnlLeftBottom.Height:=PnlLeftBottom.Height+(OT-PnlSpplit.Top);
  1109.       PnlRightBottom.Height:=PnlRightBottom.Height+(OT-PnlSpplit.Top);
  1110.     end;
  1111.     
  1112.     if PnlLeftBottom.Height<90 then
  1113.     begin
  1114.       OH:=PnlLeftBottom.Height;
  1115.       PnlLeftBottom.Height:=90;
  1116.       PnlRightBottom.Height:=115;
  1117.       PnlLeftTop.Height:=PnlLeftTop.Height-(PnlLeftBottom.Height-OH);
  1118.       OT:=PnlSpplit.Top;
  1119.       PnlSpplit.Top:=PnlLeftTop.Top+PnlLeftTop.Height;
  1120.       PnlLeftBottom.Top:=PnlLeftBottom.Top+(PnlSpplit.Top-OT);
  1121.       PnlRightBottom.Top:=PnlLeftBottom.Top;
  1122.       PnlMyCamera.Top:=PnlLeftBottom.Top;
  1123.     end;
  1125.     if WindowState = wsMaximized then exit;
  1126.     TempReg:=TRegistry.Create;
  1127.     try
  1128.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  1129.       if TempReg.OpenKey(AppKey+''+LoginName+'ChatingFormStore', True) then
  1130.       begin
  1131.         TempReg.WriteString('Left',IntToStr(Left));
  1132.         TempReg.WriteString('Top',IntToStr(Top));
  1133.         TempReg.WriteString('Width',IntToStr(Width));
  1134.         TempReg.WriteString('Height',IntToStr(Height));
  1135.         TempReg.WriteString('SpplitTop',IntToStr(PnlSpplit.Top));
  1136.       end;
  1137.     finally
  1138.       TempReg.Free;
  1139.     end;
  1140. end;
  1143. {------------------------------------------------------------------------------}
  1144. procedure TChatingForm.ImgFontClick(Sender: TObject);
  1145. var
  1146.   TempReg:TRegistry;
  1147. begin
  1148.   FontDialog1.Font:=MsgInput.Font;
  1149.   if FontDialog1.Execute then
  1150.   begin
  1151.     MsgInput.Font:=FontDialog1.Font;
  1152.     TempReg:=TRegistry.Create;
  1153.     try
  1154.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  1155.       if TempReg.OpenKey(AppKey+''+LoginName+'Font', True) then
  1156.       begin
  1157.         TempReg.WriteString('Name',FontDialog1.Font.Name);
  1158.         TempReg.WriteString('Color',IntToStr(FontDialog1.Font.Color));
  1159.         TempReg.WriteString('Size',IntToStr(FontDialog1.Font.Size));
  1160.         
  1161.         if fsBold in FontDialog1.Font.Style then
  1162.           TempReg.WriteString('fsBold','1')
  1163.         else
  1164.           TempReg.WriteString('fsBold','0');
  1166.         if fsItalic in FontDialog1.Font.Style then
  1167.           TempReg.WriteString('fsItalic','1')
  1168.         else
  1169.           TempReg.WriteString('fsItalic','0');
  1171.         if fsUnderline in FontDialog1.Font.Style then
  1172.           TempReg.WriteString('fsUnderline','1')
  1173.         else
  1174.           TempReg.WriteString('fsUnderline','0');
  1176.         if fsStrikeOut in FontDialog1.Font.Style then
  1177.           TempReg.WriteString('fsStrikeOut','1')
  1178.         else
  1179.           TempReg.WriteString('fsStrikeOut','0')
  1181.       end;
  1182.     finally
  1183.       TempReg.Free;
  1184.     end;
  1185.   end;
  1186. end;
  1189. {------------------------------------------------------------------------------}
  1190. procedure TChatingForm.FormShow(Sender: TObject);
  1191. var
  1192.   iLoop:Integer;
  1193.   Stream:TMemoryStream;
  1194.   BitMap:TBitMap;
  1195.   StreamContent:array[1..9999] of Char;
  1196.   Content,T:string;
  1197.   i,J:Integer;
  1198.   DRect,SRect:TRect;
  1199.   ImgFace:TImage;
  1200. begin
  1201.   ShowTitle;
  1202.   OnResize:=FormResize;
  1203.   if FaceHasGeted then exit;
  1204.   
  1205.   ImgFace:=TImage.Create(nil);
  1206.   BitMap:=TBitMap.Create;
  1207.   try
  1208.     ImgFace.Picture.Bitmap.LoadFromFile(PicPath+'Faces.bmp');
  1210.     DRect.Left:=0;
  1211.     DRect.Top:=0;
  1212.     DRect.Right:=19;
  1213.     DRect.Bottom:=19;
  1215.     BitMap.Width:=20;
  1216.     BitMap.Height:=20;
  1217.     BitMap.Canvas.FillRect(DRect);
  1218.     for iLoop:=1 to Length(Faces) do
  1219.     begin
  1220.       SRect.Left:=((iLoop-1) mod 10)*30+6;
  1221.       SRect.Top:=((iLoop-1) div 10)*30+6;
  1222.       SRect.Right:=((iLoop-1) mod 10)*30+25;
  1223.       SRect.Bottom:=((iLoop-1) div 10)*30+25;
  1225.       BitMap.Canvas.CopyRect(DRect,ImgFace.Canvas,SRect);
  1226.       if Length(Faces[iLoop])<=0 then
  1227.       begin
  1228.           Faces[iLoop]:=ConvertBitmapToRTF(BitMap);
  1229.           TempRxRichEdit.Lines.Add('BmpStartBmpEnd');
  1230.           TempRxRichEdit.SelStart:=8;
  1231.           TempRxRichEdit.SelLength:=0;
  1232.           TempRxRichEdit.SelText:=Faces[iLoop];
  1233.           Stream:=TMemoryStream.Create;
  1234.           TempRxRichEdit.Lines.SaveToStream(Stream);
  1235.           Stream.Position:=0;
  1236.           stream.Read(StreamContent,stream.Size);
  1237.           Content:=Copy(StreamContent,1,stream.Size);
  1238.           J:=Pos('BmpStart', Content);
  1239.           T:=Copy(Content, J+8, Length(Content));
  1240.           I:=Pos('BmpEnd',T);
  1241.           FaceCodes[iLoop]:=Copy(Content,J+8,I-1);
  1242.           TempRxRichEdit.Clear;
  1243.       end;
  1244.       if iLoop mod 5=0 then Application.ProcessMessages;
  1245.     end;
  1246.   finally
  1247.     BitMap.Free;
  1248.     ImgFace.Free;
  1249.     FaceHasGeted:=True;
  1250.   end;
  1251. end;
  1253. {------------------------------------------------------------------------------}
  1254. procedure TChatingForm.TVUserListCustomDrawItem(Sender: TCustomTreeView;
  1255.   Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
  1256. begin
  1257.   DefaultDraw:=true;
  1258.   if Node.Selected then
  1259.   begin
  1260.     TVUserList.Canvas.Font.Color:=clWhite;
  1261.   end
  1262.   else
  1263.   begin
  1264.     if (Node.StateIndex = 2) and (not InGroupMsg) then
  1265.     begin
  1266.       if (Node.ImageIndex = 6) or (Node.ImageIndex = 10) then
  1267.         TVUserList.Canvas.Font.Color:=clRed
  1268.       else
  1269.         TVUserList.Canvas.Font.Color:=clGreen;
  1270.     end
  1271.     else if Node.StateIndex = -1 then
  1272.     begin
  1273.       TVUserList.Canvas.Font.Color:=$00934A46;
  1274.       TVUserList.Canvas.Font.Style:=[fsBold];
  1275.     end
  1276.     else
  1277.       TVUserList.Canvas.Font.Color:=clBlack;
  1278.   end;
  1280.   TVUserList.Canvas.Textout(Node.DisplayRect(True).Left+2,Node.DisplayRect(True).Top+2,Node.Text);
  1281. end;
  1283. {------------------------------------------------------------------------------}
  1284. procedure TChatingForm.ImgAddNewClick(Sender: TObject);
  1285. var
  1286.   ID:Integer;
  1287.   iLoop,jLoop:Integer;
  1288.   Finded:Boolean;
  1289.   CBAddUser:TCBAddUser;
  1290.   AddRoom:ChatRoom;
  1291.   Buffer:Array[1..2048]of char;
  1292. begin
  1293.   if InGroupMsg=True then
  1294.   begin
  1295.       MessageBox(Handle,'群发消息状态下不能进入多人模式！','提示',MB_ICONINFORMATION);
  1296.       exit;
  1297.   end;
  1299.   if AudioIsOn then
  1300.   begin
  1301.       MessageBox(Handle,'当前窗口已打开音频对话任务，不能进入多人模式！','提示',MB_ICONINFORMATION);
  1302.       exit;
  1303.   end;
  1305.   if VideoIsOn then
  1306.   begin
  1307.       MessageBox(Handle,'当前窗口已打开视频对话任务，不能进入多人模式！','提示',MB_ICONINFORMATION);
  1308.       exit;
  1309.   end;
  1311.   SelUserForm:=TSelUserForm.Create(Self);
  1312.   try
  1313.     if SelUserForm.ShowModal = mrOk then
  1314.     begin
  1315.       CBAddUser.Room.UserCount:=RoomInfo.UserCount;
  1316.       for iLoop:=1 to RoomInfo.UserCount do CBAddUser.Room.Users[iLoop]:=RoomInfo.Users[iLoop];
  1318.       AddRoom.UserCount:=0;
  1319.       for iLoop := 0 to SelUserForm.TrevUserList.Items.Count - 1 do
  1320.       begin
  1321.         if (SelUserForm.TrevUserList.Items[iLoop].ImageIndex<6) or (SelUserForm.TrevUserList.Items[iLoop].ImageIndex>13)  then continue;
  1322.         if IsNodeChecked(SelUserForm.TrevUserList.Items[iLoop])=False then continue;
  1323.         ID:=PEmployee(SelUserForm.TrevUserList.Items[iLoop].Data).ID;
  1324.         Finded:=False;
  1325.         for jLoop:=1 to RoomInfo.UserCount do
  1326.         begin
  1327.           if RoomInfo.Users[jLoop] = ID then
  1328.           begin
  1329.             Finded:=True;
  1330.             break;
  1331.           end;
  1332.         end;
  1333.         if not Finded then
  1334.         begin
  1335.           if RoomInfo.UserCount=16 then
  1336.           begin
  1337.             MessageBox(Handle,PChar('多人对话环境的最大收件人数不得超过 '+IntToStr(15)+' 个'),'提示',MB_OK);
  1338.             Break;
  1339.           end;
  1340.           AddRoom.UserCount:=AddRoom.UserCount+1;
  1341.           AddRoom.Users[AddRoom.UserCount]:=ID;
  1342.           RoomInfo.UserCount:=RoomInfo.UserCount+1;
  1343.           RoomInfo.Users[RoomInfo.UserCount]:=ID;
  1344.         end;
  1345.       end;
  1347.       if AddRoom.UserCount>0 then
  1348.       begin
  1349.         ImgHistory.Visible:=False;
  1351.         for jLoop:=1 to CBAddUser.Room.UserCount do
  1352.         begin
  1353.           if CBAddUser.Room.Users[jLoop]<>Me.ID then
  1354.           begin
  1355.             CBAddUser.Receiver:=CBAddUser.Room.Users[jLoop];
  1356.             CBAddUser.AddRoom:=AddRoom;
  1357.             Buffer[1]:=skAddUser;
  1358.             CopyMemory(@Buffer[2],@CBAddUser,SizeOf(CBAddUser));
  1359.             RealMessengerX.ClientTCP.WriteBuffer(Buffer,SizeOf(CBAddUser)+1);
  1360.           end;
  1361.         end;
  1362.       end;
  1364.     end;
  1365.   finally
  1366.     SelUserForm.Free;
  1367.     SelUserForm:=nil;
  1368.   end;
  1369.   ShowTitle();
  1370. end;
  1372. {------------------------------------------------------------------------------}
  1373. procedure TChatingForm.ImgSendFileClick(Sender: TObject);
  1374. var
  1375.   Receiver:Integer;
  1376.   ReceiverName:String;
  1377.   Form:TChatingForm;
  1378.   Room:ChatRoom;
  1379. begin
  1380.   if InGroupMsg=True then
  1381.   begin
  1382.       MessageBox(Handle,'群发消息状态下不能进行文件传输！','提示',MB_ICONINFORMATION);
  1383.       exit;
  1384.   end;
  1386.   if TVUserList.Items.Count = 1 then
  1387.   begin
  1388.     Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  1389.     ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  1390.     Form        :=Self;
  1391.   end
  1392.   else
  1393.   begin
  1394.     if TVUserList.SelectionCount = 0 then
  1395.     begin
  1396.       MessageBox(Handle,'请先在 当前对话列表 中选择收件人！','提示',MB_ICONINFORMATION);
  1397.       exit;
  1398.     end;
  1399.     Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  1400.     ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  1401.     Room.UserCount:=2;
  1402.     Room.Users[1] :=Me.ID;
  1403.     Room.Users[2] :=Receiver;
  1404.     Form:=OpenChatingForm(Room);
  1405.     Form.Show;
  1406.   end;
  1408.   OpenDialog.Title:='请选择要给 '+ReceiverName+' 发送的文件';
  1409.   if OpenDialog.Execute then
  1410.   begin
  1411.     TTransmitFile.Create(tfSend,Me.ID,Me.Name,Receiver,ReceiverName,OpenDialog.Files.Strings[0],Form,'',0,'',0);
  1412.   end;
  1413. end;
  1415. {------------------------------------------------------------------------------}
  1416. {
  1417. 功能：模拟Toolbar的按钮动作，MouseMove时显示为凸起状态
  1418. }
  1419. procedure TChatingForm.ImgAddNewMouseMove(Sender: TObject;
  1420.   Shift: TShiftState; X, Y: Integer);
  1421. begin
  1422.  {   ImgIndex:=(Sender as TImage).Tag;
  1423.     if ImgIndex=LastImgIndex then exit;
  1425.     ImgDraw.Canvas.lock;
  1426.     With ImgDraw.Canvas do
  1427.     begin
  1428.       Pen.Mode :=pmCopy;
  1429.       Pen.Style:=psClear;
  1430.       Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  1432.       Pen.Style:=psSolid;
  1433.       Pen.Color:=$00FEFEFE;
  1434.       Pen.Width:=1;
  1435.       MoveTo((Sender as TImage).Left-ImgDraw.Left,50);
  1436.       LineTo(PenPos.X,2);
  1437.       LineTo(PenPos.X+(Sender as TImage).Width,2);
  1438.       Pen.Color:=EndColor;
  1439.       LineTo(PenPos.X,50);
  1440.       LineTo(PenPos.X-(Sender as TImage).Width,50);
  1442.       Pen.Mode :=pmWhite;
  1443.       Pen.Style:=psSolid;
  1444.      // Rectangle((Sender as TImage).Left-ImgDraw.Left+1,3,(Sender as TImage).Left-ImgDraw.Left+(Sender as TImage).Width,50);
  1445.       //Refresh;
  1446.     end;
  1447.     LastImgIndex:=ImgIndex;
  1448.     TimerTopBar.Enabled:=True;
  1449.     ImgDraw.Canvas.Unlock;   }
  1450. end;
  1452. {------------------------------------------------------------------------------}
  1453. {
  1454. 功能：检查Mouse是否还在指定的范围之内，如不在则复位ToolBar的显示状态
  1455. }
  1456. procedure TChatingForm.TimerTopBarTimer(Sender: TObject);
  1457. var
  1458.    p : TPoint;
  1459. begin
  1460.  {  GetCursorPos(p);
  1461.    if (P.X < Left + ImgDraw.Left) or
  1462.       (P.X > Left + ImgDraw.Left + ImgDraw.Width) or
  1463.       (P.Y < Top + ImgDraw.Top) or
  1464.       (P.Y > Top + ImgDraw.Top + ImgDraw.Height) then
  1465.    begin
  1466.       With ImgDraw.Canvas do
  1467.       begin
  1468.         Pen.Mode :=pmCopy;
  1469.         Pen.Style:=psClear;
  1470.         Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  1471.       end;
  1472.       ImgIndex:=-1;
  1473.       LastImgIndex:=-1;
  1474.       TimerTopBar.Enabled:=False;
  1475.    end;     }
  1476. end;
  1478. {------------------------------------------------------------------------------}
  1479. {
  1480. 功能：模拟Toolbar的按钮动作，MouseDown时显示为凹下状态
  1481. }
  1482. procedure TChatingForm.ImgAddNewMouseDown(Sender: TObject;
  1483.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1484. begin
  1485. {    With ImgDraw.Canvas do
  1486.     begin
  1487.       Pen.Mode :=pmCopy;
  1488.       Pen.Style:=psClear;
  1489.       Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  1491.       Pen.Style:=psSolid;
  1492.       Pen.Color:=EndColor;
  1493.       Pen.Width:=1;
  1494.       MoveTo((Sender as TImage).Left-ImgDraw.Left,50);
  1495.       LineTo(PenPos.X,2);
  1496.       LineTo(PenPos.X+(Sender as TImage).Width,2);
  1497.       Pen.Color:=$00FEFEFE;
  1498.       LineTo(PenPos.X,50);
  1499.       LineTo(PenPos.X-(Sender as TImage).Width,50);
  1501.       Pen.Mode :=pmWhite;
  1502.       Pen.Style:=psSolid;
  1503.       //Rectangle((Sender as TImage).Left-ImgDraw.Left+1,3,(Sender as TImage).Left-ImgDraw.Left+(Sender as TImage).Width,50);
  1504.     end;
  1505.     ImgFontMouseDown(Sender,Button,Shift,X,Y);
  1506.     TimerTopBar.Enabled:=False;   }
  1507. end;
  1509. {------------------------------------------------------------------------------}
  1510. {
  1511. 功能：模拟Toolbar的按钮动作，MouseUp时显示为凸起状态
  1512. }
  1513. procedure TChatingForm.ImgAddNewMouseUp(Sender: TObject;
  1514.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1515. begin
  1516.  {     ImgFontMouseUp(Sender,Button,Shift,X,Y);
  1517.       With ImgDraw.Canvas do
  1518.       begin
  1519.       Pen.Mode :=pmCopy;
  1520.       Pen.Style:=psClear;
  1521.       Rectangle(0,0,ImgDraw.Width+1,ImgDraw.Height+1);
  1523.       Pen.Style:=psSolid;
  1524.       Pen.Color:=$00FEFEFE;
  1525.       Pen.Width:=1;
  1526.       MoveTo((Sender as TImage).Left-ImgDraw.Left,50);
  1527.       LineTo(PenPos.X,2);
  1528.       LineTo(PenPos.X+(Sender as TImage).Width,2);
  1529.       Pen.Color:=EndColor;
  1530.       LineTo(PenPos.X,50);
  1531.       LineTo(PenPos.X-(Sender as TImage).Width,50);
  1533.       Pen.Mode :=pmWhite;
  1534.       Pen.Style:=psSolid;
  1535.       //Rectangle((Sender as TImage).Left-ImgDraw.Left+1,3,(Sender as TImage).Left-ImgDraw.Left+(Sender as TImage).Width,50);
  1536.       end;
  1537.     TimerTopBar.Enabled:=True; }
  1538. end;
  1540. {------------------------------------------------------------------------------}
  1541. {
  1542. 功能：视频对话
  1543. }
  1544. procedure TChatingForm.ImgVideoClick(Sender: TObject);
  1545. var
  1546.   Receiver:Integer;
  1547.   ReceiverName:String;
  1548.   Form:TChatingForm;
  1549.   Room:ChatRoom;
  1550. begin
  1551.   if InGroupMsg=True then
  1552.   begin
  1553.       MessageBox(Handle,'群发消息状态下不能进行视频对话！','提示',MB_ICONINFORMATION);
  1554.       exit;
  1555.   end;
  1557.   RealMessengerX.TestVideoDevice();
  1558.   if TVUserList.Items.Count = 1 then
  1559.   begin
  1560.     if (not HaveVideoDevice) and (not PEmployee(TVUserList.Items.GetFirstNode.Data).HaveVideoDevice) then
  1561.     begin
  1562.       MessageBox(Handle,PChar('您和 '+String(PEmployee(TVUserList.Items.GetFirstNode.Data).Name)+' 的机器均没有安装视频捕获设备，不能开启网络摄像机功能'),'提示',MB_ICONINFORMATION);
  1563.       exit
  1564.     end;
  1565.     Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  1566.     ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  1567.     Form        :=Self;
  1568.   end
  1569.   else
  1570.   begin
  1571.     if TVUserList.SelectionCount = 0 then
  1572.     begin
  1573.       MessageBox(Handle,'请先在“当前对话列表”中选择您要邀请的开始进行视频对话的人！','提示',MB_ICONINFORMATION);
  1574.       exit;
  1575.     end;
  1576.     if (not HaveVideoDevice) and (not PEmployee(TVUserList.Selected.Data).HaveVideoDevice) then
  1577.     begin
  1578.       MessageBox(Handle,PChar('您和 '+String(PEmployee(TVUserList.Selected.Data).Name)+' 的机器均没有安装视频捕获设备，不能开启网络摄像机功能'),'提示',MB_ICONINFORMATION);
  1579.       exit
  1580.     end;
  1581.     Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  1582.     ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  1583.     Room.UserCount:=2;
  1584.     Room.Users[1] :=Me.ID;
  1585.     Room.Users[2] :=Receiver;
  1586.     Form:=OpenChatingForm(Room);
  1587.     Form.Show;
  1588.   end;
  1590.   TVideoHandShake.Create(vhRequest,Receiver,ReceiverName,Form,'',0,'',0,'',0,'',0);
  1591. end;
  1593. {------------------------------------------------------------------------------}
  1594. {
  1595. 功能：音频对话
  1596. }
  1597. procedure TChatingForm.ImgVoiceClick(Sender: TObject);
  1598. var
  1599.   Receiver:Integer;
  1600.   ReceiverName:String;
  1601.   Form:TChatingForm;
  1602.   Room:ChatRoom;
  1603. begin
  1604.   if InGroupMsg=True then
  1605.   begin
  1606.       MessageBox(Handle,'群发消息状态下不能进行音频对话！','提示',MB_ICONINFORMATION);
  1607.       exit;
  1608.   end;
  1610.   if not HaveAudioDevice then
  1611.   begin
  1612.     MessageBox(Handle,'您的机器没有安装声音设备，不能进行音频对话','提示',MB_ICONINFORMATION);
  1613.     exit
  1614.   end;
  1616.   if TVUserList.Items.Count = 1 then
  1617.   begin
  1618.     if not PEmployee(TVUserList.Items.GetFirstNode.Data).HaveAudioDevice then
  1619.     begin
  1620.       MessageBox(Handle,'对方的机器没有安装声音设备，不能进行音频对话','提示',MB_ICONINFORMATION);
  1621.       exit
  1622.     end;
  1623.     Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  1624.     ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  1625.     Form        :=Self;
  1626.   end
  1627.   else
  1628.   begin
  1629.     if TVUserList.SelectionCount = 0 then
  1630.     begin
  1631.       MessageBox(Handle,'请先在“当前对话列表”中选择您要邀请的开始进行音频对话的人！','提示',MB_ICONINFORMATION);
  1632.       exit;
  1633.     end;
  1634.     if not PEmployee(TVUserList.Selected.Data).HaveAudioDevice then
  1635.     begin
  1636.       MessageBox(Handle,'对方的机器没有安装声音设备，不能进行音频对话','提示',MB_ICONINFORMATION);
  1637.       exit;
  1638.     end;
  1639.     Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  1640.     ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  1641.     Room.UserCount:=2;
  1642.     Room.Users[1] :=Me.ID;
  1643.     Room.Users[2] :=Receiver;
  1644.     Form:=OpenChatingForm(Room);
  1645.     Form.Show;
  1646.   end;
  1648.   TAudioHandShake.Create(ahRequest,Receiver,ReceiverName,Form,'',0,'',0);
  1649. end;
  1651. {------------------------------------------------------------------------------}
  1652. procedure TChatingForm.SetDOMStyle(Doc:IHTMLDocument2);
  1653. var
  1654.   v: Variant;
  1655.   TempReg:TRegistry;
  1656. begin
  1657.   v := VarArrayCreate([0, 0], varVariant);
  1658.   v[0] := '<body oncontextmenu="location.href=''PopMenu'';return false;"></body>';
  1659.   doc.write(PSafeArray(TVarData(v).VArray));
  1660.   try
  1661.       CssColor:='#'+Copy(IntToHex(EndColor,6),5,2)+Copy(IntToHex(EndColor,6),3,2)+Copy(IntToHex(EndColor,6),1,2);
  1662.   except
  1663.   end;
  1664.   Doc.body.style.cssText:='SCROLLBAR-FACE-COLOR:'+CssColor+';'+
  1665.   'SCROLLBAR-HIGHLIGHT-COLOR: ButtonHighLight;'+
  1666.   'SCROLLBAR-SHADOW-COLOR:ButtonShadow;'+
  1667.   'SCROLLBAR-ARROW-COLOR: #333333;'+
  1668.   'SCROLLBAR-3DLIGHT-COLOR:'+CssColor+';'+
  1669.   'SCROLLBAR-TRACK-COLOR:'+CssColor+';'+
  1670.   'SCROLLBAR-DARKSHADOW-COLOR:'+CssColor+';'+
  1671.   'word-break:break-all;'+
  1672.         'background-attachment: fixed;'+
  1673.         'background-repeat: no-repeat;'+
  1674.         'background-position: left top;';
  1675.   Doc.body.style.overflow:='auto';
  1676.   Doc.body.style.border:='0px solid';
  1677.   Doc.body.style.margin:='2px';
  1678.   Doc.body.style.fontFamily:='宋体';
  1679.   Doc.body.style.fontSize:='9pt';
  1681.   TempReg:=TRegistry.Create;
  1682.   try
  1683.     TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  1684.     if TempReg.OpenKey(AppKey+''+LoginName+'ChatingFormStore', True) then
  1685.     begin
  1686.         Doc.body.style.backgroundImage:='url('+TempReg.ReadString('BackGroundImage')+')';
  1687.     end;
  1688.   finally
  1689.     TempReg.Free;
  1690.   end;
  1691. end;
  1693. {------------------------------------------------------------------------------}
  1694. procedure TChatingForm.SetBrowserStyle();
  1695. begin
  1696.   SetDOMStyle(MsgContent.Document as IHTMLDocument2);
  1697. end;
  1699. {------------------------------------------------------------------------------}
  1700. procedure TChatingForm.SetBrowserBg(Url:String);
  1701. var
  1702.   TempReg:TRegistry;
  1703. begin
  1704.     TempReg:=TRegistry.Create;
  1705.     try
  1706.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  1707.       if TempReg.OpenKey(AppKey+''+LoginName+'ChatingFormStore', True) then
  1708.       begin
  1709.         TempReg.WriteString('BackGroundImage',Url);
  1710.         SetBrowserStyle();
  1711.       end;
  1712.     finally
  1713.       TempReg.Free;
  1714.     end;
  1716. end;
  1718. {------------------------------------------------------------------------------}
  1719. {
  1720. 功能：选择表情图标
  1721. }
  1722. procedure TChatingForm.ImgSelFaceClick(Sender: TObject);
  1723. begin
  1724.   if SelFaceForm=nil then
  1725.   begin
  1726.         SelFaceForm:=TSelFaceForm.Create(Self);
  1727.         SelFaceForm.ParentForm:=Self;
  1728.         SelFaceForm.Show;
  1729.   end;
  1730. end;
  1732. {------------------------------------------------------------------------------}
  1733. {
  1734. 功能：模拟Toolbar的按钮动作，MouseMove时显示为凸起状态
  1735. }
  1736. procedure TChatingForm.ImgFontMouseMove(Sender: TObject;
  1737.   Shift: TShiftState; X, Y: Integer);
  1738. begin
  1739.     ImgIndex:=(Sender as TImage).Tag;
  1740.     if ImgIndex=LastImgIndex then exit;
  1742.     With ImgBottomDraw.Canvas do
  1743.     begin
  1744.       Pen.Mode :=pmCopy;
  1745.       Pen.Style:=psClear;
  1746.       Rectangle(0,0,ImgBottomDraw.Width+1,ImgBottomDraw.Height+1);
  1748.       Pen.Style:=psSolid;
  1749.       Pen.Color:=$00FEFEFE;
  1750.       Pen.Width:=1;
  1751.       MoveTo((Sender as TImage).Left-ImgBottomDraw.Left,21);
  1752.       LineTo(PenPos.X,2);
  1753.       LineTo(PenPos.X+(Sender as TImage).Width,2);
  1754.       Pen.Color:=$00AAAAAA;
  1755.       LineTo(PenPos.X,21);
  1756.       LineTo(PenPos.X-(Sender as TImage).Width,21);
  1757.       Refresh;
  1758.     end;
  1759.     LastImgIndex:=ImgIndex;
  1760.     TimerBottomBar.Enabled:=True;
  1761. end;
  1763. {------------------------------------------------------------------------------}
  1764. {
  1765. 功能：检查Mouse是否还在指定的区域之内，如不在则复位按钮状态
  1766. }
  1767. procedure TChatingForm.TimerBottomBarTimer(Sender: TObject);
  1768. var
  1769.    p : TPoint;
  1770. begin
  1771.    GetCursorPos(p);
  1772.    if (P.X < Left + PnlLeftBottom.Left + ImgBottomDraw.Left) or
  1773.       (P.X > Left + PnlLeftBottom.Left + ImgBottomDraw.Left + ImgBottomDraw.Width) or
  1774.       (P.Y < Top + PnlLeftBottom.Top + ImgBottomDraw.Top) or
  1775.       (P.Y > Top + PnlLeftBottom.Top + ImgBottomDraw.Top + ImgBottomDraw.Height) then
  1776.    begin
  1777.       With ImgBottomDraw.Canvas do
  1778.       begin
  1779.         Pen.Mode :=pmCopy;
  1780.         Pen.Style:=psClear;
  1781.         Rectangle(0,0,ImgBottomDraw.Width+1,ImgBottomDraw.Height+1);
  1782.       end;
  1783.       ImgIndex:=-1;
  1784.       LastImgIndex:=-1;
  1785.       TimerBottomBar.Enabled:=False;
  1786.    end;
  1787. end;
  1789. {------------------------------------------------------------------------------}
  1790. {
  1791. 功能：模拟Toolbar的按钮动作，MouseDown时显示为凸起状态
  1792. }
  1793. procedure TChatingForm.ImgSelBackMouseDown(Sender: TObject;
  1794.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1795. begin
  1796.     With ImgBottomDraw.Canvas do
  1797.     begin
  1798.       Pen.Mode :=pmCopy;
  1799.       Pen.Style:=psClear;
  1800.       Rectangle(0,0,ImgBottomDraw.Width+1,ImgBottomDraw.Height+1);
  1802.       Pen.Style:=psSolid;
  1803.       Pen.Color:=$00AAAAAA;
  1804.       Pen.Width:=1;
  1805.       MoveTo((Sender as TImage).Left-ImgBottomDraw.Left,21);
  1806.       LineTo(PenPos.X,2);
  1807.       LineTo(PenPos.X+(Sender as TImage).Width,2);
  1808.       Pen.Color:=$00FEFEFE;
  1809.       LineTo(PenPos.X,21);
  1810.       LineTo(PenPos.X-(Sender as TImage).Width,21);
  1811.       Refresh;
  1812.     end;
  1813.     ImgFontMouseDown(Sender,Button,Shift,X,Y);
  1814.     TimerBottomBar.Enabled:=False;
  1815. end;
  1817. {------------------------------------------------------------------------------}
  1818. {
  1819. 功能：模拟Toolbar的按钮动作，MouseUp时显示为凹下状态
  1820. }
  1821. procedure TChatingForm.ImgSelBackMouseUp(Sender: TObject;
  1822.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1823. begin
  1824.     ImgFontMouseUp(Sender,Button,Shift,X,Y);
  1825.     With ImgBottomDraw.Canvas do
  1826.     begin
  1827.       Pen.Mode :=pmCopy;
  1828.       Pen.Style:=psClear;
  1829.       Rectangle(0,0,ImgBottomDraw.Width+1,ImgBottomDraw.Height+1);
  1831.       Pen.Style:=psSolid;
  1832.       Pen.Color:=$00FEFEFE;
  1833.       Pen.Width:=1;
  1834.       MoveTo((Sender as TImage).Left-ImgBottomDraw.Left,21);
  1835.       LineTo(PenPos.X,2);
  1836.       LineTo(PenPos.X+(Sender as TImage).Width,2);
  1837.       Pen.Color:=$00AAAAAA;
  1838.       LineTo(PenPos.X,21);
  1839.       LineTo(PenPos.X-(Sender as TImage).Width,21);
  1840.       Refresh;
  1841.     end;
  1842.     TimerBottomBar.Enabled:=True;
  1843. end;
  1845. {------------------------------------------------------------------------------}
  1846. {
  1847. 功能：选择背景
  1848. }
  1849. procedure TChatingForm.ImgSelBackClick(Sender: TObject);
  1850. begin
  1851.   if SelBackForm=nil then
  1852.   begin
  1853.         SelBackForm:=TSelBackForm.Create(Self);
  1854.         SelBackForm.ParentForm:=Self;
  1855.         SelBackForm.Show;
  1856.   end;
  1857. end;
  1859. {------------------------------------------------------------------------------}
  1860. {
  1861. 功能：调整输入框的高度（MouseMove事件）
  1862. }
  1863. procedure TChatingForm.PnlSpplitMouseMove(Sender: TObject; Shift: TShiftState;
  1864.   X, Y: Integer);
  1865. var
  1866.   OT:Integer;
  1867. begin
  1868.   if Not CanMove Then exit;
  1869.   if (PnlLeftTop.Height+(PnlSpplit.Top-OldTop)<145) and (PnlSpplit.Top>PnlSpplit.Top+(Y-OY)) then exit;
  1870.   if (PnlLeftBottom.Height+(OldTop-PnlSpplit.Top)<118) and (PnlSpplit.Top<PnlSpplit.Top+(Y-OY)) then exit;
  1871.   OT:=PnlSpplit.Top;
  1872.   PnlSpplit.Top:=PnlSpplit.Top+(Y-OY);
  1873.   if (PnlSpplit.Top<80) or (PnlSpplit.Top>Height-120) then PnlSpplit.Top:=OT
  1874. end;
  1876. {------------------------------------------------------------------------------}
  1877. {
  1878. 功能：调整输入框的高度（MouseDown事件）
  1879. }
  1880. procedure TChatingForm.PnlSpplitMouseDown(Sender: TObject;
  1881.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1882. begin
  1883.   CanMove:=True;
  1884.   OX:=X;
  1885.   OY:=Y;
  1886.   OldTop:=PnlSpplit.Top;
  1887.   PnlSpplit.Color:=EndColor;
  1888. end;
  1890. {------------------------------------------------------------------------------}
  1891. {
  1892. 功能：调整输入框的高度（MouseUp事件）
  1893. }
  1894. procedure TChatingForm.PnlSpplitMouseUp(Sender: TObject;
  1895.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  1896. begin
  1897.   if Not CanMove Then exit;
  1898.   PnlLeftTop.Height:=PnlLeftTop.Height+(PnlSpplit.Top-OldTop);
  1899.   PnlLeftBottom.Top:=PnlLeftTop.Top+PnlLeftTop.Height+3;
  1900.   PnlRightBottom.Top:=PnlLeftBottom.Top;
  1901.   PnlMyCamera.Top:=PnlLeftBottom.Top;
  1902.   PnlLeftBottom.Height:=PnlLeftBottom.Height+(OldTop-PnlSpplit.Top);
  1903.   PnlRightBottom.Height:=PnlRightBottom.Height+(OldTop-PnlSpplit.Top);
  1904.   FormResize(nil);
  1905.   CanMove:=False;
  1906.   PnlSpplit.ParentColor:=true;
  1907. end;
  1909. {复制}
  1910. procedure TChatingForm.Copy1Click(Sender: TObject);
  1911. var
  1912.   wb:IOleCommandTarget;
  1913.   hr:HRESULT;
  1914.   vv: olevariant;
  1915. begin
  1916.   //Copy 复制
  1917.   try
  1918.     //MsgContent.ExecWB(OLECMDID_COPY, OLECMDEXECOPT_PROMPTUSER);
  1919.   MsgContent.document.QueryInterface(IOleCommandTarget,wb);
  1920.   if(wb=nil) then exit;
  1921.   hr:=wb.Exec(@CGID_MSHTML,15,OLECMDEXECOPT_DODEFAULT,EmptyParam,vv);
  1922.   except
  1923.   end;
  1924. end;
  1926. {全选}
  1927. procedure TChatingForm.SelectAll1Click(Sender: TObject);
  1928. begin
  1929.   //Select All 全选
  1930.   try
  1931.     MsgContent.ExecWB(OLECMDID_SELECTALL, OLECMDEXECOPT_PROMPTUSER);
  1932.   except
  1933.   end;
  1934. end;
  1936. {------------------------------------------------------------------------------}
  1937. procedure TChatingForm.MsgContentBeforeNavigate2(Sender: TObject;
  1938.   const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  1939.   Headers: OleVariant; var Cancel: WordBool);
  1940. const
  1941.   hUrl = 'about:blank';
  1942. var
  1943.   NewUrl:String;
  1944.   BaseID:String;
  1945.   TransmitFile:TTransmitFile;
  1946.   AudioHandShake:TAudioHandShake;
  1947.   VideoHandShake:TVideoHandShake;
  1949.   function GetBaseIDFromUrl(SrcUrl:String):String;
  1950.   begin
  1951.     result:=Copy(SrcUrl,AnsiPos('_',SrcUrl)+1,Length(SrcUrl));
  1952.   end;
  1953. begin
  1954.   NewUrl:=Trim(AnsiReplaceStr(String(URL),hUrl,''));
  1956.   if AnsiSameText(NewUrl , 'PopMenu') then
  1957.   begin
  1958.     Cancel:=True;
  1959.     WebPopupMenu.Popup(Mouse.CursorPos.X, Mouse.CursorPos.Y);
  1960.     exit;
  1961.   end;
  1963.   if AnsiSameText(Copy(NewUrl,1,8) , 'TFCancel') then
  1964.   begin
  1965.     Cancel:=True;
  1966.     BaseID:=GetBaseIDFromUrl(NewUrl);
  1967.     TransmitFile:=FindTransmitFileByBaseID(BaseID);
  1968.     if TransmitFile<>nil then TransmitFile.Cancel;
  1969.     exit;
  1970.   end;
  1972.   if AnsiSameText(Copy(NewUrl,1,8) , 'TFAccept') then
  1973.   begin
  1974.     Cancel:=True;
  1975.     BaseID:=GetBaseIDFromUrl(NewUrl);
  1976.     TransmitFile:=FindTransmitFileByBaseID(BaseID);
  1977.     if TransmitFile<>nil then TransmitFile.Accept;
  1978.     exit;
  1979.   end;
  1981.   if AnsiSameText(Copy(NewUrl,1,9) , 'TFdecline') then
  1982.   begin
  1983.     Cancel:=True;
  1984.     BaseID:=GetBaseIDFromUrl(NewUrl);
  1985.     TransmitFile:=FindTransmitFileByBaseID(BaseID);
  1986.     if TransmitFile<>nil then TransmitFile.Decline;
  1987.     exit;
  1988.   end;
  1990.   if AnsiSameText(Copy(NewUrl,1,6) , 'TFStop') then
  1991.   begin
  1992.     Cancel:=True;
  1993.     BaseID:=GetBaseIDFromUrl(NewUrl);
  1994.     TransmitFile:=FindTransmitFileByBaseID(BaseID);
  1995.     if TransmitFile<>nil then TransmitFile.Stop(Me.ID);
  1996.     exit;
  1997.   end;
  1999.   if AnsiSameText(Copy(NewUrl,1,7) , 'File://') then
  2000.   begin
  2001.     Cancel:=True;
  2002.     BaseID:=AnsiReplaceStr(GetBaseIDFromUrl(NewUrl),'%20',' ');
  2003.     ShellExecute(handle, 'open', PChar(BaseID), nil, nil, SW_SHOWNORMAL);
  2004.     exit;
  2005.   end;
  2007.   if AnsiSameText(Copy(NewUrl,1,8) , 'AHCancel') then
  2008.   begin
  2009.     Cancel:=True;
  2010.     BaseID:=GetBaseIDFromUrl(NewUrl);
  2011.     AudioHandShake:=FindAudioHandShakeByBaseID(BaseID);
  2012.     if AudioHandShake<>nil then AudioHandShake.Cancel;
  2013.     exit;
  2014.   end;
  2016.   if AnsiSameText(Copy(NewUrl,1,9) , 'AHdecline') then
  2017.   begin
  2018.     Cancel:=True;
  2019.     BaseID:=GetBaseIDFromUrl(NewUrl);
  2020.     AudioHandShake:=FindAudioHandShakeByBaseID(BaseID);
  2021.     if AudioHandShake<>nil then AudioHandShake.Decline;
  2022.     exit;
  2023.   end;
  2025.   if AnsiSameText(Copy(NewUrl,1,8) , 'AHAccept') then
  2026.   begin
  2027.     Cancel:=True;
  2028.     BaseID:=GetBaseIDFromUrl(NewUrl);
  2029.     AudioHandShake:=FindAudioHandShakeByBaseID(BaseID);
  2030.     if AudioHandShake<>nil then AudioHandShake.Accept;
  2031.     exit;
  2032.   end;
  2034.   if AnsiSameText(Copy(NewUrl,1,6) , 'AHStop') then
  2035.   begin
  2036.     Cancel:=True;
  2037.     LblQuitAudioClick(nil);
  2038.     exit;
  2039.   end;
  2041.   if AnsiSameText(Copy(NewUrl,1,8) , 'VHCancel') then
  2042.   begin
  2043.     Cancel:=True;
  2044.     BaseID:=GetBaseIDFromUrl(NewUrl);
  2045.     VideoHandShake:=FindVideoHandShakeByBaseID(BaseID);
  2046.     if VideoHandShake<>nil then VideoHandShake.Cancel;
  2047.     exit;
  2048.   end;
  2050.   if AnsiSameText(Copy(NewUrl,1,9) , 'VHdecline') then
  2051.   begin
  2052.     Cancel:=True;
  2053.     BaseID:=GetBaseIDFromUrl(NewUrl);
  2054.     VideoHandShake:=FindVideoHandShakeByBaseID(BaseID);
  2055.     if VideoHandShake<>nil then VideoHandShake.Decline;
  2056.     exit;
  2057.   end;
  2059.   if AnsiSameText(Copy(NewUrl,1,8) , 'VHAccept') then
  2060.   begin
  2061.     Cancel:=True;
  2062.     BaseID:=GetBaseIDFromUrl(NewUrl);
  2063.     VideoHandShake:=FindVideoHandShakeByBaseID(BaseID);
  2064.     if VideoHandShake<>nil then VideoHandShake.Accept;
  2065.     exit;
  2066.   end;
  2068.   if AnsiSameText(Copy(NewUrl,1,6) , 'VHStop') then
  2069.   begin
  2070.     Cancel:=True;
  2071.     LblQuitAudioClick(nil);
  2072.     exit;
  2073.   end;
  2075. end;
  2077. {------------------------------------------------------------------------------}
  2078. procedure TChatingForm.WebPopupMenuPopup(Sender: TObject);
  2079. begin
  2080.   //Edit Menu 编辑菜单
  2081.   if MsgContent.OleObject.Document.queryCommandEnabled('Copy') then
  2082.     Copy1.Enabled := True
  2083.   else
  2084.     Copy1.Enabled := False;
  2085. end;
  2087. {OnActivate事件}
  2088. procedure TChatingForm.FormActivate(Sender: TObject);
  2089. begin
  2090.   ActiveChatingForm:=Self;
  2091. end;
  2093. {OnDeactivate事件}
  2094. procedure TChatingForm.FormDeactivate(Sender: TObject);
  2095. begin
  2096.   ActiveChatingForm:=nil;
  2097. end;
  2099. {------------------------------------------------------------------------------}
  2100. procedure TChatingForm.MMMixerSliderInChange(Sender: TObject);
  2101. var
  2102.    hexString:String;
  2103.    rVALUE, bVALUE, gVALUE: integer;
  2104.    hNewVALUE, sNewVALUE, lNewVALUE  : Double;
  2105. begin
  2106.     hexString:=IntToHex(EndColor,6);
  2107.     RGBtoHSL(StrToInt('$'+Copy(hexString,5,2)), StrToInt('$'+Copy(hexString,3,2)), StrToInt('$'+Copy(hexString,1,2)), hNewVALUE, sNewVALUE, lNewVALUE);
  2108.     HSLtorgb(hNewVALUE, sNewVALUE,90-30*((Sender as TMMMixerSlider).Position/(Sender as TMMMixerSlider).MaxValue), rVALUE, gVALUE, bVALUE);
  2109.     (Sender as TMMMixerSlider).Color:=TColor(bVALUE*256*256+gVALUE*256+rVALUE);
  2110. end;
  2112. {------------------------------------------------------------------------------}
  2113. {
  2114. 功能：开启/关闭麦克风
  2115. }
  2116. procedure TChatingForm.ImgMicClick(Sender: TObject);
  2117. begin
  2118.   ImgMicDisabled.Visible:=not ImgMicDisabled.Visible;
  2119.   if ImgMicDisabled.Visible then
  2120.     ACMWaveIn.Close
  2121.   else
  2122.     ACMWaveIn.Open(PWaveFormatEx(pwfx),MMMixerDevice1.DeviceID);
  2123. end;
  2125. {------------------------------------------------------------------------------}
  2126. {
  2127. 功能：开启/关闭扬声器
  2128. }
  2129. procedure TChatingForm.ImgSpkClick(Sender: TObject);
  2130. begin
  2131.   ImgSpkDisabled.Visible:=not ImgSpkDisabled.Visible;
  2132.   if ImgMicDisabled.Visible then
  2133.     ACMWaveOut.Close
  2134.   else
  2135.     ACMWaveOut.Open(PWaveFormatEx(pwfx),MMMixerDevice2.DeviceID);
  2136. end;
  2138. {------------------------------------------------------------------------------}
  2139. {
  2140. 功能：结束音频对话
  2141. }
  2142. procedure TChatingForm.LblQuitAudioClick(Sender: TObject);
  2143. var
  2144.   iLoop:Integer;
  2145.   AudioHandShake:TAudioHandShake;
  2146.   VideoHandShake:TVideoHandShake;
  2147. begin
  2148.   with AudioHandShakes.LockList do
  2149.   try
  2150.     for iLoop:=Count - 1 downto 0 do
  2151.     begin
  2152.       AudioHandShake:=Items[iLoop];
  2153.       if AudioHandShake.ChatingForm = Self then
  2154.       begin
  2155.         AudioHandShake.Stop(Me.ID);
  2156.         Break;
  2157.       end;
  2158.     end;
  2159.   finally
  2160.     AudioHandShakes.UnlockList;
  2161.   end;
  2163.   with VideoHandShakes.LockList do
  2164.   try
  2165.     for iLoop:=Count - 1 downto 0 do
  2166.     begin
  2167.       VideoHandShake:=Items[iLoop];
  2168.       if VideoHandShake.ChatingForm = Self then
  2169.       begin
  2170.         VideoHandShake.Stop(Me.ID);
  2171.         Break;
  2172.       end;
  2173.     end;
  2174.   finally
  2175.     VideoHandShakes.UnlockList;
  2176.   end;
  2177. end;
  2179. {------------------------------------------------------------------------------}
  2180. procedure TChatingForm.MsgContentDocumentComplete(Sender: TObject;
  2181.   const pDisp: IDispatch; var URL: OleVariant);
  2182. begin
  2183.   try
  2184.     SetDomStyle(MsgContent.Document as IHtmlDocument2 );
  2185.     MsgContent.OnDocumentComplete:=nil;
  2186.   except
  2187.   end;
  2188. end;
  2190. {------------------------------------------------------------------------------}
  2191. procedure TChatingForm.ImgSelColorClick(Sender: TObject);
  2192. begin
  2193.   if SelColorForm=nil then
  2194.   begin
  2195.         SelColorForm:=TSelColorForm.Create(Self);
  2196.         SelColorForm.ParentForm:=Self;
  2197.         SelColorForm.Show;
  2198.   end;
  2199. end;
  2201. {按钮被按下}
  2202. procedure TChatingForm.ImgSendTypeMouseDown(Sender: TObject;
  2203.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2204. begin
  2205.   ImgListSendType.GetBitmap(1,ImgSendType.Picture.Bitmap);
  2206.   ConvertBitmapToColor(ImgSendType.Picture.Bitmap,EndColor);
  2207.   ImgSendType.Refresh;
  2208. end;
  2210. {恢复按钮的初始状态}
  2211. procedure TChatingForm.ImgSendTypeMouseUp(Sender: TObject;
  2212.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2213. begin
  2214.   ImgListSendType.GetBitmap(0,ImgSendType.Picture.Bitmap);
  2215.   ConvertBitmapToColor(ImgSendType.Picture.Bitmap,EndColor);
  2216.   ImgSendType.Refresh;
  2217. end;
  2219. {------------------------------------------------------------------------------}
  2220. procedure TChatingForm.ImgSendTypeClick(Sender: TObject);
  2221. begin
  2222.   SendTypePopupMenu.Popup(Left+ImgSendType.Left+ImgSendType.Width+4,Top+ImgSendType.Top+3);
  2223. end;
  2225. procedure TChatingForm.TMEnterClick(Sender: TObject);
  2226. var
  2227.   TempReg:TRegistry;
  2228. begin
  2229.     TempReg:=TRegistry.Create;
  2230.     try
  2231.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  2232.       if TempReg.OpenKey(AppKey+''+LoginName+'ChatingFormStore', True) then
  2233.       begin
  2234.         TempReg.WriteString('SendType','Enter');
  2235.         TMEnter.Enabled:=False;
  2236.         TMCtrlEnter.Enabled:=True;
  2237.       end;
  2238.     finally
  2239.       TempReg.Free;
  2240.     end;
  2241. end;
  2243. procedure TChatingForm.TMCtrlEnterClick(Sender: TObject);
  2244. var
  2245.   TempReg:TRegistry;
  2246. begin
  2247.     TempReg:=TRegistry.Create;
  2248.     try
  2249.       TempReg.RootKey:=HKEY_LOCAL_MACHINE;
  2250.       if TempReg.OpenKey(AppKey+''+LoginName+'ChatingFormStore', True) then
  2251.       begin
  2252.         TempReg.WriteString('SendType','CtrlEnter');
  2253.         TMEnter.Enabled:=True;
  2254.         TMCtrlEnter.Enabled:=False;
  2255.       end;
  2256.     finally
  2257.       TempReg.Free;
  2258.     end;
  2259. end;
  2261. procedure TChatingForm.ImgGroupMsgClick(Sender: TObject);
  2262. var
  2263.   iLoop:Integer;
  2264.   Employee1:PEmployee;
  2265. begin
  2266. {  if InGroupMsg=True then
  2267.   begin
  2268.     TVUserList.Items.Clear;
  2269.     InGroupMsg:=False;
  2270.     ShowTitle(True);
  2271.     Exit;
  2272.   end;
  2274.   if AudioIsOn then
  2275.   begin
  2276.       MessageBox(Handle,'当前窗口已打开音频对话任务，不能群发消息！','提示',MB_ICONINFORMATION);
  2277.       exit;
  2278.   end;
  2280.   if VideoIsOn then
  2281.   begin
  2282.       MessageBox(Handle,'当前窗口已打开视频对话任务，不能群发消息！','提示',MB_ICONINFORMATION);
  2283.       exit;
  2284.   end;
  2286.   SelUserForm:=TSelUserForm.Create(Application);
  2287.   try
  2288.     if SelUserForm.ShowModal = mrOk then
  2289.     begin
  2290.       TVUserList.Items.Clear;
  2291.       for iLoop:=0 to SelUserForm.TrevUserList.Items.Count-1 do
  2292.       begin
  2293.         if (SelUserForm.TrevUserList.Items[iLoop].ImageIndex<6) or (SelUserForm.TrevUserList.Items[iLoop].ImageIndex>13)  then continue;
  2294.         if IsNodeChecked(SelUserForm.TrevUserList.Items[iLoop])=False then continue;
  2295.         Employee1:=PEmployee(SelUserForm.TrevUserList.Items[iLoop].Data);
  2296.         if Employee1.ID<>Me.ID then
  2297.         with TVUserList.Items.AddChild(nil,Employee1.Node.Text) do
  2298.         begin
  2299.           ImageIndex:=7;
  2300.           SelectedIndex:=ImageIndex;
  2301.           StateIndex:=Employee1.ID;
  2302.         end;
  2303.       end;
  2304.       if TVUserList.Items.Count>0 then
  2305.         InGroupMsg:=True
  2306.       else
  2307.         InGroupMsg:=False;
  2309.       ShowTitle();
  2310.     end;
  2311.   finally
  2312.     SelUserForm.Free;
  2313.     SelUserForm:=nil;
  2314.   end;    }
  2315.   if TVUserList.Items.Count > 1 then exit;
  2317.   if HistoryForm<>nil then HistoryForm.Close;
  2318.   HistoryForm:=THistoryForm.Create(Application);
  2319.   if IsSystemMsg then
  2320.   begin
  2321.     HistoryForm.ID:=-1;
  2322.     HistoryForm.Name:='系统消息';
  2323.   end
  2324.   else
  2325.   begin
  2326.     HistoryForm.ID:=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  2327.     HistoryForm.Name:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  2328.   end;
  2329.   HistoryForm.Show;
  2330. end;
  2332. procedure TChatingForm.TVUserListGetImageIndex(Sender: TObject;
  2333.   Node: TTreeNode);
  2334. begin
  2335. {  if InGroupMsg then exit;
  2336.   if Node.StateIndex = -1 then
  2337.   begin
  2338.       if Node.Expanded then
  2339.         Node.ImageIndex:=4
  2340.       else
  2341.         Node.ImageIndex:=5;
  2342.   end;
  2344.   if Node.StateIndex = 0 then
  2345.   begin
  2346.       if Node.Expanded then
  2347.         Node.ImageIndex:=1
  2348.       else
  2349.         Node.ImageIndex:=0;
  2350.   end;
  2352.   if Node.StateIndex = 1 then
  2353.   begin
  2354.       if Node.Expanded then
  2355.         Node.ImageIndex:=3
  2356.       else
  2357.         Node.ImageIndex:=2;
  2358.   end;      
  2360.   Node.SelectedIndex:=Node.ImageIndex;}
  2361. end;
  2363. procedure TChatingForm.ApplicationEvents1Message(var Msg: tagMSG;
  2364.   var Handled: Boolean);
  2365. var
  2366.   nFiles, I,j: Integer;
  2367.   Filename,DragFilename: string;
  2369.   Receiver:Integer;
  2370.   ReceiverName:String;
  2371.   Form:TChatingForm;
  2372.   Room:ChatRoom;
  2373. begin
  2374.   if (Msg.message = WM_DROPFILES) then
  2375.   begin
  2376.     if InGroupMsg=True then
  2377.     begin
  2378.       MessageBox(Handle,'群发消息状态下不能进行文件传输！','提示',MB_ICONINFORMATION);
  2379.       exit;
  2380.     end;
  2382.     if TVUserList.Items.Count = 1 then
  2383.     begin
  2384.       Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  2385.       ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  2386.       Form        :=Self;
  2387.     end
  2388.     else
  2389.     begin
  2390.       if TVUserList.SelectionCount = 0 then
  2391.       begin
  2392.         MessageBox(Handle,'请先在 当前对话列表 中选择收件人！','提示',MB_ICONINFORMATION);
  2393.         exit;
  2394.       end;
  2395.       Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  2396.       ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  2397.       Room.UserCount:=2;
  2398.       Room.Users[1] :=Me.ID;
  2399.       Room.Users[2] :=Receiver;
  2400.       Form:=OpenChatingForm(Room);
  2401.       Form.Show;
  2402.     end;
  2403.     
  2404.     nFiles := DragQueryFile (Msg.wParam, $FFFFFFFF, nil, 0);
  2405.     try
  2406.       if nFiles>1 then nFiles:=1;
  2407.       for I := 0 to nFiles - 1 do
  2408.       begin
  2409.         SetLength (Filename, 255);
  2410.         DragQueryFile (Msg.wParam, I, PChar (Filename), 255);
  2411.         for j:=1 to 255 do
  2412.         begin
  2413.           if Ord(Filename[j])>0 then
  2414.           begin
  2415.             SetLength (DragFilename, j);
  2416.             DragFilename[j]:=Filename[j];
  2417.           end
  2418.           else
  2419.             Break;
  2420.         end;
  2421.         TTransmitFile.Create(tfSend,Me.ID,Me.Name,Receiver,ReceiverName,DragFilename,Form,'',0,'',0);
  2422.       end;
  2423.     finally
  2424.       DragFinish (Msg.wParam);
  2425.       Handled := True;
  2426.     end;
  2427.   end;
  2428.   
  2430.   if CopyScreenForm<>nil then exit;
  2431.   if msg.message<>wm_keydown then exit;
  2432.   if (GetKeyState(VK_CONTROL)<0) and (msg.hwnd<>MsgInput.Handle) then
  2433.   begin
  2434.     if (msg.wParam=Ord('C')) and MsgContent.OleObject.Document.queryCommandEnabled('Copy') then Copy1Click(nil);
  2435.     if msg.wParam=Ord('A') then SelectAll1Click(nil);
  2436.   end;
  2437. end;
  2439. procedure TChatingForm.X1Click(Sender: TObject);
  2440. begin
  2441.   if TMCtrlEnter.Checked then ImgSendClick(ImgSend);
  2442. end;
  2444. procedure TChatingForm.X2Click(Sender: TObject);
  2445. begin
  2446.   if TMEnter.Checked then
  2447.     ImgSendClick(ImgSend)
  2448.   else if MsgInput.Focused then
  2449.   begin
  2450.     MsgInput.SelText:=#13#10;
  2451.     MsgInput.SelStart:=MsgInput.SelStart+1;
  2452.     MsgInput.SelLength:=0;
  2453.   end;
  2454. end;
  2456. procedure TChatingForm.MsgInputMouseDown(Sender: TObject;
  2457.   Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  2458. begin
  2459.   if Button=mbRight then PopupMenuEdit.Popup(Left+PnlLeftBottom.Left+X,Top+PnlLeftBottom.Top+MsgInput.Top+Y);
  2460. end;
  2462. procedure TChatingForm.VideoCapVideoStream(sender: TObject;
  2463.   lpVhdr: PVIDEOHDR);
  2464. begin
  2465.   CompareFrame(lpVhdr);
  2466. end;
  2468. procedure TChatingForm.AviPanelOutDblClick(Sender: TObject);
  2469. var
  2470.   VideoHandShake:TVideoHandShake;
  2471. begin
  2472.   if VideoForm=nil then
  2473.   begin
  2474.     VideoHandShake:=FindVideoHandShakeByID(PEmployee(TVUserList.Items.GetFirstNode.Data).ID);
  2475.     if VideoHandShake<>nil then
  2476.     begin
  2477.       VideoForm:=TVideoForm.Create(Self);
  2478.       VideoForm.VideoHandShake:=VideoHandShake;
  2479.       VideoHandShake.PDC:=GetDC(VideoForm.Handle);
  2480.       VideoForm.ChatingForm:=Self;
  2481.       VideoForm.Show;
  2482.     end;
  2483.   end;
  2484. end;
  2486. procedure TChatingForm.ACMWaveInData(data: Pointer; size: Integer);
  2487. var
  2488.   CBAudio:TCBAudio;
  2489.   Buffer:Array[1..2048]of char;
  2490. begin
  2491.   //Self.Caption:=IntToStr(size);
  2492.   if AudioReceiverID = 0 then exit;
  2493.   CBAudio.Receiver:=AudioReceiverID;
  2494.   CBAudio.Sender:=Me.ID;
  2495.   CopyMemory(@(CBAudio.lpData),data,size);
  2496.   CBAudio.dwBufferLength:=size;
  2498.   Buffer[1]:=skAudio;
  2499.   CopyMemory(@Buffer[2],@CBAudio,SizeOf(CBAudio));
  2500.   AudioMySocket.SendBuffer(Buffer,SizeOf(CBAudio)+1);{发送语音}
  2501. end;
  2503. procedure TChatingForm.CopyScreen;
  2504. var
  2505.   Fullscreen:Tbitmap;
  2506.   FullscreenCanvas:TCanvas;
  2507.   dc:HDC;
  2508.   TransmitFile:TTransmitFile;
  2509.   iLoop,TFCount:Integer;
  2510. begin
  2511.   if InGroupMsg=True then
  2512.   begin
  2513.       MessageBox(Handle,'群发消息状态下不能进行截屏操作！','提示',MB_ICONINFORMATION);
  2514.       exit;
  2515.   end;
  2517.   if TVUserList.Items.Count > 1 then
  2518.   begin
  2519.     MessageBox(Handle,'多人模式下不能进行截屏操作','提示',MB_ICONINFORMATION);
  2520.     exit
  2521.   end;
  2523.   if PEmployee(TVUserList.Items.GetFirstNode.Data).State='断开' then
  2524.   begin
  2525.     MessageBox(Handle,'对方不在线，不能进行截屏操作','提示',MB_ICONINFORMATION);
  2526.     exit
  2527.   end;
  2529.   TFCount:=0;
  2530.   with TransmitFiles.LockList do
  2531.   try
  2532.     for iLoop:=0 to Count - 1 do
  2533.     begin
  2534.       TransmitFile:=Items[iLoop];
  2535.       if (TransmitFile.SenderID = Me.ID) and (TransmitFile.ReceiverID = PEmployee(TVUserList.Items.GetFirstNode.Data).ID) and (TransmitFile.IsAccepted=True) then
  2536.       begin
  2537.         if TransmitFile.IsScreen then
  2538.         begin
  2539.           messagebox(Handle,'请先等待前一张图片传输完毕！','提示',MB_ICONINFORMATION);
  2540.           exit;
  2541.         end;
  2543.         Inc(TFCount);
  2544.         if TFCount>=3 then
  2545.         begin
  2546.           messagebox(Handle,'在其它文件或图片发送完毕之前，您不能进行截屏操作！','提示',MB_ICONINFORMATION);
  2547.           exit;
  2548.         end;
  2549.       end;
  2550.     end;
  2551.   finally
  2552.     TransmitFiles.UnlockList;
  2553.   end;
  2555.   CopyScreenForm:=TCopyScreenForm.Create(Self);
  2557.   Fullscreen := TBitmap.Create;      
  2558.   Fullscreen.Width := screen.width;
  2559.   Fullscreen.Height := screen.Height;
  2560.   DC := GetDC (0);                   
  2561.   FullscreenCanvas := TCanvas.Create;
  2562.   FullscreenCanvas.Handle := DC;
  2564.   Fullscreen.Canvas.CopyRect
  2565.       (Rect (0, 0, screen.Width, screen.Height), fullscreenCanvas,
  2566.       Rect (0, 0, Screen.Width, Screen.Height));
  2568.   FullscreenCanvas.Free;         
  2569.   ReleaseDC (0, DC);
  2571.   CopyScreenForm.ImgScreen.picture.Bitmap:=fullscreen;
  2572.   CopyScreenForm.Width:=fullscreen.Width;
  2573.   CopyScreenForm.Height:=fullscreen.Height;
  2574.   fullscreen.free;                        
  2575.   CopyScreenForm.ParentForm:=Self;
  2576.   CopyScreenForm.Show;
  2577. end;
  2579. procedure TChatingForm.ImgCopyScreenClick(Sender: TObject);
  2580. begin
  2581.   CopyScreenTypePopupMenu.Popup(Left+PnlLeftBottom.Left+ImgCopyScreen.Left+3,Top+PnlLeftBottom.Top+ImgCopyScreen.Top+ImgCopyScreen.Height+3);
  2582. end;
  2584. procedure TChatingForm.MDirectCopyScreenClick(Sender: TObject);
  2585. begin
  2586.   CopyScreenTimer.Enabled:=True;
  2587. end;
  2589. procedure TChatingForm.MCopyScreenAfterMinWindowClick(Sender: TObject);
  2590. begin
  2591.   ShowWindow(Handle,SW_HIDE);
  2592.   CopyScreenTimer.Enabled:=True;
  2593. end;
  2595. procedure TChatingForm.CopyScreenTimerTimer(Sender: TObject);
  2596. begin
  2597.   CopyScreenTimer.Enabled:=False;
  2598.   CopyScreen;
  2599.   if CopyScreenForm=nil then ShowWindow(Handle,SW_SHOW);
  2600. end;
  2602. procedure TChatingForm.lblTitleClick(Sender: TObject);
  2603. begin
  2604.   if WindowState = wsNormal then
  2605.   begin
  2606.     WindowState := wsMaximized;
  2607.     Left:=0;
  2608.     Top:=0;
  2609.     Width:=Screen.WorkAreaWidth;
  2610.     Height:=Screen.WorkAreaHeight;
  2611.   end
  2612.   else
  2613.   begin
  2614. //    ImgListMax.GetBitmap(0,ImgMax.Picture.Bitmap);
  2615.     WindowState := wsNormal;
  2616.   end;
  2618. //  ConvertBitmapToColor(ImgMax.Picture.Bitmap,EndColor);
  2619. //  ImgMax.Refresh;
  2620. end;
  2622. procedure TChatingForm.TVUserListClick(Sender: TObject);
  2623. begin
  2624.   if TVUserList.selected <> nil then
  2625.     TVUserList.selected.imageindex:=TVUserList.selected.imageindex;
  2626.     //showmessage(inttostr(TVUserList.selected.imageindex));
  2627. end;
  2629. procedure TChatingForm.fcImageBtn3Click(Sender: TObject);
  2630. var
  2631.   Receiver:Integer;
  2632.   ReceiverName:String;
  2633.   Form:TChatingForm;
  2634.   Room:ChatRoom;
  2635. begin
  2636.   if InGroupMsg=True then
  2637.   begin
  2638.       MessageBox(Handle,'群发消息状态下不能进行文件传输！','提示',MB_ICONINFORMATION);
  2639.       exit;
  2640.   end;
  2642.   if TVUserList.Items.Count = 1 then
  2643.   begin
  2644.     Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  2645.     ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  2646.     Form        :=Self;
  2647.   end
  2648.   else
  2649.   begin
  2650.     if TVUserList.SelectionCount = 0 then
  2651.     begin
  2652.       MessageBox(Handle,'请先在 当前对话列表 中选择收件人！','提示',MB_ICONINFORMATION);
  2653.       exit;
  2654.     end;
  2655.     Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  2656.     ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  2657.     Room.UserCount:=2;
  2658.     Room.Users[1] :=Me.ID;
  2659.     Room.Users[2] :=Receiver;
  2660.     Form:=OpenChatingForm(Room);
  2661.     Form.Show;
  2662.   end;
  2664.   OpenDialog.Title:='请选择要给 '+ReceiverName+' 发送的文件';
  2665.   if OpenDialog.Execute then
  2666.   begin
  2667.     TTransmitFile.Create(tfSend,Me.ID,Me.Name,Receiver,ReceiverName,OpenDialog.Files.Strings[0],Form,'',0,'',0);
  2668.   end;
  2670. end;
  2672. procedure TChatingForm.fcImageBtn2Click(Sender: TObject);
  2673. var
  2674.   ID:Integer;
  2675.   iLoop,jLoop:Integer;
  2676.   Finded:Boolean;
  2677.   CBAddUser:TCBAddUser;
  2678.   AddRoom:ChatRoom;
  2679.   Buffer:Array[1..2048]of char;
  2680. begin
  2681.   if InGroupMsg=True then
  2682.   begin
  2683.       MessageBox(Handle,'群发消息状态下不能进入多人模式！','提示',MB_ICONINFORMATION);
  2684.       exit;
  2685.   end;
  2687.   if AudioIsOn then
  2688.   begin
  2689.       MessageBox(Handle,'当前窗口已打开音频对话任务，不能进入多人模式！','提示',MB_ICONINFORMATION);
  2690.       exit;
  2691.   end;
  2693.   if VideoIsOn then
  2694.   begin
  2695.       MessageBox(Handle,'当前窗口已打开视频对话任务，不能进入多人模式！','提示',MB_ICONINFORMATION);
  2696.       exit;
  2697.   end;
  2699.   SelUserForm:=TSelUserForm.Create(Self);
  2700.   try
  2701.     if SelUserForm.ShowModal = mrOk then
  2702.     begin
  2703.       CBAddUser.Room.UserCount:=RoomInfo.UserCount;
  2704.       for iLoop:=1 to RoomInfo.UserCount do CBAddUser.Room.Users[iLoop]:=RoomInfo.Users[iLoop];
  2706.       AddRoom.UserCount:=0;
  2707.       for iLoop := 0 to SelUserForm.TrevUserList.Items.Count - 1 do
  2708.       begin
  2709.         if (SelUserForm.TrevUserList.Items[iLoop].ImageIndex<6) or (SelUserForm.TrevUserList.Items[iLoop].ImageIndex>13)  then continue;
  2710.         if IsNodeChecked(SelUserForm.TrevUserList.Items[iLoop])=False then continue;
  2711.         ID:=PEmployee(SelUserForm.TrevUserList.Items[iLoop].Data).ID;
  2712.         Finded:=False;
  2713.         for jLoop:=1 to RoomInfo.UserCount do
  2714.         begin
  2715.           if RoomInfo.Users[jLoop] = ID then
  2716.           begin
  2717.             Finded:=True;
  2718.             break;
  2719.           end;
  2720.         end;
  2721.         if not Finded then
  2722.         begin
  2723.           if RoomInfo.UserCount=16 then
  2724.           begin
  2725.             MessageBox(Handle,PChar('多人对话环境的最大收件人数不得超过 '+IntToStr(15)+' 个'),'提示',MB_OK);
  2726.             Break;
  2727.           end;
  2728.           AddRoom.UserCount:=AddRoom.UserCount+1;
  2729.           AddRoom.Users[AddRoom.UserCount]:=ID;
  2730.           RoomInfo.UserCount:=RoomInfo.UserCount+1;
  2731.           RoomInfo.Users[RoomInfo.UserCount]:=ID;
  2732.         end;
  2733.       end;
  2735.       if AddRoom.UserCount>0 then
  2736.       begin
  2737.         ImgHistory.Visible:=False;
  2739.         for jLoop:=1 to CBAddUser.Room.UserCount do
  2740.         begin
  2741.           if CBAddUser.Room.Users[jLoop]<>Me.ID then
  2742.           begin
  2743.             CBAddUser.Receiver:=CBAddUser.Room.Users[jLoop];
  2744.             CBAddUser.AddRoom:=AddRoom;
  2745.             Buffer[1]:=skAddUser;
  2746.             CopyMemory(@Buffer[2],@CBAddUser,SizeOf(CBAddUser));
  2747.             RealMessengerX.ClientTCP.WriteBuffer(Buffer,SizeOf(CBAddUser)+1);
  2748.           end;
  2749.         end;
  2750.       end;
  2752.     end;
  2753.   finally
  2754.     SelUserForm.Free;
  2755.     SelUserForm:=nil;
  2756.   end;
  2757.   ShowTitle();
  2758. end;
  2760. procedure TChatingForm.fcImageBtn4Click(Sender: TObject);
  2761. var
  2762.   Receiver:Integer;
  2763.   ReceiverName:String;
  2764.   Form:TChatingForm;
  2765.   Room:ChatRoom;
  2766. begin
  2767.   if InGroupMsg=True then
  2768.   begin
  2769.       MessageBox(Handle,'群发消息状态下不能进行音频对话！','提示',MB_ICONINFORMATION);
  2770.       exit;
  2771.   end;
  2773.   if not HaveAudioDevice then
  2774.   begin
  2775.     MessageBox(Handle,'您的机器没有安装声音设备，不能进行音频对话','提示',MB_ICONINFORMATION);
  2776.     exit
  2777.   end;
  2779.   if TVUserList.Items.Count = 1 then
  2780.   begin
  2781.     if not PEmployee(TVUserList.Items.GetFirstNode.Data).HaveAudioDevice then
  2782.     begin
  2783.       MessageBox(Handle,'对方的机器没有安装声音设备，不能进行音频对话','提示',MB_ICONINFORMATION);
  2784.       exit
  2785.     end;
  2786.     Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  2787.     ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  2788.     Form        :=Self;
  2789.   end
  2790.   else
  2791.   begin
  2792.     if TVUserList.SelectionCount = 0 then
  2793.     begin
  2794.       MessageBox(Handle,'请先在“当前对话列表”中选择您要邀请的开始进行音频对话的人！','提示',MB_ICONINFORMATION);
  2795.       exit;
  2796.     end;
  2797.     if not PEmployee(TVUserList.Selected.Data).HaveAudioDevice then
  2798.     begin
  2799.       MessageBox(Handle,'对方的机器没有安装声音设备，不能进行音频对话','提示',MB_ICONINFORMATION);
  2800.       exit;
  2801.     end;
  2802.     Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  2803.     ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  2804.     Room.UserCount:=2;
  2805.     Room.Users[1] :=Me.ID;
  2806.     Room.Users[2] :=Receiver;
  2807.     Form:=OpenChatingForm(Room);
  2808.     Form.Show;
  2809.   end;
  2811.   TAudioHandShake.Create(ahRequest,Receiver,ReceiverName,Form,'',0,'',0);
  2812. end;
  2814. procedure TChatingForm.fcImageBtn1Click(Sender: TObject);
  2815. var
  2816.   Receiver:Integer;
  2817.   ReceiverName:String;
  2818.   Form:TChatingForm;
  2819.   Room:ChatRoom;
  2820. begin
  2821.   if InGroupMsg=True then
  2822.   begin
  2823.       MessageBox(Handle,'群发消息状态下不能进行视频对话！','提示',MB_ICONINFORMATION);
  2824.       exit;
  2825.   end;
  2827.   RealMessengerX.TestVideoDevice();
  2828.   if TVUserList.Items.Count = 1 then
  2829.   begin
  2830.     if (not HaveVideoDevice) and (not PEmployee(TVUserList.Items.GetFirstNode.Data).HaveVideoDevice) then
  2831.     begin
  2832.       MessageBox(Handle,PChar('您和 '+String(PEmployee(TVUserList.Items.GetFirstNode.Data).Name)+' 的机器均没有安装视频捕获设备，不能开启网络摄像机功能'),'提示',MB_ICONINFORMATION);
  2833.       exit
  2834.     end;
  2835.     Receiver    :=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  2836.     ReceiverName:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  2837.     Form        :=Self;
  2838.   end
  2839.   else
  2840.   begin
  2841.     if TVUserList.SelectionCount = 0 then
  2842.     begin
  2843.       MessageBox(Handle,'请先在“当前对话列表”中选择您要邀请的开始进行视频对话的人！','提示',MB_ICONINFORMATION);
  2844.       exit;
  2845.     end;
  2846.     if (not HaveVideoDevice) and (not PEmployee(TVUserList.Selected.Data).HaveVideoDevice) then
  2847.     begin
  2848.       MessageBox(Handle,PChar('您和 '+String(PEmployee(TVUserList.Selected.Data).Name)+' 的机器均没有安装视频捕获设备，不能开启网络摄像机功能'),'提示',MB_ICONINFORMATION);
  2849.       exit
  2850.     end;
  2851.     Receiver    :=PEmployee(TVUserList.Selected.Data).ID;
  2852.     ReceiverName:=PEmployee(TVUserList.Selected.Data).Name;
  2853.     Room.UserCount:=2;
  2854.     Room.Users[1] :=Me.ID;
  2855.     Room.Users[2] :=Receiver;
  2856.     Form:=OpenChatingForm(Room);
  2857.     Form.Show;
  2858.   end;
  2860.   TVideoHandShake.Create(vhRequest,Receiver,ReceiverName,Form,'',0,'',0,'',0,'',0);
  2861. end;
  2863. procedure TChatingForm.fcImageBtn5Click(Sender: TObject);
  2864. begin
  2865.   if TVUserList.Items.Count > 1 then exit;
  2867.   if HistoryForm<>nil then HistoryForm.Close;
  2868.   HistoryForm:=THistoryForm.Create(Application);
  2869.   if IsSystemMsg then
  2870.   begin
  2871.     HistoryForm.ID:=-1;
  2872.     HistoryForm.Name:='系统消息';
  2873.   end
  2874.   else
  2875.   begin
  2876.     HistoryForm.ID:=PEmployee(TVUserList.Items.GetFirstNode.Data).ID;
  2877.     HistoryForm.Name:=PEmployee(TVUserList.Items.GetFirstNode.Data).Name;
  2878.   end;
  2879.   HistoryForm.Show;
  2880. end;
  2882. procedure TChatingForm.Label1Click(Sender: TObject);
  2883. begin
  2884. fcImageBtn2.click;
  2885. end;
  2887. procedure TChatingForm.Label2Click(Sender: TObject);
  2888. begin
  2889. fcImageBtn3.click;
  2890. end;
  2892. procedure TChatingForm.Label3Click(Sender: TObject);
  2893. begin
  2894. fcImageBtn4.click;
  2895. end;
  2897. procedure TChatingForm.Label4Click(Sender: TObject);
  2898. begin
  2899. fcImageBtn1.click;
  2900. end;
  2902. procedure TChatingForm.Label5Click(Sender: TObject);
  2903. begin
  2904. fcImageBtn5.click;
  2905. end;
  2907. end.