unit ChatWin;
{
    Copyright 2002, Peter Millard

    This file is part of Exodus.

    Exodus is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    Exodus is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with Exodus; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}
interface

uses
  Chat, ChatController, JabberID, XMLTag, mmsystem, Unicode, udp, Dateutils,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, BaseChat, ExtCtrls, StdCtrls, Menus, ComCtrls, ExRichEdit, RichEdit2,
  TntStdCtrls, Buttons, ToolWin, ImgList, Videocap, vfw, VideoDisp,
  IdThreadMgr, IdThreadMgrDefault, IdTCPConnection, IdTCPClient,
  IdBaseComponent, IdComponent, IdTCPServer, ACMWaveOut, ACMWaveIn;

const
  WM_AnyQPLAYAUDIO = WM_USER + 5415;

type
  TDisplayMode = (dmAuto, dmBig, dmSmall);
  TCaptureMode = (cmBig, cmSmall);

  TfrmChat = class(TfrmBaseChat)
    popContact: TPopupMenu;
    mnuHistory: TMenuItem;
    mnuProfile: TMenuItem;
    mnuBlock: TMenuItem;
    mnuSendFile: TMenuItem;
    mnuSave: TMenuItem;
    N1: TMenuItem;
    mnuReturns: TMenuItem;
    timFlash: TTimer;
    SaveDialog1: TSaveDialog;
    C1: TMenuItem;
    mnuVersionRequest: TMenuItem;
    mnuTimeRequest: TMenuItem;
    mnuLastActivity: TMenuItem;
    mnuOnTop: TMenuItem;
    popClearHistory: TMenuItem;
    mnuWordwrap: TMenuItem;
    NotificationOptions1: TMenuItem;
    timBusy: TTimer;
    popAddContact: TMenuItem;
    N3: TMenuItem;
    pnlJID: TPanel;
    imgStatus: TPaintBox;
    lblNick: TTntLabel;
    lblJID: TTntLabel;
    btnClose: TSpeedButton;
    pnlRight: TPanel;
    N11: TMenuItem;
    N4: TMenuItem;
    N5: TMenuItem;
    N6: TMenuItem;
    N7: TMenuItem;
    mnuViewRight: TMenuItem;
    mnuHistory1: TMenuItem;
    popClearHistory1: TMenuItem;
    mnuProfile1: TMenuItem;
    C2: TMenuItem;
    mnuVersionRequest1: TMenuItem;
    mnuTimeRequest1: TMenuItem;
    mnuLastActivity1: TMenuItem;
    popAddContact1: TMenuItem;
    mnuBlock1: TMenuItem;
    mnuSendFile1: TMenuItem;
    mnuSave1: TMenuItem;
    N8: TMenuItem;
    NotificationOptions2: TMenuItem;
    mnuOnTop1: TMenuItem;
    mnuReturns1: TMenuItem;
    mnuWordwrap1: TMenuItem;
    N9: TMenuItem;
    N10: TMenuItem;
    ACMWaveIn1: TACMWaveIn;
    ACMWaveOut1: TACMWaveOut;
    N12: TMenuItem;
    pnlCapture: TPanel;
    ImageCap: TImage;
    Label2: TLabel;
    R1: TMenuItem;
    Powerpoint1: TMenuItem;
    OpenDialog1: TOpenDialog;
    W1: TMenuItem;
    Timer1: TTimer;
    VideoCap: TVideoCap;
    pnlDisplay: TPanel;
    ImageDisp: TImage;
    VideoDisp: TVideoDisp;
    TrackBarSpk: TTrackBar;
    TrackBarMic: TTrackBar;
    Imagespk: TImage;
    ImageMic: TImage;
    TrackBarquant: TTrackBar;
    lbquant: TLabel;
    spbtnLBig: TSpeedButton;
    spbtnLSmall: TSpeedButton;
    spbtnRBig: TSpeedButton;
    spbtnRSmall: TSpeedButton;
    spbtnRAuto: TSpeedButton;
    lbRcv: TLabel;
    lbSend: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure MsgOutKeyPress(Sender: TObject; var Key: Char);
    procedure doHistory(Sender: TObject);
    procedure doProfile(Sender: TObject);
    procedure doAddToRoster(Sender: TObject);
    procedure lblJIDClick(Sender: TObject);
    procedure mnuReturnsClick(Sender: TObject);
    procedure mnuSendFileClick(Sender: TObject);
    procedure imgStatusPaint(Sender: TObject);
    procedure timFlashTimer(Sender: TObject);
    procedure MsgOutChange(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure CTCPClick(Sender: TObject);
    procedure mnuBlockClick(Sender: TObject);
    procedure FormEndDock(Sender, Target: TObject; X, Y: Integer);
    procedure mnuSaveClick(Sender: TObject);
    procedure mnuOnTopClick(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure popClearHistoryClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    // procedure timMemoryTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure mnuWordwrapClick(Sender: TObject);
    procedure btnCloseMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure NotificationOptions1Click(Sender: TObject);
    procedure timBusyTimer(Sender: TObject);
    procedure mnuViewRightClick(Sender: TObject);
    procedure VideoButtonClick(Sender: TObject);
    procedure AudioButtonClick(Sender: TObject);
    procedure VideoCapVideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
    procedure ACMWaveIn1Data(data: Pointer; size: Integer);
    procedure N12Click(Sender: TObject);
    procedure RxSliderquantChange(Sender: TObject);
    procedure VideoCapStatusCallback(Sender: TObject; nID: Integer;
      status: String);
    procedure R1Click(Sender: TObject);
    procedure N4Click(Sender: TObject);
    procedure Powerpoint1Click(Sender: TObject);
    procedure W1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ACMWaveOut1Done(Sender: TObject);
    procedure TrackBarSpkChange(Sender: TObject);
    procedure TrackBarMicChange(Sender: TObject);
    procedure changeCapture(Sender: TObject);
    procedure FormConstrainedResize(Sender: TObject; var MinWidth,
      MinHeight, MaxWidth, MaxHeight: Integer);
    procedure changeDisplay(Sender: TObject);
  private
    { Private declarations }
    jid: widestring; // jid of the person we are talking to
    _jid: TJabberID; // JID object of jid
    _pcallback: integer; // Presence Callback
    _scallback: integer; // Session callback
    _thread: string; // thread for conversation
    _pres_img: integer; // current index of the presence image
    _msg_out: boolean;

    // Stuff for composing events
    _flash_ticks: integer;
    _cur_img: integer;
    _old_img: integer;
    _old_hint: string;
    _last_id: string;
    _reply_id: string;
    _check_event: boolean;
    _send_composing: boolean;
    _warn_busyclose: boolean;

    _destroying: boolean;
    _redock: boolean;
    _VideoWidth: Word;
    _VideoHeight: Word;
    _LocalVideoWidth: Word;
    _LocalVideoHeight: Word;

    haveVideo: boolean;
    haveAudio: boolean;

    // custom notification options to use..
    _notify: array[0..3] of integer;

    MicControlID: Cardinal;
    SpkControlID: Cardinal;
    hmx: HMixer;
    _VolChanging: Boolean;

    _AudioTask: TAnyQBaseUDPTask;
    _VideoTask: TAnyQBaseUDPTask;
    _Ppttask: TAnyQBaseUDPTask;


    _ReadAudioData : Boolean;
    _AudioSize : Integer;
    _ReadAudioSize : Integer;
    _AudioData : array of byte;

    _ReadVideoData : Boolean;
    _VideoSize : Integer;
    _ReadVideoSize : Integer;
    _VideoData : array of byte;
    _StopVideoing: Boolean;

    procedure AudioUdpRcv(sender: TObject; Adata: TStream);
    procedure AudioUdpRcvStatus(sender: TObject);
    procedure AudioUdpFail(sender: TObject);
    procedure AudioUdpTimeout(Sender: TObject);

    procedure VideoUdpRcv(sender: TObject; Adata: TStream);
    procedure VideoUdpRcvStatus(sender: TObject);
    procedure VideoUdpFail(sender: TObject);
    procedure VideoUdpTimeout(Sender: TObject);

    procedure SetupPrefs();
    procedure ChangePresImage(show: widestring; status: widestring);
    procedure ResetPresImage;
    procedure freeChatObject();
    procedure _sendMsg(txt: Widestring);

    function GetThread: string;
    procedure InitAudioMixer;
    procedure InitVolValue;

    procedure WMMmMixmControlChange(var Message: TMessage); message MM_MIXM_CONTROL_CHANGE;
    procedure WMMmMixmLineChange(var Message: TMessage); message MM_MIXM_LINE_CHANGE;
    procedure WMPLAYAUDIO(var msg: TMessage); message WM_AnyQPLAYAUDIO;

    function DisplayMode: TDisplayMode;
    function CaptureMode: TCaptureMode;
  published
    procedure PresCallback(event: string; tag: TXMLTag);
    procedure SessionCallback(event: string; tag: TXMLTag);
    procedure CTCPCallback(event: string; tag: TXMLTag);
    procedure VideoCallback(event: string; tag: TXMLTag);
    procedure AudioCallback(event: string; tag: TXMLTag);
  public
    { Public declarations }
    _pptForm: TCustomForm;
    _webForm: TCustomForm;
    IsVCaller: Boolean;
    IsACaller: Boolean;
    IspptCaller: Boolean;

    OtherNick: widestring;
    chat_object: TChatController;
    reqID: widestring;
    TaskID: TGUID;

    procedure PlayQueue();
    procedure MessageEvent(tag: TXMLTag);
    procedure showMsg(tag: TXMLTag);
    procedure showPres(tag: TXMLTag);
    procedure sendMsg; override;
    procedure sendAutoReplyMsg(txt: widestring; rtf: string);
    procedure SetJID(cjid: widestring);
    procedure AcceptFiles(var msg: TWMDropFiles); message WM_DROPFILES;
    procedure DockForm; override;
    procedure FloatForm; override;

    procedure pluginMenuClick(Sender: TObject); override;

    property getJid: Widestring read jid;
    property redock: boolean read _redock;

    procedure SendVideoRequest;
    procedure SendAudioRequest;
    procedure SendVideoStop;
    procedure SendAudioStop;

    procedure StartAudio; overload;
    procedure StartVideo; overload;
    procedure StartAudio(url: widestring); overload;
    procedure StartVideo(url: widestring); overload;
    procedure StopAudio;
    procedure StopVideo;
    procedure StartMyVideo;
    procedure StopMyAudio;

  end;

var
  frmChat: TfrmChat;

function StartChat(sjid, resource: widestring; show_window: boolean; chat_nick: widestring = ''): TfrmChat;
procedure StartAudioChat(sjid: widestring); overload;
procedure StartVideoChat(sjid: widestring); overload;

procedure StartAudioChat(task: TAnyQBaseUDPTask; sjid, ID: widestring; hosts: TStringList); overload;
procedure StartVideoChat(task: TAnyQBaseUDPTask; sjid, ID: widestring; hosts: TStringList); overload;

procedure StartpptChat(task: TAnyQBaseUDPTask; sjid, ID: widestring;
    hosts: TStringList; fileName: widestring; fileSize: Int64);
procedure StartwebChat(sjid, ID: widestring; webid: TGuid);


procedure StartAudioChat(sjid, url, ID: widestring); overload;
procedure StartVideoChat(sjid, url, ID: widestring); overload;

procedure StopVideoChat(sjid: widestring);
procedure StopAudioChat(sjid: widestring);

procedure CloseAllChats;

resourcestring
  sReplying = ' 正在回复...';
  sChatActivity = '对话活动: ';
  sUserBlocked = '该用户已经被阻止。';
  sIsNow = '已经';
  sAvailable = '联机';
  sOffline = '脱机';
  sCloseBusy = '这个聊天窗口正忙. 强制关闭吗?';

implementation

{$R *.dfm}

uses
  CustomNotify, COMChatController, Debug, ExEvents, FileCtrl,
  JabberConst, ExSession, ExUtils, Presence, PrefController, Room,
  Transfer, RosterAdd, RiserWindow, Notify,
  Jabber1, Profile, MsgDisplay, IQ, math,
  JabberMsg, Roster, Session, XMLUtils,
  ShellAPI, RosterWindow, Emoticons, msghistory, AnyQV, g729, whiteboard,
  pptConsole, frmwebbrowse;

const
  PCMFOMAT: tWAVEFORMATEX =
  (wFormatTag: WAVE_FORMAT_PCM;
    nChannels: 1;
    nSamplesPerSec: 8000;
    nAvgBytesPerSec: 16000;
    nBlockAlign: 2;
    wBitsPerSample: 16;
    cbSize: 0;
    );

const
  BI_I420 = $30323449;
  BI_I420l = $30323469;
  BI_YUY2 = $32595559;
  BI_YUY2l = $32797579;

var
  VideoInited: Boolean; // 视频是否初始化
  VideoTaskID: TGUID;
  AudioTaskID: TGUID;
  IncludeAudio: Boolean; // 是否包含音频
  Skip: Integer;
  KeyFlag: boolean;

  AudioBuf: array[0..3000 - 1] of Byte; //缓存3S的声音数据，超过则抛弃
  AudioSize: Integer;
  AudioDecBuf: array[0..3 * 16000 - 1] of Byte;

procedure pcmFindPeak(pwfx: PWaveFormatEx; pSrc: PChar; dwSrcLen: Integer;
  var PeakL, PeakR: SmallInt);
var
  SrcNumBytes, sd: Longint;
  pL, pR, sw: Smallint;
begin
  PeakL := 0;
  PeakR := 0;
  pR := 0;
  pL := 0;
  if pwfx^.wBitsperSample = 8 then
  begin
    if pwfx^.nChannels = 2 then
    begin
      SrcNumBytes := dwSrcLen and not 1;
      while (SrcNumBytes > 0) do
      begin
            { the left channel }
        sw := PByte(pSrc)^ - 128;
        if abs(sw) > pL then
        begin
          PeakL := sw;
          pL := Min(abs(sw), 127);
        end;

            { the right channel }
        sw := PByte(pSrc + 1)^ - 128;
        if abs(sw) > pR then
        begin
          PeakR := sw;
          pR := Min(abs(sw), 127);
        end;

        inc(pSrc, 2 * sizeOf(Byte));
        dec(SrcNumBytes, 2 * sizeOf(Byte));
      end;
      PeakL := PeakL + 128;
      PeakR := PeakR + 128;
    end
    else
    begin
      SrcNumBytes := dwSrcLen;
      while (SrcNumBytes > 0) do
      begin
            { we have only one channel }
        sw := PByte(pSrc)^ - 128;
        if abs(sw) > pL then
        begin
          PeakL := sw;
          pL := Min(abs(sw), 127);
        end;

        inc(pSrc, sizeOf(Byte));
        dec(SrcNumBytes, sizeOf(Byte));
      end;
      PeakL := PeakL + 128;
      PeakR := PeakL;
    end;
  end
  else
  begin
    if pwfx^.nChannels = 2 then
    begin
      SrcNumBytes := dwSrcLen and not 3;
      while (SrcNumBytes > 0) do
      begin
            { the left channel }
        sd := PSmallint(pSrc)^;
        if abs(sd) > pL then
        begin
          PeakL := sd;
          pL := Min(abs(sd), 32767);
        end;

            { the right channel }
        sd := PSmallint(pSrc + 2)^;
        if abs(sd) > pR then
        begin
          PeakR := sd;
          pR := Min(abs(sd), 32767);
        end;

        inc(pSrc, 2 * sizeOf(SmallInt));
        dec(SrcNumBytes, 2 * sizeOf(SmallInt));
      end;
    end
    else
    begin
      SrcNumBytes := dwSrcLen and not 1;
      while (SrcNumBytes > 0) do
      begin
            { we have only one channel }
        sd := PSmallint(pSrc)^;
        if abs(sd) > pL then
        begin
          PeakL := sd;
          pL := Min(abs(sd), 32767);
        end;

        inc(pSrc, sizeOf(SmallInt));
        dec(SrcNumBytes, sizeOf(SmallInt));
      end;
      PeakR := PeakL;
    end;
  end;
end;

procedure StopAudioChat(sjid: widestring);
var
  chat: TChatController;
begin
  // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    StopAudio;
    AudioButton.Down := false;
  end;
end;

procedure StopVideoChat(sjid: widestring);
var
  chat: TChatController;
begin
  // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    StopVideo;
    VideoButton.Down := false;
  end;
end;

{---------------------------------------}

procedure StartAudioChat(sjid: widestring);
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    AudioButton.Down := true;
    AudioButton.Click;
  end;
end;

procedure StartAudioChat(task: TAnyQBaseUDPTask; sjid, ID: widestring; hosts: TStringList); overload;
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;


  with TfrmChat(chat.window) do begin
    IsACaller := false;
    _AudioTask := task;
    _AudioTask.OnRcvData := AudioUdpRcv;
    _AudioTask.OnRcvStatus := AudioUdpRcvStatus;
    _AudioTask.OnTimeOut := AudioUdpTimeout;
    _AudioTask.OnFail := AudioUdpFail;
    _AudioTask.NoCheck := true;
    AudioTaskID := _AudioTask.TaskID;

    ReqID := ID;
    _AudioTask.Connect(hosts);
//    StartAudio(url);
  end;     {}
end;

procedure StartAudioChat(sjid, url, ID: widestring);
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    ReqID := ID;
    StartAudio(url);
  end;
end;
{---------------------------------------}

procedure StartVideoChat(sjid: widestring);
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
  // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    VideoButton.Down := true;
    VideoButton.Click;
  end;
end;

procedure StartVideoChat(task: TAnyQBaseUDPTask; sjid, ID: widestring; hosts: TStringList); overload;
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    IsVCaller := false;
    _VideoTask := task;
    _VideoTask.OnRcvData := VideoUdpRcv;
    _VideoTask.OnRcvStatus := VideoUdpRcvStatus;
    _VideoTask.OnTimeOut := VideoUdpTimeout;
    _VideoTask.OnFail := VideoUdpFail;
    _VideoTask.NoCheck := true;

    ReqID := ID;
    _VideoTask.Connect(hosts);
//    StartVideo(url);
  end;             {}
end;

procedure StartpptChat(task: TAnyQBaseUDPTask; sjid, ID: widestring;
    hosts: TStringList; fileName: widestring; fileSize: Int64);
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  starrcvtppt(task, fileName, fileSize, TfrmChat(chat.window), Sjid, hosts);
end;

procedure StartwebChat(sjid, ID: widestring; webid: TGuid);
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  starrcvtBrows(webid, TfrmChat(chat.window), Sjid);
end;

procedure StartVideoChat(sjid, url, ID: widestring);
var
  chat: TChatController;
begin
  StartChat(sjid, '', true);
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, '', '');
  if chat = nil then
    exit;
  if chat.Window = nil then exit;

  with TfrmChat(chat.window) do begin
    ReqID := ID;
    StartVideo(url);
  end;
end;

{---------------------------------------}

function StartChat(sjid, resource: widestring; show_window: boolean; chat_nick: widestring = ''): TfrmChat;
var
  r, m: integer;
  chat: TChatController;
  win: TfrmChat;
  tmp_jid: TJabberID;
  cjid: widestring;
  ritem: TJabberRosterItem;
  new_chat: boolean;
  do_scroll: boolean;
  hist: string;
begin
    // either show an existing chat or start one.
  chat := MainSession.ChatList.FindChat(sjid, resource, '');
  new_chat := false;
  do_scroll := false;

    // If we have an existing chat, we may just want to raise it
    // or redock it, etc...
  r := MainSession.Prefs.getInt(P_CHAT);
  m := MainSession.Prefs.getInt('chat_memory');

  if (((r = msg_existing_chat) or (m > 0)) and (chat <> nil)) then begin
    win := TfrmChat(chat.window);
    if (win <> nil) then begin
      if ((win.Docked) or (win.Redock)) then begin
        if (not win.Visible) then
          win.ShowDefault()
        else if (win.TabSheet <> nil) then
          frmAnyQ.Tabs.ActivePage := win.TabSheet;
      end
      else
        win.ShowDefault();
      Result := win;
      exit;
    end;
  end;

    // Create a new chat controller if we don't have one
  if chat = nil then begin
    chat := MainSession.ChatList.AddChat(sjid, resource);
    new_chat := true;
  end;

    // Create a window if we don't have one.
  if (chat.window = nil) then begin
    win := TfrmChat.Create(Application);
    chat.Window := win;
    chat.stopTimer();
    win.chat_object := chat;
    hist := TrimRight(chat.getHistory());
    if (hist <> '') then with win.MsgList do begin
            // repopulate history..
        InputFormat := ifRTF;
        SelStart := 0;
        SelLength := Length(Lines.Text);
        RTFSelText := hist;
        InputFormat := ifUnicode;

            // always remove the last line..
        Lines.Delete(Lines.Count - 1);
        do_scroll := true;
      end;
    ExCOMController.fireNewChat(sjid, TAnyQChat(chat.ComController));
    new_chat := false;
  end;

    // Setup the properties of the window,
    // and hook it up to the chat controller.
  with TfrmChat(chat.window) do begin
    tmp_jid := TJabberID.Create(sjid);
    if (chat_nick = '') then begin
      ritem := MainSession.roster.Find(sjid);
      if (ritem = nil) then begin
                // If not in our roster, check for a TC room
        if (IsRoom(sjid)) then
          chat_nick := FindRoomNick(sjid + '/' + resource);

        if (chat_nick = '') then
          OtherNick := tmp_jid.user
        else
          OtherNick := chat_nick;
      end
      else
        OtherNick := ritem.Nickname;
    end
    else
      OtherNick := chat_nick;

    if resource <> '' then
      cjid := sjid + '/' + resource
    else
      cjid := sjid;
    tmp_jid.Free;
    SetJID(cjid);

    chat.OnMessage := MessageEvent;

        // handle setting position for this window
    if (not MainSession.Prefs.RestorePosition(TfrmChat(chat.window),
      MungeName(Caption))) then
      Position := poDefaultPosOnly;

    ShowDefault();
    Activate;
    BringToFront;
    if ((show_window) and (Application.Active)) then begin
      Show();
      if (TfrmChat(chat.window).Visible) then
        TfrmChat(chat.window).SetFocus();
    end;

    PlayQueue();

        // scroll to the bottom..
    if (do_scroll) then
      _scrollBottom();
  end;

  if (new_chat) then
    ExCOMController.fireNewChat(sjid, TAnyQChat(chat.ComController));

  Result := TfrmChat(chat.window);
end;

{---------------------------------------}

procedure CloseAllChats;
var
  i: integer;
  c: TChatController;
begin
  with MainSession.ChatList do begin
    for i := Count - 1 downto 0 do begin
      c := TChatController(Objects[i]);
      if c <> nil then begin
        if c.window <> nil then
          TfrmChat(c.window).chat_object := nil;
        TfrmChat(c.window).Free();
      end;
      c.Free;
      Delete(i);
    end;
  end;
end;

{---------------------------------------}

procedure TfrmChat.FormCreate(Sender: TObject);
var
  bh: tagBITMAPINFOHEADER;
begin
  _VideoWidth := 320;
  _VideoHeight := 240;
  _LocalVideoWidth := 320;
  _LocalVideoHeight := 240;
  _StopVideoing := False;

  bh.biSize := Sizeof(tagBITMAPINFOHEADER);
  bh.biPlanes := 1;
  bh.biWidth := 320;
  bh.biHeight := 240;
  bh.biCompression := BI_RGB;
  bh.biSizeImage := 320 * 240 * 3;
  bh.biBitCount := 24;
  bh.biXPelsPerMeter := 0;
  bh.biYPelsPerMeter := 0;
  bh.biClrUsed := 0;
  bh.biClrImportant := 0;
  VideoDisp.BitMapInfoHeader := bh;

  ACMWaveIn1.Visible := false;
  ACMWaveOut1.Visible := false;
  AudioSize := 0;

  Skip := 0;
  SetupPrefs();

  inherited;
  haveVideo := false;
  haveAudio := false;
  pnlRight.Align := alRight;

  _thread := '';
  _pcallback := -1;
  _scallback := -1;
  OtherNick := '';
  _pres_img := ico_Unknown;
  _check_event := false;
  _last_id := '';
  _reply_id := '';
  _msg_out := false;
  _jid := nil;
  _destroying := false;
  _redock := false;

  reqID := '';
    {
        _notify[0]  := getInt('notify_online');
        _notify[1]  := getInt('notify_offline');
        _notify[2]  := getInt('notify_newchat');
        _notify[3]  := getInt('notify_normalmsg');
        _notify[4]  := getInt('notify_s10n');
        _notify[5]  := getInt('notify_invite');
        _notify[6]  := getInt('notify_keyword');
        _notify[7]  := getInt('notify_chatactivity');
        _notify[8]  := getInt('notify_roomactivity');
        _notify[9]  := getInt('notify_oob');
        _notify[10] := getInt('notify_autoresponse');
    }

  _notify[0] := MainSession.Prefs.getInt('notify_chatactivity');

  if (MainSession.Profile.ConnectionType = conn_normal) then
    DragAcceptFiles(Handle, True);

  mnuSendFile.Enabled := (MainSession.Profile.ConnectionType = conn_normal);


  InitAudioMixer;
  InitVolValue;
end;

{---------------------------------------}

procedure TfrmChat.SetupPrefs();
begin
  AssignDefaultFont(MsgList.Font);
  lblJID.Font.Color := clBlue;
  lblJID.Font.Style := [fsUnderline];

    // setup prefs
  MsgList.Color := TColor(MainSession.Prefs.getInt('color_bg'));
  MsgOut.Color := MsgList.Color;
  MsgOut.Font.Assign(MsgList.Font);
  MsgOut.DefAttributes.Name := MsgOut.Font.Name;
  MsgOut.DefAttributes.Size := MsgOut.Font.Size;
  MsgOut.DefAttributes.Style := MsgOut.Font.Style;
  MsgOut.SelAttributes.Name := MsgOut.Font.Name;
  MsgOut.SelAttributes.Size := MsgOut.Font.Size;
  MsgOut.SelAttributes.Style := MsgOut.Font.Style;

  _embed_returns := MainSession.Prefs.getBool('embed_returns');
  _wrap_input := MainSession.Prefs.getBool('wrap_input');
  _warn_busyclose := MainSession.Prefs.getBool('warn_closebusy');
  mnuReturns.Checked := _embed_returns;
  mnuWordwrap.Checked := _wrap_input;
  mnuReturns1.Checked := _embed_returns;
  mnuWordwrap1.Checked := _wrap_input;
  MsgOut.WantReturns := _embed_returns;
  MsgOut.WordWrap := _wrap_input;
end;


{---------------------------------------}

procedure TfrmChat.SetJID(cjid: widestring);
var
  ritem: TJabberRosterItem;
  p: TJabberPres;
  i: integer;
begin
  jid := cjid;
  if (_jid <> nil) then _jid.Free();

  _jid := TJabberID.Create(cjid);

    // setup the callbacks if we don't have them already
  if (_pcallback = -1) then
    _pcallback := MainSession.RegisterCallback(PresCallback,
      '/packet/presence[@from="' + Lowercase(cjid) + '*"]');

  if (_scallback = -1) then
    _scallback := MainSession.RegisterCallback(SessionCallback, '/session');


    // setup the captions, etc..
  ritem := MainSession.Roster.Find(_jid.jid);
  p := MainSession.ppdb.FindPres(_jid.jid, _jid.resource);

  if ritem <> nil then begin
    lblNick.Caption := ' ' + ritem.Nickname + ' ';
    Caption := ritem.Nickname + ' - ' + sChat;
    lblJID.Caption := '<' + _jid.full + '>';
    if (p = nil) then
      ChangePresImage('offline', 'offline')
    else
      ChangePresImage(p.show, p.status);
  end

  else begin
    lblNick.Caption := ' ';
    lblJID.Caption := cjid;
    if OtherNick <> '' then
      Caption := OtherNick + ' - ' + sChat
    else
      Caption := _jid.user + ' - ' + sChat;
    if (p = nil) then
      ChangePresImage('unknown', 'Unknown Presence')
    else
      ChangePresImage(p.show, p.status);
  end;

    // synchronize the session chat list with this JID
  i := MainSession.ChatList.indexOfObject(chat_object);
  if (i >= 0) then
    MainSession.ChatList[i] := cjid;
end;

{---------------------------------------}

function TfrmChat.GetThread: string;
var
  seed: string;
begin
  if _thread <> '' then exit;

  seed := FormatDateTime('MMDDYYYYHHMM', now);
  seed := seed + jid + MainSession.Username + MainSession.Server;

    // hash the seed to get the thread
  _thread := Sha1Hash(seed);
  Result := _thread;
end;

{---------------------------------------}

procedure TfrmChat.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Action := caFree;
  inherited;
end;

{---------------------------------------}

procedure TfrmChat.PlayQueue();
var
  t: TXMLTag;
begin
    // pull all of the msgs from the controller queue,
    // and feed them into this window
  if (chat_object = nil) then exit;

  while (chat_object.msg_queue.AtLeast(1)) do begin
    t := TXMLTag(chat_object.msg_queue.Pop());
    Self.MessageEvent(t);
  end;
end;

{---------------------------------------}

procedure TfrmChat.MessageEvent(tag: TXMLTag);
var
  xml, body: Widestring;
  msg_type, from_jid: WideString;
  etag, tagThread: TXMLTag;
begin
    // callback for messages
    // check for a jabber:x:event tag
  msg_type := tag.GetAttribute('type');
  from_jid := tag.getAttribute('from');

  if from_jid <> jid then begin
    chat_object.SetJID(from_jid);
    SetJID(from_jid);
  end;

  if (_check_event) then begin
        // check for composing events
    etag := tag.QueryXPTag(XP_MSGXEVENT);
    if ((etag <> nil) and (etag.GetFirstTag('composing') <> nil)) then begin
            // we got a composing a message
      if (etag.GetBasicText('id') = _last_id) then begin
        _flash_ticks := 0;

                // Setup the cache'd old versions in ChangePresImage
        _cur_img := _pres_img;
        imgStatus.Hint := OtherNick + sReplying;
        timFlashTimer(Self);
        timFlash.Enabled := true;

                {
                should we really bail here??
                Gabber sends type=chat for msg events so it'll get into the
                next block of code anyways. If we don't bail,
                then we'll have to check to see if we have a body in the
                next block of code. ICK
                }

        exit;
      end
      else if ((etag.GetFirstTag('id') <> nil) and
        (timFlash.Enabled)) then begin
        Self.ResetPresImage();
      end;
    end;
  end;

    // process the msg
  etag := tag.QueryXPTag(XP_MSGCOMPOSING);
  _send_composing := (etag <> nil);
  if (_send_composing) then
    _reply_id := tag.GetAttribute('id');

    // plugin
  xml := tag.xml();
  body := tag.GetBasicText('body');
  TAnyQChat(chat_object.ComController).fireRecvMsg(body, xml);

    // make sure we are visible..
  if (not visible) then begin
    ShowDefault();
  end;

  showMsg(tag);
  if _thread = '' then begin
        // cache thread from message
    tagThread := tag.GetFirstTag('thread');
    if tagThread <> nil then
      _thread := tagThread.Data;
  end;
  TAnyQChat(chat_object.ComController).fireAfterRecvMsg(body, xml);
end;

{---------------------------------------}

procedure TfrmChat.showMsg(tag: TXMLTag);
var
  m, etag: TXMLTag;
  subj_msg, msg: TJabberMessage;
begin
    // display the body of the msg
  if (timFlash.Enabled) then
    Self.ResetPresImage();

  if (_warn_busyclose) then begin
    timBusy.Enabled := false;
    timBusy.Enabled := true;
  end;

  _check_event := false;

  Msg := TJabberMessage.Create(tag);
  Msg.Nick := OtherNick;
  Msg.IsMe := false;

  if not msg.broadcast then
  begin
      // only display + notify if we have something to display :)
    if (Msg.Subject <> '') then begin
      subj_msg := TJabberMessage.Create(tag);
      subj_msg.Body := '主题被更改为: ' + subj_msg.Subject;
      subj_msg.Subject := '';
      subj_msg.Nick := '';
      DisplayMsg(subj_msg, MsgList, TmpEdit);
      subj_msg.Free();
    end;
  end;

  if ((Msg.Body <> '') or (Msg.rtf <> '')) then begin
    DoNotify(Self, _notify[0], sChatActivity + OtherNick, ico_user, 'notify_chatactivity');

    if msg.broadcast then
      DisplayBroadcastMsg(Msg, MsgList, TmpEdit)
    else
      DisplayMsg(Msg, MsgList, TmpEdit);

        // log if we want..
    if (MainSession.Prefs.getBool('log')) then
      LogMsg(GetMsgLogText(msg));
            //LogMessage(Msg);

        // check for displayed events
    etag := tag.QueryXPTag(XP_MSGXEVENT);
    if ((etag <> nil) and (etag.GetFirstTag('id') = nil)) then begin
      if (etag.GetFirstTag('displayed') <> nil) then begin
                // send back a displayed event
        m := generateEventMsg(tag, 'displayed');
        MainSession.SendTag(m);
      end;
    end;
  end;

  Msg.Free();
end;

procedure TfrmChat._sendMsg(txt: Widestring);
var
  xml: WideString;
  msg: TJabberMessage;
  mtag: TXMLTag;
  function IsOnline: boolean;
  var
    tmp_id: TJabberID;
    pri: TJabberPres;
  begin
    Result := True;
    tmp_id := TJabberID.Create(Jid);
    if (tmp_id.resource = '') then begin
      pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
      if (pri = nil) then begin
        Result := False;
        exit;
      end;
    end;
    tmp_id.Free;
  end;
begin
    // plugin madness
  if (chat_object <> nil) then
    TAnyQChat(chat_object.ComController).fireBeforeMsg(txt);

  if (txt = '') then exit;

  if smsButton.Down then
  begin
    if not IsOnline then
    begin
      frmAnyQ.sendsms(Jid, Txt);
    end;
  end;

  if _thread = '' then begin //get thread from message
    _thread := GetThread;
  end;

    // send the msg
  msg := TJabberMessage.Create(jid, 'chat', Trim(txt), '');
  msg.thread := _thread;
  msg.nick := MainSession.Username;
  msg.isMe := true;

  MsgList.SetFocus;
  MsgOut.SetFocus;
    //add rtf
  MsgOut.SelStart := 0;
  MsgOut.SelLength := Length(txt);
  Msg.rtf := MsgOut.RTFSelText;
    //add by doublewood
  MsgOut.SelLength := 0;

  _last_id := MainSession.generateID();
  _check_event := true;
  msg.id := _last_id;

  mtag := msg.Tag;
  with mtag.AddTag('x') do begin
    setAttribute('xmlns', XMLNS_XEVENT);
    AddTag('composing');
  end;

    // additional plugin madness
  if (chat_object <> nil) then
    xml := TAnyQChat(chat_object.ComController).fireAfterMsg(txt);
  if (xml <> '') then
    mtag.addInsertedXML(xml);
  MainSession.SendTag(mtag);
  DisplayMsg(Msg, MsgList, TmpEdit);

    // log the msg
  if (MainSession.Prefs.getBool('log')) then
    LogMsg(GetMsgLogText(msg));
//        LogMessage(Msg);

  Msg.Free();
end;

{---------------------------------------}

procedure TfrmChat.SendMsg;
var
  txt: Widestring;
begin
    // Send the actual message out
  txt := getInputText(MsgOut);
  _sendMsg(txt);

  inherited;
end;

{---------------------------------------}

procedure TfrmChat.MsgOutKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key = #0) then exit;
  if (chat_object = nil) then exit;

    // dispatch key-presses to Plugins
  TAnyQChat(chat_object.ComController).fireMsgKeyPress(Key);

  inherited;
end;

{---------------------------------------}

procedure TfrmChat.SessionCallback(event: string; tag: TXMLTag);
begin
  if (event = '/session/disconnected') then begin
    DisplayPresence(sDisconnected, MsgList);
    MsgOut.Enabled := False;
    spbtnSend.Enabled := False;
    ToolBar1.Enabled := False;

    MainSession.UnRegisterCallback(_pcallback);
    _pcallback := -1;

        // this should make sure that hidden windows
        // just go away when we get disconnected.
    if (not Visible) then
      Self.Free();
  end
  else if (event = '/session/connected') then begin
    Self.SetJID(jid);
    MsgOut.Enabled := True;
    spbtnSend.Enabled := True;
    ToolBar1.Enabled := True;
  end
  else if (event = '/session/prefs') then
    SetupPrefs()
  else if (event = '/session/block') then begin
        // if this jid just got blocked, just close the window.
    if (_jid.jid = tag.GetAttribute('jid')) then begin
      DisplayPresence(sUserBlocked, Self.MsgList);
      MainSession.UnRegisterCallback(_pcallback);
      _pcallback := -1;
      freeChatObject();
    end;
  end;
end;

{---------------------------------------}

procedure TfrmChat.PresCallback(event: string; tag: TXMLTag);
begin
    // display some presence packet
  if Event = 'xml' then
    showPres(tag);
end;

{---------------------------------------}

procedure TfrmChat.ChangePresImage(show: WideString; status: WideString);
begin
    // Change the bulb
  if (show = 'offline') then
    _pres_img := ico_Offline
  else if (show = 'unknown') then
    _pres_img := ico_Unknown
  else if (show = 'away') then
    _pres_img := ico_Away
  else if (show = 'xa') then
    _pres_img := ico_XA
  else if (show = 'dnd') then
    _pres_img := ico_DND
  else if (show = 'chat') then
    _pres_img := ico_Chat
  else
    _pres_img := ico_Online;

  if (status = '') then
    imgStatus.Hint := show
  else
    imgStatus.Hint := status;

  _old_img := _pres_img;
  _old_hint := imgStatus.Hint;

  Self.imgStatusPaint(Self);
end;

{---------------------------------------}

procedure TfrmChat.showPres(tag: TXMLTag);
var
  txt: WideString;
  status, show, User: string;
  p: TJabberPres;
  j: TJabberID;
begin
    // Get the user
  user := tag.GetAttribute('from');

    //check to see if this is the person you are chatting with...
  if pos(jid, user) = 0 then Exit;

    // make sure the user is still connected
  j := TJabberID.Create(jid);
  p := MainSession.ppdb.FindPres(j.jid, j.resource);
  j.Free();
  if (p = nil) then begin
    show := sOffline;
    status := sOffline;
  end
  else begin
    show := tag.GetBasicText('show');
    status := tag.GetBasicText('status');
  end;

  ChangePresImage(show, status);
  if (status = '') then
    txt := show
  else
    txt := status;

  if (txt = '') then
    txt := sAvailable;

  if (MainSession.Prefs.getBool('timestamp')) then
    txt := '[' + formatdatetime(MainSession.Prefs.getString('timestamp_format'), now) + '] ' +
      jid + ' ' + sIsNow + ' ' + txt
  else
    txt := jid + ' ' + sIsNow + ' ' + txt;

  DisplayPresence(txt, MsgList);
end;

{---------------------------------------}

procedure TfrmChat.doHistory(Sender: TObject);
begin
  inherited;
  ShowMsgHistory(_jid.jid);
end;

{---------------------------------------}

procedure TfrmChat.doProfile(Sender: TObject);
begin
  inherited;
  ShowProfile(_jid.jid);
end;

{---------------------------------------}

procedure TfrmChat.doAddToRoster(Sender: TObject);
var
  ritem: TJabberRosterItem;
  add: TfrmAdd;
begin
  inherited;
    // check to see if we're already subscribed...
  ritem := MainSession.roster.find(_jid.jid);
  if ((ritem <> nil) and ((ritem.subscription = 'both') or (ritem.subscription = 'to'))) then begin
    ShowRiserWindow(nil, sAlreadySubscribed, ico_info);
//        MessageBox(Handle,Pchar(sAlreadySubscribed),'信息',MB_OK or MB_ICONINFORMATION);
    exit;
  end
  else begin
    add := ShowAddContact();
    add.txtJID.Text := _jid.jid;
    add.txtNickname.Text := _jid.user;
  end;

end;

{---------------------------------------}

procedure TfrmChat.lblJIDClick(Sender: TObject);
var
  cp: TPoint;
begin
  inherited;
  GetCursorPos(cp);
  popContact.popup(cp.x, cp.y);
end;

{---------------------------------------}

procedure TfrmChat.mnuReturnsClick(Sender: TObject);
begin
  inherited;
  mnuReturns.Checked := not mnuReturns.Checked;
  mnuReturns1.Checked := mnuReturns.Checked;
  MsgOut.WantReturns := mnuReturns.Checked;
  _embed_returns := mnuReturns.Checked;
  MainSession.Prefs.setBool('embed_returns', _embed_returns);
end;

{---------------------------------------}

procedure TfrmChat.mnuWordwrapClick(Sender: TObject);
begin
  inherited;
  mnuWordwrap.Checked := not mnuWordWrap.Checked;
  mnuWordwrap1.Checked :=  mnuWordWrap.Checked;
  _wrap_input := mnuWordwrap.Checked;
  MsgOut.WordWrap := _wrap_input;
  MainSession.Prefs.setBool('wrap_input', _wrap_input);
end;

{---------------------------------------}

procedure TfrmChat.mnuSendFileClick(Sender: TObject);
begin
  inherited;
  FileSend(_jid.full);
end;

{---------------------------------------}

procedure TfrmChat.imgStatusPaint(Sender: TObject);
begin
  inherited;
    // repaint
  frmAnyQ.ImgLst24b.Draw(imgStatus.Canvas, 1, 1, _pres_img);
end;

{---------------------------------------}

procedure TfrmChat.ResetPresImage;
begin
    // turn off flashing of the presence icon
  timFlash.Enabled := false;
  _pres_img := _old_img;
  imgStatus.Hint := _old_hint;
  imgStatus.Repaint();
  imgStatus.Refresh();
end;

{---------------------------------------}

procedure TfrmChat.timFlashTimer(Sender: TObject);
begin
  inherited;
    // Flash the presence image for 30 seconds..
  inc(_flash_ticks);
  if (_cur_img = _old_img) then begin
    _cur_img := _old_img + 33;
    if (_cur_img > 38) then _cur_img := 38;
  end
  else
    _cur_img := _old_img;

  _pres_img := _cur_img;
  imgStatus.Refresh();
  imgStatus.Repaint();

  if (_flash_ticks >= 60) then
    resetPresImage();
end;

{---------------------------------------}

procedure TfrmChat.MsgOutChange(Sender: TObject);
var
  c: TXMLTag;
begin
  inherited;
  if (_send_composing) then begin
    _send_composing := false;
    c := TXMLTag.Create('message');
    with c do begin
      setAttribute('to', jid);
      with AddTag('x') do begin
        setAttribute('xmlns', XMLNS_XEVENT);
        AddTag('composing');
        AddBasicTag('id', _reply_id);
      end;
    end;
    MainSession.SendTag(c);
  end;
end;

{---------------------------------------}

procedure TfrmChat.AcceptFiles(var msg: TWMDropFiles);
const
  cnMaxFileNameLen = 255;
var
  i,
    nCount: integer;
  acFileName: array[0..cnMaxFileNameLen] of char;
begin
    // find out how many files we're accepting
  nCount := DragQueryFile(msg.Drop, $FFFFFFFF, acFileName, cnMaxFileNameLen);

    // query Windows one at a time for the file name
  for i := 0 to nCount - 1 do begin
    DragQueryFile(msg.Drop, i, acFileName, cnMaxFileNameLen);
        // do your thing with the acFileName
    FileSend(_jid.full, acFileName);
  end;

    // let Windows know that you're done
  DragFinish(msg.Drop);
end;

{---------------------------------------}

procedure TfrmChat.freeChatObject();
var
  idx: integer;
begin
  if (chat_object = nil) then exit;
  idx := MainSession.ChatList.IndexOfObject(chat_object);
  if (idx >= 0) then
    MainSession.ChatList.Delete(idx);
  FreeAndNil(chat_object);
end;

{---------------------------------------}

procedure TfrmChat.FormDestroy(Sender: TObject);
begin
  if VideoInited then
  begin
    StopVideo;
  end;
  
  if assigned(_AudioTask) then
    FreeAndNil(_AudioTask);
  if assigned(_VideoTask) then
    FreeAndNil(_VideoTask);
{
    if VideoChat=self then
    begin
      if haveVideo then
        StopVideo;

      VideoChat := nil;
      haveVideo := false;
      haveAudio := false;

      VACConnected := false;
      VACManager.ReHost;
    end;
{}
    // Unregister the callbacks + stuff
  if (MainSession <> nil) then begin
    MainSession.UnRegisterCallback(_pcallback);
    MainSession.UnRegisterCallback(_scallback);
  end;

  if (chat_object <> nil) then
    freeChatObject();

  if (_jid <> nil) then
    FreeAndNil(_jid);

  DragAcceptFiles(Handle, false);

  mixerClose(hmx);
  inherited;
end;

{---------------------------------------}

procedure TfrmChat.CTCPClick(Sender: TObject);
var
  jid: WideString;
  p: TJabberPres;
begin
    // get some CTCP query sent out
  p := MainSession.ppdb.FindPres(_jid.jid, '');
  if p = nil then
        // this person isn't online.
    jid := _jid.jid
  else
    jid := p.fromJID.full;

  if Sender = mnuVersionRequest then
    jabberSendCTCP(jid, XMLNS_VERSION, CTCPCallback)
  else if Sender = mnuTimeRequest then
    jabberSendCTCP(jid, XMLNS_TIME, CTCPCallback)
  else if Sender = mnuLastActivity then
    jabberSendCTCP(jid, XMLNS_LAST, CTCPCallback);
end;

{---------------------------------------}

procedure TfrmChat.CTCPCallback(event: string; tag: TXMLTag);
var
  from: WideString;
  s: WideString;
  ns: WideString;
  qtag: TXMLTag;
  tmp_tag: TXMLTag;
  msg: WideString;
  procedure DispString(str: WideString);
  var
    subj_msg: TJabberMessage;
  begin
    subj_msg := TJabberMessage.Create();
    subj_msg.Body := str;
    subj_msg.Subject := '';
    subj_msg.Nick := '';
    DisplayMsg(subj_msg, MsgList, TmpEdit);
    subj_msg.Free();
  end;
begin
    // record some kind of CTCP result
  if ((tag <> nil) and (tag.getAttribute('type') = 'result')) then begin
    from := tag.getAttribute('from');

    ns := tag.Namespace(true);
    if ns = XMLNS_TIME then begin
      qTag := tag.getFirstTag('query');
      msg := sMsgTime;

      tmp_tag := qtag.getFirstTag('display');
      if (tmp_tag <> nil) then
        msg := msg + #13 + sMsgLocalTime + tmp_tag.Data;
      s := tag.GetAttribute('iq_elapsed_time');
      if (s <> '') then
        msg := msg + #13 + Format(sMsgPing, [s]);
      DispString(msg);
    end

    else if ns = XMLNS_VERSION then begin
      qTag := tag.getFirstTag('query');
      tmp_tag := qtag.getFirstTag('name');
      msg := sMsgVersion + #13 + sMsgVerClient + tmp_tag.Data + #13;

      tmp_tag := qtag.getFirstTag('version');
      msg := msg + sMsgVerVersion + tmp_tag.Data + #13;

      tmp_tag := qtag.getFirstTag('os');
      DispString(msg + sMsgVerOS + tmp_tag.Data);
    end

    else if ns = XMLNS_LAST then begin
      qTag := tag.getFirstTag('query');
      DispString(sMsgLastInfo + secsToDuration(qTag.getAttribute('seconds')) + '.');
    end;

  end;
end;

{---------------------------------------}

procedure TfrmChat.mnuBlockClick(Sender: TObject);
begin
  MainSession.Block(_jid);
  freeChatObject();
end;

{---------------------------------------}

procedure TfrmChat.DockForm;
begin
  inherited;
  btnClose.Visible := true;
  DragAcceptFiles(Handle, False);
end;

{---------------------------------------}

procedure TfrmChat.FloatForm;
begin
  inherited;
  btnClose.Visible := false;
  DragAcceptFiles(Handle, True);
end;

{---------------------------------------}

procedure TfrmChat.FormEndDock(Sender, Target: TObject; X, Y: Integer);
begin
  inherited;
  btnClose.Visible := Docked;
  if ((Docked) and (TabSheet <> nil)) then Self.TabSheet.ImageIndex := -1;
  DragAcceptFiles(Handle, not Docked);

    // scroll the MsgView to the bottom.
  _scrollBottom();
  Self.Refresh();
end;

{---------------------------------------}

procedure TfrmChat.mnuSaveClick(Sender: TObject);
begin
  inherited;
    // save the conversation as RTF
  if SaveDialog1.Execute then begin
    MsgList.PlainRTF := false;
    MsgList.WideLines.SaveToFile(SaveDialog1.Filename);
  end;
end;

{---------------------------------------}

procedure TfrmChat.mnuOnTopClick(Sender: TObject);
begin
  inherited;
  mnuOnTop.Checked := not mnuOnTop.Checked;

  if (mnuOnTop.Checked) then
    Self.FormStyle := fsStayOnTop
  else
    Self.FormStyle := fsNormal;
end;

{---------------------------------------}

procedure TfrmChat.FormResize(Sender: TObject);
begin
  inherited;
    // make the close btn be right justified..
  btnClose.Left := Panel1.Width - btnClose.Width - 2;
  pnlJID.Width := Panel1.Width - btnClose.Width - 5;
end;

{---------------------------------------}

procedure TfrmChat.btnCloseClick(Sender: TObject);
begin
  Self.Close();
end;

{---------------------------------------}

procedure TfrmChat.popClearHistoryClick(Sender: TObject);
begin
  inherited;
  ClearLog(Self._jid.jid)
end;

{---------------------------------------}

procedure TfrmChat.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
  s: string;
  tmpjid: TJabberID;
begin
  if ((_warn_busyclose) and
    ((timBusy.Enabled) or (timFlash.Enabled))) then begin
    if MessageBox(handle, Pchar(sCloseBusy), '确认', MB_YESNO
      or MB_ICONQUESTION) = mrNo then begin
      CanClose := false;
      exit;
    end;
  end;

  tmpjid := TJabberID.Create(jid);
  LogMessages(tmpjid.jid, Historys);
  tmpjid.Free;

  if _pptForm <> nil then
  begin
    if not (csDestroying in _pptForm.ComponentState) then
      TfrmPPT(_pptForm).tbClose.Click;
  end;

  if _WebForm <> nil then
  begin
    if not (csDestroying in _WebForm.ComponentState) then
      TfrmPPT(_WebForm).Close;
  end;

{
    if ((MainSession.Prefs.getInt('chat_memory') > 0) and
        (MainSession.Prefs.getInt(P_CHAT) = msg_existing_chat) and
        (MsgList.Lines.Count > 0) and
        (chat_object <> nil) and
        (not _destroying)) then begin
        MsgList.Visible := false;
        MsgList.SelectAll();
        s := MsgList.RTFSelText;
        chat_object.SetHistory(s);
        chat_object.unassignEvent();
        chat_object.startTimer();
        chat_object.window := nil;
        chat_object := nil;
    end;
 {}//rem by doublewood; 去掉历史记忆功能，当对话关闭时，不再保留对话记录。 2003-8-7


  Hide;
  if mnuViewRight.Checked then
  begin
    mnuViewRight.Checked := false;
    mnuViewRightClick(mnuViewRight);
  end;
  inherited;
end;

{---------------------------------------}

procedure TfrmChat.FormShow(Sender: TObject);
begin
  inherited;
end;

{---------------------------------------}

procedure TfrmChat.FormActivate(Sender: TObject);
begin
  inherited;
  if (_redock) then _redock := false;
end;

{---------------------------------------}

procedure TfrmChat.btnCloseMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  _destroying := (ssCtrl in Shift);
end;

{---------------------------------------}

procedure TfrmChat.NotificationOptions1Click(Sender: TObject);
var
  f: TfrmCustomNotify;
begin
    // change notification options..
  f := TfrmCustomNotify.Create(Application);

  f.addItem('Chat activity');
  f.setVal(0, _notify[0]);
  if (f.ShowModal) = mrOK then begin
    _notify[0] := f.getVal(0);
  end;

  f.Free();
end;

{---------------------------------------}

procedure TfrmChat.timBusyTimer(Sender: TObject);
begin
  inherited;
  timBusy.Enabled := false;
end;

{---------------------------------------}

procedure TfrmChat.pluginMenuClick(Sender: TObject);
begin
  if (chat_object <> nil) then
    TAnyQChat(chat_object.ComController).fireMenuClick(Sender);
end;


procedure TfrmChat.mnuViewRightClick(Sender: TObject);
begin
  inherited;
  if mnuViewRight.Checked then
  begin
    Width := Width + pnlRight.Width;
    pnlRight.Visible := mnuViewRight.Checked;
  end
  else
  begin
    pnlRight.Visible := mnuViewRight.Checked;
    Width := Width - pnlRight.Width;
  end;
end;

procedure TfrmChat.VideoButtonClick(Sender: TObject);
var
  selfproc: TIdServerThreadEvent;
  tmp_id: TJabberID;
  pri: TJabberPres;

  procedure initVideo;
  var
    bh: tagBITMAPINFOHEADER;
  begin
    try
      VideoCap.DriverIndex := MainSession.Prefs.getInt('CamDriver');
      VideoCap.VideoPreview := false;
      VideoCap.DriverOpen := true;
      bh := VideoCap.BitMapInfoHeader;
      bh.biWidth := VideoCap.Width;
      bh.biHeight := VideoCap.Height;
      bh.biSizeImage := bh.biWidth * bh.biHeight * bh.biBitCount div 8;
      VideoCap.BitMapInfoHeader := bh;

      bh.biWidth := VideoDisp.Width;
      bh.biHeight := VideoDisp.Height;
      bh.biCompression := BI_RGB;
      bh.biSizeImage := bh.biWidth * bh.biHeight * 3;
      bh.biBitCount := 24;
      VideoDisp.BitMapInfoHeader := bh;

      VideoCap.VideoPreview := true;
      VideoCap.StartCapture;
      VideoCap.visible := true;
      VideoDisp.visible := true;
      KeyFlag := true;
      VideoInited := true;
    except
      UninitCode;
      VideoInited := false;
      ShowRiserWindow(nil, '初始化视频设备失败，设备可能已被占用!', ico_info);
      VideoButton.Down := false;
      abort;
    end;
  end;
begin
  //是否是要停止视频？
  if not VideoButton.Down then
  begin
    if VideoInited then
      StopVideo;
    exit;
  end;

  tmp_id := TJabberID.Create(Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行视频对话', ico_info);
      if haveVideo then
        StopVideo;
      haveVideo := false;
      VideoButton.Down := false;
      exit;
    end;
  end;
  tmp_id.Free;

  if not mnuViewRight.Checked then
    mnuViewRight.Click;

  //开始视频
  if VideoInited and not IsEqualGUID(VideoTaskID,_VideoTask.TaskID) then
  begin
    ShowRiserWindow(nil, '同时只能与一个联系人进行音视频对话!', ico_info);
    VideoButton.Down := false;
    Exit;
  end;

  if IncludeAudio then
  begin
{    selfproc := self.IdTCPServerVExecute;
    if not ((Addr(frmAnyQ.IdTCPServerV.OnExecute) = Addr(selfproc)) or
      (ClientHandleThread.chat = self)) then
    begin
      ShowRiserWindow(nil, '同时只能与一个联系人进行音视频对话!', ico_info);
      VideoButton.Down := false;
      Exit;
    end; {}
  end;

  try
    _VideoWidth := 352;
    _VideoHeight := 288;
    _LocalVideoWidth := 352;
    _LocalVideoHeight := 288;
    initVideo;
  except
  end;

  if not CodeInited then
    if not InitCode(VideoCap.BitMapInfoHeader.biWidth,
        VideoCap.BitMapInfoHeader.biHeight) then
    begin
      ShowRiserWindow(nil, '无法初始化视频处理库!', ico_info);
      VideoButton.Down := false;
      Exit;
    end;


{  if not assigned(frmAnyQ.IdTCPServerV.OnExecute) and (ClientHandleThread = nil) then
  begin
    frmAnyQ.IdTCPServerV.OnExecute := IdTCPServerVExecute;
    frmAnyQ.IdTCPServerV.Active := true;
  end; {}

  SendVideoRequest;
  inherited; {}
end;

procedure TfrmChat.AudioButtonClick(Sender: TObject);
var
  selfproc: TIdServerThreadEvent;
  tmp_id: TJabberID;
  pri: TJabberPres;
begin
  //是否是要停止音频？
  if not AudioButton.Down then
  begin
    if IncludeAudio then
      StopAudio;
    exit;
  end;

  tmp_id := TJabberID.Create(Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行音频对话', ico_info);
      if IncludeAudio then
        StopAudio;
      IncludeAudio := false;
      AudioButton.Down := false;
      exit;
    end;
  end;
  tmp_id.Free;

  if not mnuViewRight.Checked then
    mnuViewRight.Click;

  if IncludeAudio  and not IsEqualGUID(AudioTaskID,_AudioTask.TaskID) then
  begin
{    selfproc := self.IdTCPServerVExecute;
    if not ((Addr(frmAnyQ.IdTCPServerV.OnExecute) = Addr(selfproc)) or
      (ClientHandleThread.chat = self)) then
    begin
      ShowRiserWindow(nil, '同时只能与一个联系人进行音视频对话!', ico_info);
      VideoButton.Down := false;
      Exit;
    end;{}
  end;

  try
    ACMWaveIn1.Open(@PCMFOMAT, MainSession.Prefs.getInt('WavInDriver'));
    ACMWaveOut1.Open(@PCMFOMAT, MainSession.Prefs.getInt('WavOutDriver'));
    ACMWaveOut1.Tag := 0;
  except
    ShowRiserWindow(nil, '无法初始化音频设备!', ico_info);
    AudioButton.Down := false;
    Exit;
  end;

{  if not assigned(frmAnyQ.IdTCPServerV.OnExecute) and (ClientHandleThread = nil) then
  begin
    frmAnyQ.IdTCPServerV.OnExecute := IdTCPServerVExecute;
    frmAnyQ.IdTCPServerV.Active := true;
  end; {}

  AudioSize := 0;
  IncludeAudio := true;
  SendAudioRequest;
  inherited; {}
end;

procedure TfrmChat.SendAudioRequest;
var
  iq: TJabberIQ;
  myip: Widestring;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  taskguid: TGUID;
  hosts : TStringList;
  i: integer;
begin
  IsACaller := true;
  myip := MainSession.Stream.LocalIP;
  if (myip = '') then begin
    ShowRiserWindow(nil, sNetMeetingConnError, ico_info);
    exit;
  end;

  tmp_id := TJabberID.Create(Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行语音对话', ico_info);
      if haveAudio then
        StopAudio;
      haveAudio := false;
      AudioButton.Down := false;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := Jid;
  tmp_id.Free;

//  TaskID := taskguid;

  try
    if _AudioTask= nil then
    begin
      CreateGUID(taskguid);
      _AudioTask := TAnyQBaseUDPTask.Create(UDPController, taskguid);
    end;
    _AudioTask.NoCheck := True;
    _AudioTask.OnRcvData := AudioUdpRcv;
    _AudioTask.OnRcvStatus := AudioUdpRcvStatus;
    _AudioTask.OnTimeOut := AudioUdpTimeout;
    _AudioTask.OnFail := AudioUdpFail;
    AudioTaskID := _AudioTask.TaskID;
//    _AudioTask.ISAV := true;
    hosts := TStringList.Create;
    UDPController.GetUDPInfo(hosts);

    iq := TJabberIQ.Create(MainSession, MainSession.generateID, AudioCallback, 300);
    with iq do begin
      Namespace := XMLNS_AnyQUDP;
      iqType := 'set';
      toJid := tmps;
      qTag.AddBasicTag('taskid', GUIDToString(_AudioTask.TaskID));
      qTag.AddBasicTag('type', 'audio');
      qTag.AddBasicTag('sync', 'false');
      for i:= 0 to hosts.Count-1 do
        qTag.AddBasicTag('host', hosts[i]);
      Send;
    end;
    hosts.Free;
  except
    ShowRiserWindow(nil, '无法进行语音对话', ico_info);
    if Assigned(_AudioTask) then
      FreeAndNil(_AudioTask);
    AudioButton.Down := false;
//    InitIBB;
  end; {}
end;
{var
  myip: Widestring;
  iq, q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
begin
    // ok, we have our menu item..
  myip := MainSession.Stream.LocalIP;
  if (myip = '') then begin
    ShowRiserWindow(nil, sNetMeetingConnError, ico_info);
//        Messagebox(handle, Pchar(sNetMeetingConnError), '错误', MB_OK or MB_ICONERROR);
    exit;
  end;

  tmp_id := TJabberID.Create(_Jid.full);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行语音对话', ico_info);
//            MessageBox(Handle, Pchar(sXferOnline), '错误', MB_OK or MB_ICONERROR);
      if haveAudio then
        StopAudio;
      haveAudio := false;
      AudioButton.Down := false;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := _Jid.full;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', tmps);
  iq.setAttribute('type', 'set');

  q := iq.AddTag('query');
  q.setAttribute('xmlns', 'jabber:iq:oob');

  q.AddBasicTag('url', 'audioto:' + myip);
  q.AddBasicTag('desc', '请求语音对话');

  MainSession.SendTag(iq);
  tmp_id.Free;
end;{}

procedure TfrmChat.SendVideoRequest;
var
  iq: TJabberIQ;
  myip: Widestring;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  taskguid: TGUID;
  hosts : TStringList;
  i: integer;
begin
  IsVCaller := true;
  myip := MainSession.Stream.LocalIP;
  if (myip = '') then begin
    ShowRiserWindow(nil, sNetMeetingConnError, ico_info);
    exit;
  end;

  tmp_id := TJabberID.Create(Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行视频对话', ico_info);
      if haveVideo then
        StopVideo;
      haveVideo := false;
      VideoButton.Down := false;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := Jid;
  tmp_id.Free;

//  TaskID := taskguid;

  try
    if _VideoTask=nil then
    begin
      CreateGUID(taskguid);
      _VideoTask := TAnyQBaseUDPTask.Create(UDPController, taskguid);
    end;
    _VideoTask.NoCheck := true;
    _VideoTask.OnRcvData := VideoUdpRcv;
    _VideoTask.OnRcvStatus := VideoUdpRcvStatus;
    _VideoTask.OnTimeOut := VideoUdpTimeout;
    _VideoTask.OnFail := VideoUdpFail;
//    _VideoTask.ISAV := true;
    VideoTaskID := _VideoTask.TaskID;
    hosts := TStringList.Create;
    UDPController.GetUDPInfo(hosts);

    iq := TJabberIQ.Create(MainSession, MainSession.generateID, VideoCallback, 300);
    with iq do begin
      Namespace := XMLNS_AnyQUDP;
      iqType := 'set';
      toJid := tmps;
      qTag.AddBasicTag('taskid', GUIDToString(_VideoTask.TaskID));
      qTag.AddBasicTag('type', 'video');
      qTag.AddBasicTag('sync', 'false');
      for i:= 0 to hosts.Count-1 do
        qTag.AddBasicTag('host', hosts[i]);
      Send;
    end;
    hosts.Free;
  except
    ShowRiserWindow(nil, '无法进行视频对话', ico_info);
    if Assigned(_videoTask) then
      FreeAndNil(_videoTask);
    VideoButton.Down := false;
//    InitIBB;
  end;    {}
end;
{var
  iq: TJabberIQ;
  myip: Widestring;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
begin
  myip := MainSession.Stream.LocalIP;
  if (myip = '') then begin
    ShowRiserWindow(nil, sNetMeetingConnError, ico_info);
    exit;
  end;

  tmp_id := TJabberID.Create(_Jid.full);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行视频对话', ico_info);
      if haveVideo then
        StopVideo;
      haveVideo := false;
      VideoButton.Down := false;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := _Jid.full;

  iq := TJabberIQ.Create(MainSession, MainSession.generateID, VideoCallback, 300);
  with iq do begin
    Namespace := XMLNS_IQOOB;
    iqType := 'set';
    toJid := tmps;
    qTag.AddBasicTag('url', 'videoto:' + myip);
    qTag.AddBasicTag('desc', '请求视频对话');
    Send();
  end;
  tmp_id.Free;{}

procedure TfrmChat.AudioUdpRcv(sender: TObject; Adata: TStream);
var
  Buf: array of Byte;
  decsize: integer;
  i: integer;
  PeakL, PeakR: Smallint;
begin
  if Adata.Size <= sizeof(TAnyQUDPHead) then
    exit;
  AData.Seek(0,0);

  if not _ReadAudioData then
  begin
    if Adata.Size >= sizeof(_AudioSize) then
    begin
      Adata.Read(_AudioSize, sizeof(_AudioSize));
      SetLength(_AudioData, _AudioSize);
      _ReadAudioSize := Adata.Read(_AudioData[0], _AudioSize);
      _ReadAudioData := _AudioSize > _ReadAudioSize;
      if not _ReadAudioData then
        if IncludeAudio and (_AudioSize > 0) then
        begin
          for i := 0 to (_AudioSize div 10) - 1 do
            va_g729a_decoder(pchar(@_AudioData[0]) + I * 10, pchar(@AudioDecBuf) + i * 160, 0);
          pcmFindPeak(@PCMFOMAT, @AudioDecBuf, _AudioSize * 16, PeakL, PeakR);
          TrackBarSpk.SelStart := 32767-ABS(PeakL);
          if ACMWaveOut1.Tag < 10 then
          begin
            ACMWaveOut1.PlayBack(@AudioDecBuf, _AudioSize * 16);
            ACMWaveOut1.Tag := ACMWaveOut1.Tag + 1;
          end;
        end;
    end;
  end
  else
  begin
    if _ReadAudioSize + Adata.Size <= _AudioSize then
      Adata.Read(_AudioData[_ReadAudioSize], Adata.Size);
    _ReadAudioSize := _ReadAudioSize + Adata.Size;
    if _ReadAudioSize>= _AudioSize then
    begin
      _ReadAudioData := false;
      if _ReadAudioSize > _AudioSize then
        exit;
      if IncludeAudio and (_AudioSize > 0) then
      begin
        for i := 0 to (_AudioSize div 10) - 1 do
          va_g729a_decoder(pchar(@_AudioData[0]) + I * 10, pchar(@AudioDecBuf) + i * 160, 0);
        pcmFindPeak(@PCMFOMAT, @AudioDecBuf, _AudioSize * 16, PeakL, PeakR);
        TrackBarSpk.SelStart := 32767-ABS(PeakL);
        if ACMWaveOut1.Tag < 10 then
        begin
          ACMWaveOut1.PlayBack(@AudioDecBuf, _AudioSize * 16);
          ACMWaveOut1.Tag := ACMWaveOut1.Tag + 1;
        end;
      end;
    end;
  end;
end;

procedure TfrmChat.VideoUdpRcv(sender: TObject; Adata: TStream);
var
  Buf: array of Byte;
  decsize: integer;
  DFRAM: xvid_dec_frame_t;
  Dimg_t: xvid_image_t;
  W,H,OldW: word;
  info: TBitmapInfoHeader;
//  infoSrc: TBitmapInfoHeader;
begin
  lbRcv.Caption := inttostr(AData.Size);
  if Adata.Size <= 0 then
    exit;
  AData.Seek(0,0);

  if not _ReadVideoData then
  begin
    if Adata.Size >= sizeof(_VideoSize) then
    begin
      Adata.Read(_VideoSize, sizeof(_VideoSize));
      Adata.Read(W,Sizeof(W));
      Adata.Read(H,Sizeof(H));
//      Caption := Inttostr(_VideoSize)+' '+Inttostr(W)+' '+Inttostr(H);
      if (W<>_VideoWidth) or (H<>_VideoHeight) then
      begin
        _VideoWidth := W;
        _VideoHeight := H;
        info := VideoDisp.BitMapInfoHeader;
        info.biWidth := W;
        info.biHeight := H;
        info.biSizeImage := W*H*info.biBitCount div 8;
        VideoDisp.BitMapInfoHeader := info;
        VideoDisp.Invalidate;
        Case DisplayMode of
          dmAuto: ;
          dmBig:
            begin
              W := 320;
              H := 240;
            end;
          dmSmall:
            begin
              W := 160;
              H := 120;
            end;
        end;

        pnlDisplay.Height := H+21;
        spbtnRBig.Top := H+1;
        spbtnRSmall.Top := H+1;
        spbtnRAuto.Top := H+1;
        lbSend.Top := H+4;
        lbRcv.Top := H+4;
        Imagespk.Left := W+1;
        TrackBarSpk.Left := W;
        VideoDisp.Width := W;
        VideoDisp.Height := H;
        ImageDisp.Width := W;
        ImageDisp.Height := H;
        OldW := pnlRight.Width;
        pnlRight.Width := Max(W, VideoCap.Width) +25;
        if Max(W, VideoCap.Width) +25 < OldW then
          Width := Width-(OldW-pnlRight.Width);
        if pnlCapture.Height+pnlDisplay.Height+8 > pnlRight.Height then
          ClientHeight := ClientHeight+(pnlCapture.Height+pnlDisplay.Height+8-pnlRight.Height);
      end;

      SetLength(_VideoData, _VideoSize);
      _ReadVideoSize := Adata.Read(_VideoData[0], _VideoSize);
      _ReadVideoData := _VideoSize > _ReadVideoSize;
      if not _ReadVideoData then
        if CodeInited and (_VideoSize > 0) then
        begin
          FillMemory(@Dimg_t, Sizeof(Dimg_t), 0);
          Dimg_t.csp := XVID_CSP_BGR or XVID_CSP_VFLIP;
          Dimg_t.plane[0] := @Decbuf[0];
          Dimg_t.stride[0] := _VideoWidth*3;

          FillMemory(@DFRAM, sizeof(DFRAM), 0);
          DFRAM.version := XVID_VERSION;
          DFRAM.general := XVID_LOWDELAY or XVID_DEBLOCKY or XVID_DEBLOCKUV;
          DFRAM.bitstream := @_VideoData[0];
          DFRAM.length := _VideoSize;
          DFRAM.output := Dimg_t;
          _VideoSize := 0;

          if not CodeInited then exit;
          if not assigned(VDecodeproc) then
            exit;
          try
            VDecodeproc(DECodehandle, XVID_DEC_DECODE, @DFRAM, nil);
            VideoDisp.DrawStream(@Decbuf[0], True);
{            begin
              info := VideoDisp.BitMapInfoHeader;
              info.biWidth := _VideoWidth;
              info.biHeight := _VideoHeight;
              info.biSizeImage := _VideoWidth*_VideoHeight*3;

              VideoDisp.DrawStreamEx((320-_VideoWidth) div 2, (240-_VideoHeight) div 2,
                  _VideoWidth, _VideoHeight, @Decbuf[0], info, True);
            end;{}
          except
            VideoDisp.Invalidate;
          end;
        end;
    end;
  end
  else
  begin
    if _ReadVideoSize + Adata.Size <= _VideoSize then
      Adata.Read(_VideoData[_ReadVideoSize], Adata.Size);
    _ReadVideoSize := _ReadVideoSize + Adata.Size;
    if _ReadVideoSize>= _VideoSize then
    begin
      _ReadVideoData := false;
      if _ReadVideoSize > _VideoSize then
        exit;
      if CodeInited and (_VideoSize > 0) then
      begin
        FillMemory(@Dimg_t, Sizeof(Dimg_t), 0);
        Dimg_t.csp := XVID_CSP_BGR or XVID_CSP_VFLIP;
        Dimg_t.plane[0] := @Decbuf[0];
        Dimg_t.stride[0] := _VideoWidth*3;

        FillMemory(@DFRAM, sizeof(DFRAM), 0);
        DFRAM.version := XVID_VERSION;
        DFRAM.general := XVID_LOWDELAY or XVID_DEBLOCKY or XVID_DEBLOCKUV;
        DFRAM.bitstream := @_VideoData[0];
        DFRAM.length := _VideoSize;
        DFRAM.output := Dimg_t;
        _VideoSize := 0;

        if not CodeInited then exit;
        if not assigned(VDecodeproc) then
          exit;
        try
          VDecodeproc(DECodehandle, XVID_DEC_DECODE, @DFRAM, nil);
          VideoDisp.DrawStream(@Decbuf[0], True);
{          info := VideoDisp.BitMapInfoHeader;
          info.biWidth := _VideoWidth;
          info.biHeight := _VideoHeight;
          info.biSizeImage := _VideoWidth*_VideoHeight*3;
          VideoDisp.DrawStreamEx((352-_VideoWidth) div 2, (288-_VideoHeight) div 2,
              _VideoWidth, _VideoHeight, @Decbuf[0], info, True);{}
        except
          VideoDisp.Invalidate;
        end;
      end;
    end;
  end;
end;

procedure TfrmChat.StartAudio(url: widestring);
var
  selfproc: TIdServerThreadEvent;
  iq, q: TXMLTag;
begin
{  if not mnuViewRight.Checked then
    mnuViewRight.Click;

  AudioButton.Down := true;

  if IncludeAudio then
  begin
    selfproc := self.IdTCPServerVExecute;
    if not ((Addr(frmAnyQ.IdTCPServerV.OnExecute) = Addr(selfproc)) or
      (ClientHandleThread.chat = self)) then
    begin
      ShowRiserWindow(nil, '同时只能与一个联系人进行音视频对话!', ico_info);
      AudioButton.Down := false;
      Exit;
    end;
  end;

  try
    ACMWaveIn1.Open(@PCMFOMAT,MainSession.Prefs.getInt('WavInDriver'));
    ACMWaveOut1.Open(@PCMFOMAT,MainSession.Prefs.getInt('WavOutDriver'));
    ACMWaveOut1.Tag := 0;
  except
    ShowRiserWindow(nil, '无法初始化音频设备!', ico_info);
    AudioButton.Down := false;
    Exit;
  end;

  if not assigned(frmAnyQ.IdTCPServerV.OnExecute) and (ClientHandleThread = nil) then
  begin
    frmAnyQ.IdTCPClientV.Host := copy(url, 9, length(url));
    frmAnyQ.IdTCPClientV.Connect(15000);

    ClientHandleThread := TClientHandleThread.Create(True);
    ClientHandleThread.chat := self;
    ClientHandleThread.FreeOnTerminate := True;
    ClientHandleThread.Resume;
  end;

  AudioSize := 0;
  IncludeAudio := true;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', _jid.full);
  iq.setAttribute('type', 'result');
  iq.setAttribute('id', reqID);
  MainSession.SendTag(iq);       {}
end;

procedure TfrmChat.StartVideo(url: widestring);
var
  iq, q: TXMLTag;

  procedure initVideo;
  var
    bh: tagBITMAPINFOHEADER;
  begin
    try
      VideoCap.DriverIndex := MainSession.Prefs.getInt('CamDriver');
      VideoCap.VideoPreview := false;
      VideoCap.DriverOpen := true;
      bh := VideoCap.BitMapInfoHeader;
      bh.biWidth := VideoCap.Width;
      bh.biHeight := VideoCap.Height;
      bh.biSizeImage := bh.biWidth * bh.biHeight * bh.biBitCount div 8;
      VideoCap.BitMapInfoHeader := bh;

      bh.biWidth := VideoDisp.Width;
      bh.biHeight := VideoDisp.Height;
      bh.biCompression := BI_RGB;
      bh.biSizeImage := bh.biWidth * bh.biHeight * 3;
      bh.biBitCount := 24;
      VideoDisp.BitMapInfoHeader := bh;

      VideoCap.VideoPreview := true;
      VideoCap.StartCapture;
      VideoCap.visible := true;
      VideoDisp.visible := true;
      KeyFlag := true;
      VideoInited := true;
      VideoTaskID := _VideoTask.TaskID;
    except
      UninitCode;
      VideoInited := false;
      ShowRiserWindow(nil, '初始化视频设备失败，设备可能已被占用!', ico_info);
      VideoButton.Down := false;
//      abort;
    end;
  end;
begin
  if not mnuViewRight.Checked then
    mnuViewRight.Click;

  VideoButton.Down := true;

  //开始视频
  if VideoInited  and IsEqualGUID(VideoTaskID,_VideoTask.TaskID) then
  begin
    ShowRiserWindow(nil, '同时只能与一个联系人进行视频对话!', ico_info);
    VideoButton.Down := false;
    Exit;
  end;

  try
    _VideoWidth := 352;
    _VideoHeight := 288;
    _LocalVideoWidth := 352;
    _LocalVideoHeight := 288;
    initVideo;
  except
  end;

  if not CodeInited then
    if not InitCode(VideoCap.BitMapInfoHeader.biWidth,
        VideoCap.BitMapInfoHeader.biHeight) then
    begin
      ShowRiserWindow(nil, '无法初始化视频处理库!', ico_info);
      VideoButton.Down := false;
      Exit;
    end;

  frmAnyQ.IdTCPClientV.Host := copy(url, 9, length(url));
  frmAnyQ.IdTCPClientV.Connect(15000);

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', _jid.full);
  iq.setAttribute('type', 'result');
  iq.setAttribute('id', reqID);
  MainSession.SendTag(iq);
end;


procedure TfrmChat.StartMyVideo;
//var
//	Msg					: TVACMessage;
begin
//  //发送请求(VAC)
//  if VACManager=nil then
//    exit;
//  if not havevideo then
//  begin
//    Msg.dwMsgId := MSGID_VIDEO_SESSION_START;
//    VACManager.SendTo(VACManager.PeerDPNID, @Msg, SizeOf(TVacMessage));
//    // Run graph
//    InitVideo;
//    VACManager.RunTransmissionGraph;
//    havevideo := true;
//  end;
end;

procedure TfrmChat.StopAudio;
begin
  if not IncludeAudio then exit;

  IncludeAudio := false;
  ACMWaveIn1.Close;
  ACMWaveOut1.Close;
  TrackBarSpk.SelStart := 32767;
  TrackBarMic.SelStart := 32767;

  if assigned(_AudioTask) then
    FreeAndNil(_AudioTask);

  if not VideoInited then
  begin

  end;

  AudioButton.Down := false;
  SendAudioStop;
end;

procedure TfrmChat.StopVideo;
begin
  if (not CodeInited) and (not VideoInited) then exit;

  _StopVideoing := True;
  if VideoCap.DriverOpen then
  begin
    VideoCap.DriverOpen := false;
    VideoCap.visible := false;
    VideoDisp.visible := false;
    VideoInited := false;
  end;
  _StopVideoing := False;

  if assigned(_VideoTask) then
    FreeAndNil(_VideoTask);

  if not IncludeAudio then
  begin
  end;

  VideoButton.Down := false;
  SendVideoStop;

  if CodeInited then
    UninitCode;
end;

procedure TfrmChat.InitAudioMixer;
var
  ML: TMixerLine;
  MLC: TMixerLineControls;
  P: PMixerControl;
  i, j, k: Integer;
  pp: Pchar;
begin
  for i := 0 to waveINGetNumDevs - 1 do
  begin
    ML.cbStruct := SizeOf(TMixerLine);
    mixerGetLineInfo(i, @ML, MIXER_OBJECTF_WAVEIN);
    for j := 0 to ML.cConnections - 1 do
    begin
      ml.dwSource := j;
      mixerGetLineInfo(i, @ML, MIXER_GETLINEINFOF_SOURCE);
      if ML.dwComponentType <> MIXERLINE_COMPONENTTYPE_SRC_MICROPHONE then
      begin
        continue;
      end;

      getmem(p, sizeof(TMixerControl) * Ml.cControls);
      Mlc.cbStruct := SizeOf(MLC);
      MLC.dwLineID := Ml.dwLineID;
      MLC.cbmxctrl := SizeOf(TMixerControl);
      MLC.cControls := Ml.cControls;
      MLC.pamxctrl := P;
      mixerGetLineControls(i, @MLC, MIXER_OBJECTF_WAVEIN);

      pp := Pointer(Mlc.pamxctrl);
      for k := 0 to ML.cControls - 1 do
      begin
        if PMixerControl(pp).Bounds.dwMaximum = 65535 then
        begin
          MicControlID := PMixerControl(pp).dwControlID;
          break;
        end;
        pp := pp + sizeof(TMixerControl);
      end;
      FreeMem(p);
    end;
  end;

  for i := 0 to waveOutGetNumDevs - 1 do
  begin
    ML.cbStruct := SizeOf(TMixerLine);
    mixerGetLineInfo(i, @ML, MIXER_OBJECTF_WAVEOUT);
    for j := 0 to ML.cConnections - 1 do
    begin
      ml.dwSource := j;
      mixerGetLineInfo(i, @ML, MIXER_GETLINEINFOF_DESTINATION);
      if ML.dwComponentType <> MIXERLINE_COMPONENTTYPE_DST_SPEAKERS then
      begin
        continue;
      end;

      getmem(p, sizeof(TMixerControl) * Ml.cControls);
      Mlc.cbStruct := SizeOf(MLC);
      MLC.dwLineID := Ml.dwLineID;
      MLC.cbmxctrl := SizeOf(TMixerControl);
      MLC.cControls := Ml.cControls;
      MLC.pamxctrl := P;
      mixerGetLineControls(i, @MLC, MIXER_OBJECTF_WAVEOUT);

      pp := Pointer(Mlc.pamxctrl);
      for k := 0 to ML.cControls - 1 do
      begin
        if PMixerControl(pp).Bounds.dwMaximum = 65535 then
        begin
          SPKControlID := PMixerControl(pp).dwControlID;
          break;
        end;
        pp := pp + sizeof(TMixerControl);
      end;
      FreeMem(p);
    end;
  end;

  mixerOpen(@hmx, 0, handle, 0, CALLBACK_WINDOW or MIXER_OBJECTF_MIXER);
end;

procedure TfrmChat.WMMmMixmControlChange(var Message: TMessage);
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  if (Message.LParam <> 1) and (Message.LParam <> MicControlID) then
    exit;
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := Message.LParam;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  d.paDetails := @R;
  if mixerGetControlDetails(Message.WParam, @D, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
  begin
    _VolChanging := True;
    if Message.LParam = SpkControlID then
      TrackBarSpk.Position := 32767-(R div 2)
    else
      TrackBarMic.Position := 32767-(R div 2);
    _VolChanging := False;
  end;
end;

procedure TfrmChat.WMMmMixmLineChange(var Message: TMessage);
begin

end;

procedure TfrmChat.InitVolValue;
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := SpkControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  d.paDetails := @R;
  if mixerGetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
  begin
    TrackBarSpk.Position := 32767-(R div 2);
  end;

  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := MicControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  d.paDetails := @R;
  if mixerGetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE) = MMSYSERR_NOERROR then
  begin
    TrackBarMic.Position := 32767-(R div 2);
  end;
end;

procedure TfrmChat.StopMyAudio;
begin
//  if not haveAudio then
//    exit;
//
//	VACManager.LeaveVoiceSession;
//	if VACVoiceHost then
//		VACManager.StopVoiceSession;
//  VACVoiceHost := false;
//  haveAudio := false;
end;

procedure TfrmChat.AudioCallback(event: string; tag: TXMLTag);
begin
  if self=nil then exit;
  if tag=nil then exit;
  if (tag.GetAttribute('type') = 'error') then
  begin
    with tag.GetFirstTag('error') do
    begin
      if GetAttribute('code') = '406' then
        ShowRiserWindow(nil, '对方拒绝与您进行语音对话！', ico_info)
      else
        ShowRiserWindow(nil, '对方无法与您进行语音对话！', ico_info);
      exit;
    end;
  end;

  if (tag.GetAttribute('type') = 'result') then
  begin
    //对方接受请求，进行处理
  end;
end;

procedure TfrmChat.VideoCallback(event: string; tag: TXMLTag);
var
  errtag: TXMLTag;
begin
  if self=nil then exit;
  if tag=nil then exit;
  if csDestroying in Self.ComponentState then
    exit;
  if ((event = 'xml') or (event = 'cache')) then begin
    if (tag.GetAttribute('type') = 'error') then
    begin
      errTag := tag.GetFirstTag('error');
      if errTag <> nil then
        with errTag do
        begin
          if GetAttribute('code') = '404' then
            ShowRiserWindow(nil, '对方无法与您进行视频对话！', ico_info)
          else
            if GetAttribute('code') = '406' then
              ShowRiserWindow(nil, '对方拒绝与您进行视频对话！', ico_info)
            else
              ShowRiserWindow(nil, '对方无法与您进行视频对话！', ico_info);

          StopVideo;
          VideoButton.Down := false;
          exit;
        end;
    end;

    if (tag.GetAttribute('type') = 'result') then
    begin
      //对方接受请求，进行处理
    end;
  end
  else
  begin
    //超时或者其他错误;
    ShowRiserWindow(nil, '对方超过五分钟没有响应请求，请求自动取消！', ico_info);
     StopVideo;
    VideoButton.Down := false;
    exit;
  end;
end;

procedure TfrmChat.SendAudioStop;
var
  iq, q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
begin
  tmp_id := TJabberID.Create(_Jid.full);
  if (tmp_id.resource = '') then
  begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then
      exit;
    tmps := pri.fromJID.full;
  end
  else
    tmps := _Jid.full;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', tmps);
  iq.setAttribute('type', 'set');

  q := iq.AddTag('query');
  q.setAttribute('xmlns', 'jabber:iq:oob');

  q.AddBasicTag('url', 'audiostop');
  q.AddBasicTag('desc', '终止音频对话');

  MainSession.SendTag(iq);
end;

procedure TfrmChat.SendVideoStop;
var
  iq, q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
begin
  tmp_id := TJabberID.Create(_Jid.full);
  if (tmp_id.resource = '') then
  begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then
      exit;
    tmps := pri.fromJID.full;
  end
  else
    tmps := _Jid.full;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', tmps);
  iq.setAttribute('type', 'set');

  q := iq.AddTag('query');
  q.setAttribute('xmlns', 'jabber:iq:oob');

  q.AddBasicTag('url', 'videostop');
  q.AddBasicTag('desc', '终止视频对话');

  MainSession.SendTag(iq);
end;

procedure TfrmChat.VideoCapVideoStream(sender: TObject; lpVhdr: PVIDEOHDR);
var
  FRAME: xvid_enc_frame_t;
  Eimg_t : xvid_image_t;
  i: Integer;
  List: TList;
  Buf: array of Byte;
  info:TBitmapInfoHeader;
//  infosrc:TBitmapInfoHeader;
  W,H: Word;
//  DFRAM: XVID_DEC_FRAME;
begin
  if not CodeInited then
    exit;

//  info:= VideoDisp.BitMapInfoHeader;
//  infosrc:= VideoCap.BitMapInfoHeader;
  info:= VideoCap.BitMapInfoHeader;
  Case CaptureMode of
    cmBig: ;
    cmSmall: ;
  end;
  W := Info.biWidth;
  H := Info.biHeight;
{  Info.biWidth := W;
  Info.biHeight := H;
  Info.biSizeImage := W*H*3;
{  if RxSliderVideoSize.Value in [1,3] then
    StretchDIB(@Info,@tmpBuf[0], 0, 0,
      W, H,@infosrc, lpVhdr.lpData, 0, 48, 320, 240)
  else
    StretchDIB(@Info,@tmpBuf[0], 0, 0,
      W, H,@infosrc, lpVhdr.lpData, 0, 0, infosrc.biWidth,infosrc.biHeight);
{}
//  if Skip < 15 - RxSliderskip.Value then
//  begin
//    Skip := Skip + 1;
//    exit;
//  end;
//  Skip := 0;
//
  if (W<>_LocalVideoWidth) or (H<>_LocalVideoHeight) then
  begin
    _LocalVideoWidth := W;
    _LocalVideoHeight := H;
    InitEnCode(_LocalVideoWidth, _LocalVideoHeight);
    KeyFlag := True;
  end;

  if _VideoTask.Sending then
  begin
//    Caption := 'W';
    VideoCap.Tag := VideoCap.Tag+1;
    if VideoCap.Tag>90 then
    begin
      KeyFlag := True;
      VideoCap.Tag := 0;
//      Caption := 'S';
    end;
  end
  else
  begin
    VideoCap.Tag := 0;
//    Caption := 'S';
  end;

  if Assigned(_VideoTask) and (VideoCap.Tag = 0) and (_VideoTask.Status<>'connecting') and (_VideoTask.Status<>'') then
  begin
    VideoCap.Tag := 0;

    FillMemory(@Eimg_t, Sizeof(Eimg_t), 0);
    case info.biCompression of
      BI_RGB:
        begin
          Eimg_t.csp := XVID_CSP_BGR or XVID_CSP_VFLIP;
          Eimg_t.stride[0] := _LocalVideoWidth*3;
        end;
      BI_I420, BI_I420l:
        begin
          Eimg_t.csp := XVID_CSP_I420;
          Eimg_t.stride[0] := _LocalVideoWidth;
        end;
      BI_YUY2, BI_YUY2l:
        begin
          Eimg_t.csp := XVID_CSP_YUY2;
          Eimg_t.stride[0] := _LocalVideoWidth*2;
        end;
    end;
    Eimg_t.plane[0] := lpVhdr.lpData; //@tmpBuf[0];

    FillMemory(@FRAME, sizeof(FRAME), 0);
    FRAME.version := XVID_VERSION;
    FRAME.vol_flags := XVID_VOL_QUARTERPEL;
    FRAME.vop_flags := XVID_VOP_HALFPEL or XVID_VOP_CHROMAOPT or XVID_VOP_TRELLISQUANT; //or XVID_VOP_DEBUG;
    FRAME.quant_intra_matrix := nil;
    FRAME.quant_inter_matrix := nil;
    FRAME.motion := XVID_ME_QUARTERPELREFINE16 or XVID_ME_CHROMA_BVOP;
    FRAME.input := Eimg_t;
    FRAME._type := XVID_TYPE_AUTO;
    FRAME.bitstream := @outbuf[0];

    if KeyFlag then
      //确保第一帧是关键帧，这样对方才能够立即显示出图象
      FRAME._type := 1;

    FRAME.quant := 13 - TrackBarquant.Position;
    FRAME.length := 0;
    if not assigned(Vencodeproc) then exit;
    try
      FRAME.length := Vencodeproc(ENCodehandle, XVID_ENC_ENCODE, @FRAME, nil);
//      Application.Title := Inttostr(FRAME.intra);
    except
      KeyFlag := true;
      exit;
    end;
  //  CurFRAMESize := FRAME.length;
//    SpeedButton1.Caption := inttostr(FRAME.length);
    if CodeInited then
    begin
      setlength(Buf, sizeof(FRAME.length)+FRAME.length+4);
      Move(FRAME.length, BUF[0], sizeof(FRAME.length));
      Move(W, BUF[sizeof(FRAME.length)], Sizeof(W));
      Move(H, BUF[sizeof(FRAME.length)+2], Sizeof(H));
      Move(outbuf[0], BUF[sizeof(FRAME.length)+4], FRAME.length);
      if FRAME.length>0 then
      begin
        _VideoTask.SendData(BUF[0], sizeof(FRAME.length)+FRAME.length+4);
//        Caption := _VideoTask._CurHost+':'+inttostr(_VideoTask._CurPort);
        KeyFlag := false;
        lbSend.Caption := inttostr(sizeof(FRAME.length)+FRAME.length+4);
      end;
    end;
  end;
{
  if not _LocalVideoBig then
  begin
    info:= VideoDispSmall.BitMapInfoHeader;
    infosrc:= VideoCap.BitMapInfoHeader;
    Case RxSliderVideoSize.Value of
      1: begin
          W := 128;
          H := 96;
        end;
      2: begin
          W := 176;
          H := 144;
        end;
      3: begin
          W := 176;
          H := 144;
        end;
      4: begin
          W := 176;
          H := 144;
        end;
    end;
    Info.biWidth := W;
    Info.biHeight := H;
    Info.biSizeImage := W*H*3;
    if RxSliderVideoSize.Value in [1,3] then
      StretchDIB(@Info,@tmpBuf[0], 0, 0,
        W, H, @infosrc, lpVhdr.lpData, 0, 48, 320, 240)
    else
      StretchDIB(@Info,@tmpBuf[0], 0, 0,
        W, H,@infosrc, lpVhdr.lpData, 0, 0, infosrc.biWidth,infosrc.biHeight);{}
//  end;
//  try
{    DFRAM.general := XVID_H263QUANT or XVID_HALFPEL; // or XVID_INTER4V;
    DFRAM.bitstream := @_VideoData[0];
    DFRAM.length := _VideoSize;
    _VideoSize := 0;
    DFRAM.image := @Decbuf[0];
    DFRAM.stride := _VideoWidth;
    DFRAM.colorspace := XVID_CSP_RGB24 or XVID_CSP_VFLIP;
    if not CodeInited then exit;
    if not assigned(VDecodeproc) then
      exit;
    try
      VDecodeproc(DECodehandle, XVID_DEC_DECODE, @DFRAM, nil);
      if _LocalVideoBig then
      begin
        info := VideoDispSmall.BitMapInfoHeader;
        infoSrc := VideoDispSmall.BitMapInfoHeader;
        infoSrc.biWidth := _VideoWidth;
        infoSrc.biHeight := _VideoHeight;
        infoSrc.biSizeImage := _VideoWidth*_VideoHeight*3;

        if _VideoWidth<176 then
          info.biWidth := _VideoWidth
        else
          info.biWidth := 176;
        if _VideoHeight<144 then
          info.biHeight := _VideoHeight
        else
          info.biHeight := 144;
        info.biSizeImage := info.biWidth*info.biHeight*3;

        StretchDIB(@Info,@tmpDecBuf[0], 0, 0,
          W, H,@infosrc, @Decbuf[0], 0, 0, infosrc.biWidth,infosrc.biHeight);

        VideoDispSmall.DrawStreamEx((176-info.biWidth) div 2, (144-info.biWidth) div 2,
            info.biWidth, info.biWidth, @tmpDecBuf[0], info, True);
      end
      else
      begin
        info := VideoDisp.BitMapInfoHeader;
        info.biWidth := _VideoWidth;
        info.biHeight := _VideoHeight;
        info.biSizeImage := _VideoWidth*_VideoHeight*3;
        VideoDisp.DrawStreamEx((352-_VideoWidth) div 2, (288-_VideoHeight) div 2,
            _VideoWidth, _VideoHeight, @Decbuf[0], info, True);
      end;
    except
    end;    {}

//    VideoDispSmall.DrawStreamEx((176-W) div 2, (144-H) div 2, W, H, @TmpBuf[0], info, True);
//  except
//    VideoDispSmall.Invalidate;
//  end;

{  if frmAnyQ.IdTCPServerV.Active then
  begin
    List := frmAnyQ.IdTCPServerV.Threads.LockList;
    try
      for i := 0 to List.Count - 1 do
      try
        TIdPeerThread(List.Items[i]).Connection.WriteBuffer(FRAME.length, sizeof(FRAME.length), false);
        TIdPeerThread(List.Items[i]).Connection.WriteBuffer(audiosize, sizeof(audiosize), false);
        TIdPeerThread(List.Items[i]).Connection.WriteBuffer(outbuf, FRAME.length, false);
        TIdPeerThread(List.Items[i]).Connection.WriteBuffer(Audiobuf, audiosize, true);
        audiosize := 0;
        KeyFlag := false;
      except
        TIdPeerThread(List.Items[i]).Stop;
      end;
    finally
      frmAnyQ.IdTCPServerV.Threads.UnlockList;
    end;
  end
  else
    if frmAnyQ.IdTCPClientV.Connected then
    begin
      frmAnyQ.IdTCPClientV.WriteBuffer(FRAME.length, sizeof(FRAME.length), false);
      frmAnyQ.IdTCPClientV.WriteBuffer(audiosize, sizeof(audiosize), false);
      frmAnyQ.IdTCPClientV.WriteBuffer(outbuf, FRAME.length, false);
      frmAnyQ.IdTCPClientV.WriteBuffer(Audiobuf, audiosize, true);
      audiosize := 0;
      KeyFlag := false;
    end;  {}
end;

procedure TfrmChat.ACMWaveIn1Data(data: Pointer; size: Integer);
var
  pi, po: Pchar;
  i: Integer;
  List: TList;
  zero: Integer;
  PeakL, PeakR: Smallint;
  BUF: array of Byte;
begin
  zero := 0;
  pi := data;
  po := @Audiobuf;
  po := po + AudioSize;
  va_g729a_encoder(pi, po);
  AudioSize := AudioSize + 10;
  if AudioSize >= 3000 then
    AudioSize := 0;

  pcmFindPeak(@PCMFOMAT, Data, Size, PeakL, PeakR);
  TrackBarMic.SelStart := 32767-ABS(PeakL);

  if AudioSize < 60 then exit;
  if Assigned(_AudioTask) and IncludeAudio then
  begin
    setlength(Buf, sizeof(AudioSize)+AudioSize);
    Move(AudioSize, BUF[0], sizeof(AudioSize));
    Move(AudioBuf, BUF[sizeof(AudioSize)], AudioSize);
    if Assigned(_AudioTask) then
      _AudioTask.SendData(BUF[0], sizeof(AudioSize)+AudioSize);
//    KeyFlag := false;
  end;
  audiosize := 0;

{
  if not VideoInited then
  begin
    //如果没有视频传送，则自己发送数据
    if AudioSize < 40 then exit;
    if frmAnyQ.IdTCPServerV.Active then
    begin
      List := frmAnyQ.IdTCPServerV.Threads.LockList;
      try
        for i := 0 to List.Count - 1 do
        try
          TIdPeerThread(List.Items[i]).Connection.WriteBuffer(zero, sizeof(zero), false);
          TIdPeerThread(List.Items[i]).Connection.WriteBuffer(AudioSize, sizeof(AudioSize), false);
          TIdPeerThread(List.Items[i]).Connection.WriteBuffer(AudioBuf, AudioSize, true);
        except
          TIdPeerThread(List.Items[i]).Stop;
        end;
        audiosize := 0;
      finally
        frmAnyQ.IdTCPServerV.Threads.UnlockList;
      end;
    end
    else
      if frmAnyQ.IdTCPClientV.Connected then
      begin
        frmAnyQ.IdTCPClientV.WriteBuffer(zero, sizeof(zero), false);
        frmAnyQ.IdTCPClientV.WriteBuffer(AudioSize, sizeof(AudioSize), false);
        frmAnyQ.IdTCPClientV.WriteBuffer(AudioBuf, AudioSize, true);
        audiosize := 0;
      end;
  end;
{}
end;

procedure TfrmChat.WMPLAYAUDIO(var msg: TMessage);
begin
//  ACMWaveOut1.PlayBack(@AudioDecbuf, msg.WParam);
//  ACMWaveOut1.Tag := ACMWaveOut1.Tag+1;
end;

procedure TfrmChat.sendAutoReplyMsg(txt: widestring; rtf: string);
var
  xml: WideString;
  msg: TJabberMessage;
  mtag: TXMLTag;
begin
  // plugin madness
  if (chat_object <> nil) then
    TAnyQChat(chat_object.ComController).fireBeforeMsg(txt);

  if (txt = '') then exit;

  if _thread = '' then begin //get thread from message
    _thread := GetThread;
  end;

  // send the msg
  msg := TJabberMessage.Create(jid, 'chat', Trim(txt), '');
  msg.thread := _thread;
  msg.nick := MainSession.Username;
  msg.isMe := true;

  Msg.rtf := rtf;

  //add by doublewood
  _last_id := MainSession.generateID();
  _check_event := true;
  msg.id := _last_id;

  mtag := msg.Tag;
  with mtag.AddTag('x') do begin
    setAttribute('xmlns', XMLNS_XEVENT);
    AddTag('composing');
  end;

  // additional plugin madness
  if (chat_object <> nil) then
    xml := TAnyQChat(chat_object.ComController).fireAfterMsg(txt);
  if (xml <> '') then
    mtag.addInsertedXML(xml);
  MainSession.SendTag(mtag);
  Msg.Free();
end;

procedure TfrmChat.N12Click(Sender: TObject);
var
  iq: TJabberIQ;
  myip: Widestring;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
begin
  myip := MainSession.Stream.LocalIP;
  if (myip = '') then begin
    ShowRiserWindow(nil, sNetMeetingConnError, ico_info);
    exit;
  end;

  tmp_id := TJabberID.Create(_Jid.full);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行白板交流', ico_info);
      if haveVideo then
        StopVideo;
      haveVideo := false;
      VideoButton.Down := false;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := _Jid.full;
  StartWhiteboard(tmps);
  inherited;
end;

procedure TfrmChat.StartAudio;
var
  selfproc: TIdServerThreadEvent;
  iq, q: TXMLTag;
begin
  if not mnuViewRight.Checked then
    mnuViewRight.Click;

  AudioButton.Down := true;

  if IncludeAudio then
  begin
    ShowRiserWindow(nil, '同时只能与一个联系人进行音视频对话!', ico_info);
    AudioButton.Down := false;
    Exit;
  end;

  try
    ACMWaveIn1.Open(@PCMFOMAT,MainSession.Prefs.getInt('WavInDriver'));
  except
    ShowRiserWindow(nil, '无法初始化音频输入设备!', ico_info);
    AudioButton.Down := false;
  end;

  try
    ACMWaveOut1.Open(@PCMFOMAT,MainSession.Prefs.getInt('WavOutDriver'));
  except
    ShowRiserWindow(nil, '无法初始化音频播放设备!', ico_info);
    AudioButton.Down := false;
    Exit;
  end;

{
  if not assigned(frmAnyQ.IdTCPServerV.OnExecute) and (ClientHandleThread = nil) then
  begin
    frmAnyQ.IdTCPClientV.Host := copy(url, 9, length(url));
    frmAnyQ.IdTCPClientV.Connect(15000);

    ClientHandleThread := TClientHandleThread.Create(True);
    ClientHandleThread.chat := self;
    ClientHandleThread.FreeOnTerminate := True;
    ClientHandleThread.Resume;
  end;
{}

  AudioSize := 0;
  IncludeAudio := true;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', _jid.full);
  iq.setAttribute('type', 'result');
  iq.setAttribute('id', reqID);
  MainSession.SendTag(iq);
end;

procedure TfrmChat.StartVideo;
var
  iq, q: TXMLTag;

  procedure initVideo;
  var
    bh: tagBITMAPINFOHEADER;
  begin
    try
      VideoCap.DriverIndex := MainSession.Prefs.getInt('CamDriver');
      VideoCap.VideoPreview := false;
      VideoCap.DriverOpen := true;
      bh := VideoCap.BitMapInfoHeader;
      bh.biWidth := VideoCap.Width;
      bh.biHeight := VideoCap.Height;
      bh.biSizeImage := bh.biWidth * bh.biHeight * bh.biBitCount div 8;
      VideoCap.BitMapInfoHeader := bh;

      bh.biWidth := VideoDisp.Width;
      bh.biHeight := VideoDisp.Height;
      bh.biCompression := BI_RGB;
      bh.biSizeImage := bh.biWidth * bh.biHeight * 3;
      bh.biBitCount := 24;
      VideoDisp.BitMapInfoHeader := bh;

      VideoCap.VideoPreview := true;
      VideoCap.StartCapture;
      VideoCap.visible := true;
      VideoDisp.visible := true;
      KeyFlag := true;
      VideoInited := true;
      VideoTaskID := _VideoTask.TaskID;
    except
//      UninitCode;
      VideoInited := false;
//      VideoCap.visible := true;
      VideoDisp.visible := true;
//      VideoDispSmall.visible := true;
//      ShowRiserWindow(nil, '初始化视频设备失败，设备可能已被占用!', ico_info);
      VideoButton.Down := false;
//      abort;
    end;
  end;
begin
  if not mnuViewRight.Checked then
    mnuViewRight.Click;

  VideoButton.Down := true;

  if VideoInited  and not IsEqualGUID(VideoTaskID,_VideoTask.TaskID) then
  begin
    ShowRiserWindow(nil, '同时只能与一个联系人进行视频对话!', ico_info);
    VideoButton.Down := false;
    Exit;
  end;

  try
    _VideoWidth := 352;
    _VideoHeight := 288;
    _LocalVideoWidth := 352;
    _LocalVideoHeight := 288;
    initVideo;
  except
  end;

  if not CodeInited then
    if not InitCode(352, 288) then
    begin
      ShowRiserWindow(nil, '无法初始化视频处理库!', ico_info);
      VideoButton.Down := false;
      Exit;
    end;

  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', _jid.full);
  iq.setAttribute('type', 'result');
  iq.setAttribute('id', reqID);
  MainSession.SendTag(iq);
end;

procedure TfrmChat.RxSliderquantChange(Sender: TObject);
begin
  inherited;
  KeyFlag := True;
end;

procedure TfrmChat.VideoUdpFail(sender: TObject);
var
  hosts: TStringList;
  iq: TXMLTag;
  i: integer;
begin
  if TAnyQBaseUDPTask(Sender).Status='connecting' then
  begin
    if IsVCaller then
      StopVideo
    else
    begin
      hosts := TStringList.Create;
      UDPController.GetUDPInfo(hosts);
      iq := TXMLTag.Create('iq');
      with iq do begin
        setAttribute('to', jid);
        setAttribute('id', MainSession.generateID());
        setAttribute('type', 'set');
        with AddTag('query') do begin
          setAttribute('xmlns', XMLNS_AnyQUDP);
          AddBasicTag('taskid', GUIDToString(_VideoTask.TaskID));
          for i:= 0 to hosts.Count-1 do
            AddBasicTag('host', hosts[i]);
        end;
      end;
      hosts.Free;
      MainSession.SendTag(iq);
    end;
    if assigned(_VideoTask) then
      FreeAndNil(_VideoTask);
  end;    
end;

procedure TfrmChat.VideoUdpRcvStatus(sender: TObject);
begin
  if TAnyQBaseUDPTask(Sender).Status='connected' then
    if not IsVCaller then
      StartVideo
    else
      KeyFlag := true;
end;

procedure TfrmChat.VideoUdpTimeout(Sender: TObject);
begin

end;

procedure TfrmChat.AudioUdpFail(sender: TObject);
var
  hosts: TStringList;
  iq: TXMLTag;
  i: integer;
begin
  if TAnyQBaseUDPTask(Sender).Status='connected' then
    if IsACaller then
      StopAudio
    else
    begin
      hosts := TStringList.Create;
      UDPController.GetUDPInfo(hosts);
      iq := TXMLTag.Create('iq');
      with iq do begin
        setAttribute('to', jid);
        setAttribute('id', MainSession.generateID());
        setAttribute('type', 'set');
        with AddTag('query') do begin
          setAttribute('xmlns', XMLNS_AnyQUDP);
          AddBasicTag('taskid', GUIDToString(_AudioTask.TaskID));
          for i:= 0 to hosts.Count-1 do
            AddBasicTag('host', hosts[i]);
        end;
      end;
      hosts.Free;
      MainSession.SendTag(iq);
    end;
  if assigned(_AudioTask) then
    FreeAndNil(_AudioTask);
end;

procedure TfrmChat.AudioUdpRcvStatus(sender: TObject);
begin
  if TAnyQBaseUDPTask(Sender).Status='connected' then
    if not IsACaller then
      StartAudio;
end;

procedure TfrmChat.AudioUdpTimeout(Sender: TObject);
begin

end;

procedure TfrmChat.VideoCapStatusCallback(Sender: TObject; nID: Integer;
  status: String);
begin
  if nID=IDS_CAP_END then
    if not _StopVideoing then
      StopVideo;
end;

procedure TfrmChat.R1Click(Sender: TObject);
var
  fp: string;
begin
  inherited;
  fp := MainSession.Prefs.getString('xfer_path');
  if fp = '' then
    fp := ExtractFilePath(Application.ExeName);
  ShellExecute(application.Handle, 'open', Pchar(fp), nil, nil, SW_SHOWDEFAULT);
end;

procedure TfrmChat.N4Click(Sender: TObject);
begin
  inherited;
  self.close;
end;

procedure TfrmChat.Powerpoint1Click(Sender: TObject);
var
  tmp_id: TJabberID;
  pri: TJabberPres;
  toJid: widestring;
begin
  tmp_id := TJabberID.Create(Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户进行Powerpoint演讲', ico_info);
      exit;
    end;
    toJid := pri.fromJID.full;
  end
  else
    toJid := Jid;
  tmp_id.Free;

  if OpenDialog1.Execute then
  begin
    startppt(OpenDialog1.FileName, self, tojid);
  end;
end;

procedure TfrmChat.W1Click(Sender: TObject);
var
  tmp_id: TJabberID;
  pri: TJabberPres;
  toJid: widestring;
begin
  tmp_id := TJabberID.Create(Jid);
  if (tmp_id.resource = '') then begin
    pri := MainSession.ppdb.FindPres(tmp_id.jid, '');
    if (pri = nil) then begin
      ShowRiserWindow(nil, '只能与联机用户共同浏览网页', ico_info);
      exit;
    end;
    toJid := pri.fromJID.full;
  end
  else
    toJid := Jid;
  tmp_id.Free;
  startBrows(self, toJid);
end;

procedure TfrmChat.Timer1Timer(Sender: TObject);
var
  r: Trect;
begin
  r := Rect(0,0,1,1);
//  InvalidateRect(VideoDispSmall.Handle, @R,true);
  InvalidateRect(VideoDisp.Handle, @R,true);
end;

procedure TfrmChat.ACMWaveOut1Done(Sender: TObject);
begin
  if ACMWaveOut1.Tag>0 then
    ACMWaveOut1.Tag := ACMWaveOut1.Tag-1;
end;

procedure TfrmChat.TrackBarSpkChange(Sender: TObject);
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  if _VolChanging then
    exit;
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := SpkControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  R := (32767-TrackBarSpk.Position)*2;
  d.paDetails := @R;
  mixerSetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE);
end;

procedure TfrmChat.TrackBarMicChange(Sender: TObject);
var
  D: tMIXERCONTROLDETAILS;
  R: Cardinal;
begin
  if _VolChanging then
    exit;
  FillChar(d, SizeOf(tMIXERCONTROLDETAILS), 0);
  d.cbStruct := SizeOf(tMIXERCONTROLDETAILS);
  d.dwControlID := MicControlID;
  d.cChannels := MIXERCONTROL_CONTROLF_UNIFORM;
  d.cbDetails := sizeof(TMixerControl);
  R := (32767-TrackBarMic.Position)*2;
  d.paDetails := @R;
  mixerSetControlDetails(hmx, @D, MIXER_GETCONTROLDETAILSF_VALUE);
end;

function TfrmChat.CaptureMode: TCaptureMode;
begin
  if spbtnLBig.Down then Result := cmBig;
  if spbtnLSmall.Down then Result := cmSmall;
end;

function TfrmChat.DisplayMode: TDisplayMode;
begin
  if spbtnRBig.Down then Result := dmBig;
  if spbtnRSmall.Down then Result := dmSmall;
  if spbtnRAuto.Down then Result := dmAuto;
end;

procedure TfrmChat.changeCapture(Sender: TObject);
var
  bh: TBitmapInfoHeader;
  W,H, OldW: Integer;
begin
  Case CaptureMode of
    cmBig:
      begin
        W := 320;
        H := 240;
      end;
    cmSmall:
      begin
        W := 160;
        H := 120;
      end;
  end;

  pnlCapture.Height := H+21;
  spbtnLBig.Top := H+1;
  spbtnLSmall.Top := H+1;
  lbquant.Top := H+4;
  TrackBarquant.Top := H+1;
  ImageMic.Left := W+1;
  TrackBarMic.Left := W;
  VideoCap.Width := W;
  VideoCap.Height := H;
  ImageCap.Width := W;
  ImageCap.Height := H;
  OldW := pnlRight.Width;
  pnlRight.Width := Max(W, VideoDisp.Width) +25;
  if Max(W, VideoDisp.Width) +25 < OldW then
    Width := Width-(OldW-pnlRight.Width);
  if pnlCapture.Height+pnlDisplay.Height+8 > pnlRight.Height then
    ClientHeight := ClientHeight+(pnlCapture.Height+pnlDisplay.Height+8-pnlRight.Height);

  if VideoCap.DriverOpen then
  begin
    bh := VideoCap.BitMapInfoHeader;
    VideoCap.StopCapture;
    VideoCap.VideoPreview := False;
    _StopVideoing := True;
    VideoCap.DriverOpen := False;
    VideoCap.DriverOpen := True;
    bh.biWidth := W;
    bh.biHeight := H;
    bh.biSizeImage := W*H*bh.biBitCount div 8;
    VideoCap.Invalidate;
    _StopVideoing := False;
    VideoCap.BitMapInfoHeader := bh;
    VideoCap.VideoPreview := True;
    VideoCap.StartCapture;
  end;
end;

procedure TfrmChat.FormConstrainedResize(Sender: TObject; var MinWidth,
  MinHeight, MaxWidth, MaxHeight: Integer);
begin
//  inherited;
  if Self.WindowState<>wsNormal then
    exit
  else
    MinHeight := pnlDisplay.Height+pnlCapture.Height+8+(Height-ClientHeight);
end;

procedure TfrmChat.changeDisplay(Sender: TObject);
var
  bh: TBitmapInfoHeader;
  W,H, OldW: Integer;
begin
  W := VideoDisp.Width;
  H := VideoDisp.Height;
  Case DisplayMode of
    dmBig:
      begin
        W := 320;
        H := 240;
      end;
    dmSmall:
      begin
        W := 160;
        H := 120;
      end;
  end;
{
  if VideoCap.DriverOpen then
  begin
    bh := VideoCap.BitMapInfoHeader;
    bh.biWidth := W;
    bh.biHeight := H;
    bh.biSizeImage := W*H*bh.biBitCount div 8;
    VideoCap.BitMapInfoHeader := bh;
  end;
{}
  pnlDisplay.Height := H+21;
  spbtnRBig.Top := H+1;
  spbtnRSmall.Top := H+1;
  spbtnRAuto.Top := H+1;
  lbSend.Top := H+4;
  lbRcv.Top := H+4;
  Imagespk.Left := W+1;
  TrackBarSpk.Left := W;
  VideoDisp.Width := W;
  VideoDisp.Height := H;
  ImageDisp.Width := W;
  ImageDisp.Height := H;
  OldW := pnlRight.Width;
  pnlRight.Width := Max(W, VideoCap.Width) +25;
  if Max(W, VideoCap.Width) +25 < OldW then
    Width := Width-(OldW-pnlRight.Width);
  if pnlCapture.Height+pnlDisplay.Height+8 > pnlRight.Height then
    ClientHeight := ClientHeight+(pnlCapture.Height+pnlDisplay.Height+8-pnlRight.Height);
end;

end.

