unit whiteboard;

interface

uses
  XMLTag, IdThreadMgr, IdThreadMgrDefault, IdTCPConnection, IdTCPClient,
  IdBaseComponent, IdComponent, IdTCPServer, Udp,
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Dockable, ComCtrls, ExtCtrls, StdCtrls, Menus, ImgList, ToolWin,
  Buttons, IdCoder, IdCoder3to4, IdCoderMIME;

const
  WBACT_INIT = $0000;
  WBACT_CLEAR = $FFFF;

  WBACT_BEGIN = $0001;
  WBACT_LINE = $0002;
  WBACT_RECTANGLE = $0003;
  WBACT_ELLIPSE = $0004;
  WBACT_ROUNDRECT = $0005;
  WBACT_FILL = $0006;
  WBACT_ERASER = $0007;
  WBACT_TEXT = $0008;

  WBACT_PEN = $0100;
  WBACT_PASTE = $0200;

type
  TWBACT = packed record
    Flag: array[0..3] of Char;
    Act: Word;
    StartPos: TPoint;
    EndPos: TPoint;
    PenColor: TColor;
    PenWidth: Word;
    PenStyle: Integer;
    BrushColor: TColor;
    BrushStyle: Integer;
    DataSize: Integer;
  end;

  TWBDrawState = record
    Pen: TPen;
    Brush: TBrush;
    Font: TFont;
    Point: TPoint;
  end;

type
  TfrmAnyQWB = class(TfrmDockable)
    pnlTools: TPanel;
    sbClear: TSpeedButton;
    pbStyle: TPaintBox;
    ImageList1: TImageList;
    pnlColors: TPanel;
    pbColorPick: TPaintBox;
    btnTextFont: TButton;
    ScrollBox1: TScrollBox;
    ImgBoard: TImage;
    StatusBar1: TStatusBar;
    ColorDialog1: TColorDialog;
    FontDialog1: TFontDialog;
    IdDecoderMIME1: TIdDecoderMIME;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tbEraser: TToolButton;
    tbFill: TToolButton;
    tbPen: TToolButton;
    tbText: TToolButton;
    tbLine: TToolButton;
    tbEllipse: TToolButton;
    tbRectangle: TToolButton;
    tbRoundRect: TToolButton;
    tbCapRect: TToolButton;
    tbCapWindow: TToolButton;
    procedure pbStyleMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbStylePaint(Sender: TObject);
    procedure pbColorPickDblClick(Sender: TObject);
    procedure pbColorPickMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure pbColorPickPaint(Sender: TObject);
    procedure btnTextFontClick(Sender: TObject);
    procedure ImgBoardMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure ImgBoardMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ImgBoardMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure tbEraserClick(Sender: TObject);
    procedure tbFillClick(Sender: TObject);
    procedure tbPenClick(Sender: TObject);
    procedure tbTextClick(Sender: TObject);
    procedure tbLineClick(Sender: TObject);
    procedure tbEllipseClick(Sender: TObject);
    procedure tbRectangleClick(Sender: TObject);
    procedure tbRoundRectClick(Sender: TObject);
    procedure sbClearClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure TextChange(Sender: TObject);
    procedure tbCapWindowClick(Sender: TObject);
    procedure tbCapRectClick(Sender: TObject);
    procedure PastepnlMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormDestroy(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    _task: TAnyQBaseUDPTask;
    _taskhost: TStringList;
    _Act: TWBACT;
    _ActData: array of Byte;
    _ReadData: Boolean;
    _ReadSize: Integer;

    procedure MakeEraserCursor;

    procedure UdpRcv(sender: TObject; Adata: TStream);
    procedure UdpRcvStatus(sender: TObject);
    procedure UdpFail(sender: TObject);
    procedure UdpTimeout(Sender: TObject);
  public
    { Public declarations }
    IsCaller: Boolean;
    DrawIng: Boolean;
    TextEdit: TMemo;
    PasteImg: TImage;
    Pastepnl: TPanel;
    JID: Widestring;
    reqID: widestring;
    TaskID: TGUID;

    SendByIBB: Boolean;
    procedure DoBegin(X, Y: Integer; ISSelf: Boolean = true);
    procedure DoInit(InitData: Pointer; ISSelf: Boolean = true);
    procedure DoAct(Act: TWBACT; ActData: PByte);
    procedure WBCallback(event: string; tag: TXMLTag);
    procedure Init;
    procedure SendReady;

    procedure connecturl(url: widestring);
    procedure InitIBB;
    procedure FinishCurrAct;
    procedure SendCurAct;
    procedure sendCurActByIBB;

    procedure sendnotstart;

    procedure IdTCPServerWExecute(AThread: TIdPeerThread);
    procedure IdTCPServerWDisConnect(AThread: TIdPeerThread);
  end;

var
  frmAnyQWB: TfrmAnyQWB;

procedure StartWhiteboard(Tojid: Widestring); overload;
procedure StartWhiteboard(task: TAnyQBaseUDPTask; Tojid, ReqID: Widestring; hosts: TStringList); overload;
procedure StartWhiteboard(Tojid: Widestring; Url, ReqID: Widestring); overload;
procedure Processwhiteboard(tag: TXMLTag);

implementation

uses Math, RiserWindow, CaptureScreen, Jabber1, JabberID, iq, Session,
  RosterWindow, presence, JabberConst;
{$R *.dfm}

const
  crWBPen = 1;
  crWBCross = 2;
  crWBFill = 3;
  crWBEraser = 4;
{
type
  TClientHandleThread = class(TThread)
  private
    Act: TWBACT;
    ACTData: array of Byte;
    decsize: Integer;
    procedure Draw;
  protected
    procedure Execute; override;
  public
  end;

var
  ClientHandleThread: TClientHandleThread; // variable (type see above)
{}
var
  ColorTable: array[0..27] of TColor =
  (
    Tcolor($000000), Tcolor($808080), Tcolor($000080), Tcolor($008080),
    Tcolor($008000), Tcolor($808000), Tcolor($800000), Tcolor($800080),
    Tcolor($408080), Tcolor($404000), Tcolor($FF8000), Tcolor($804000),
    Tcolor($FF0080), Tcolor($004080), Tcolor($FFFFFF), Tcolor($C0C0C0),
    Tcolor($0000FF), Tcolor($00FFFF), Tcolor($00FF00), Tcolor($FFFF00),
    Tcolor($FF0000), Tcolor($FF00FF), Tcolor($80FFFF), Tcolor($80FF00),
    Tcolor($FFFF80), Tcolor($FF8080), Tcolor($8000FF), Tcolor($4080FF)
    );
  MyAct: TWBACT;
  MyActData: array of Byte;
  MyDrawState: TWBDrawState;
  MyEraserWidth: Integer;
  MyRecBrush: Integer;

  OtherMyAct: TWBACT;
  IBBStream: TStream;

procedure Processwhiteboard(tag: TXMLTag);
var
  _iq: TXMLTag;
  qtag, taskinfo: TXMLTag;
  JID, tasktype: widestring;
  decstr: string;
  ACT: TWBACT;
  ACTData: array of Byte;
begin
  if frmAnyQWB = nil then exit;

  qtag := tag.GetFirstTag('query');
  if qtag = nil then exit;

  JID := tag.GetAttribute('from');
  if JID <> frmAnyQWB.JID then exit;

  if tag.GetAttribute('type') = 'set' then
  begin
    if qtag.GetFirstTag('data') <> nil then
    begin
      if IBBStream = nil then
        IBBStream := TMemoryStream.Create;
      decstr := qtag.GetFirstTag('data').Data;
      frmAnyQWB.IdDecoderMIME1.DecodeToStream(decstr, IBBStream);
    end;

    _iq := TXMLTag.Create('iq');
    _iq.setAttribute('id', tag.GetAttribute('id'));
    _iq.setAttribute('type', 'result');
    with _iq.AddTag('query') do
    begin
      setAttribute('xmlns', XMLNS_IBB);
      setAttribute('sid', qtag.GetAttribute('sid'));
    end;
    _iq.setAttribute('to', jid);
    MainSession.SendTag(_iq);

    if qtag.GetFirstTag('close') <> nil then
    begin
      IBBStream.Seek(0, 0);
      IBBStream.Read(ACT, Sizeof(ACT));
      if ACT.DataSize > 0 then
      begin
        setlength(ACTData, ACT.DataSize);
        IBBStream.Read(ACTData[0], ACT.DataSize);
      end;
      IBBStream.Free;
      IBBStream := nil;
      frmAnyQWB.DoAct(ACT, @ACTDATA[0]);
    end;
  end;
end;

procedure StartWhiteboard(Tojid: Widestring);
begin
  if frmAnyQWB = nil then
  begin
    frmAnyQWB := TfrmAnyQWB.Create(Application);
    frmAnyQWB.JID := Tojid;
    frmAnyQWB.IsCaller := true;
    frmAnyQWB.Caption := '正在等待对方回应……';
    frmAnyQWB.Show;
    frmAnyQWB.Init;
  end
  else
    if frmAnyQWB.JID = Tojid then
      frmAnyQWB.BringToFront
    else
      ShowRiserWindow(nil, '已经有一个白板在使用中，同时只能使用一个白板', ico_info);
end;

procedure StartWhiteboard(task: TAnyQBaseUDPTask; Tojid, ReqID: Widestring; hosts: TStringList);
begin
  if frmAnyQWB = nil then
  begin
    frmAnyQWB := TfrmAnyQWB.Create(Application);
    frmAnyQWB._task := task;
    frmAnyQWB.IsCaller := False;
    frmAnyQWB.JID := Tojid;
    frmAnyQWB.ReqID := ReqID;
    frmAnyQWB.Caption := '正在等待对方回应……';
    frmAnyQWB.Show;

    task.OnRcvData := frmAnyQWB.UdpRcv;
    task.OnRcvStatus := frmAnyQWB.UdpRcvStatus;
    task.OnTimeOut := frmAnyQWB.UdpTimeout;
    task.OnFail := frmAnyQWB.UdpFail;

    frmAnyQWB.SendReady;
    task.Connect(hosts);
//    frmAnyQWB.ConnectUrl(Url);
  end
  else
    if frmAnyQWB.JID = Tojid then
      frmAnyQWB.BringToFront
    else
      frmAnyQWB.SendnotStart; {}
end;

procedure StartWhiteboard(Tojid: Widestring; Url, ReqID: Widestring);
begin
  if frmAnyQWB = nil then
  begin
    frmAnyQWB := TfrmAnyQWB.Create(Application);
    frmAnyQWB.JID := Tojid;
    frmAnyQWB.ReqID := ReqID;
    frmAnyQWB.Caption := '正在等待对方回应……';
    frmAnyQWB.Show;
    frmAnyQWB.ConnectUrl(Url);
  end
  else
    if frmAnyQWB.JID = Tojid then
      frmAnyQWB.BringToFront
    else
      frmAnyQWB.SendnotStart;
end;

procedure TfrmAnyQWB.MakeEraserCursor;
var
  ANDmaskCursor: array[0..31] of DWORD;
  XormaskCursor: array[0..31] of DWORD;
  i: Integer;
  h: HCURSOR;
begin
  if Screen.Cursors[crWBEraser] <> Screen.Cursors[crDefault] then
    DestroyCursor(Screen.Cursors[crWBEraser]);
  FillChar(ANDmaskCursor[0], 128, $FF);
  FillChar(XormaskCursor[0], 128, $00);
  case MyEraserWidth of
    4: begin
        ANDmaskCursor[0] := $FFFFFF0F;
        ANDmaskCursor[1] := $FFFFFF0F;
        ANDmaskCursor[2] := $FFFFFF0F;
        XormaskCursor[1] := $00000060;
        XormaskCursor[2] := $00000060;
        ANDmaskCursor[3] := $FFFFFF0F;
      end;
    8: begin
        ANDmaskCursor[0] := $FFFFFF00;
        for i := 1 to 6 do
        begin
          ANDmaskCursor[i] := $FFFFFF00;
          XormaskCursor[i] := $0000007E;
        end;
        ANDmaskCursor[7] := $FFFFFF00;
      end;
    16: begin
        ANDmaskCursor[0] := $FFFF0000;
        for i := 1 to 14 do
        begin
          ANDmaskCursor[i] := $FFFF0000;
          XormaskCursor[i] := $0000FE7F;
        end;
        ANDmaskCursor[15] := $FFFF0000;
      end;
  end;
  h := CreateCursor(HInstance, MyEraserWidth div 2, MyEraserWidth div 2, 32, 32, @ANDmaskCursor, @XormaskCursor);
  Screen.Cursors[crWBEraser] := h;
end;

procedure TfrmAnyQWB.pbStyleMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  R: TRect;
  i: Integer;
begin
  R := Rect(2, 3, 44, 74);
  if not PtInRect(R, point(x, y)) then exit;
  case MyAct.Act of
    WBACT_LINE, WBACT_PEN:
      begin
        MyDrawState.Pen.Width := 2 shl ((y - 3) div 18);
        pbStyle.Refresh;
      end;
    WBACT_ERASER:
      begin
        MyEraserWidth := 4 shl ((y - 3) div 24);
        pbStyle.Refresh;
        MakeEraserCursor;
      end;
    WBACT_RECTANGLE, WBACT_ELLIPSE, WBACT_ROUNDRECT:
      begin
        MyRecBrush := ((y - 3) div 24);
        pbStyle.Refresh;
      end;
  end;
end;

procedure TfrmAnyQWB.pbStylePaint(Sender: TObject);
var
  R: TRect;
  x, y: integer;
  i: Integer;
begin
  R := pbStyle.ClientRect;
  DrawEdge(pbStyle.Canvas.Handle, R, BDR_SUNKENINNER or BDR_SUNKENOUTER, BF_RECT);
  InflateRect(R, -2, -2);
  pbStyle.Canvas.Brush.Color := pnlTools.Color;
  pbStyle.Canvas.FillRect(R);
  case MyAct.Act of
    WBACT_LINE, WBACT_PEN:
      begin
        for i := 0 to 3 do
        begin
          R := Rect(2, i * 18 + 3, 44, (i + 1) * 18 + 3);
          InflateRect(R, -1, 0);
          if MyDrawState.Pen.Width = 2 shl i then
          begin
            pbStyle.Canvas.Brush.Color := clHighlight;
            pbStyle.Canvas.FillRect(R);
            InflateRect(R, -2, ((2 shl i) - 18) div 2);
            pbStyle.Canvas.Brush.Color := clHighlightText;
            pbStyle.Canvas.FillRect(R);
          end
          else
          begin
            InflateRect(R, -2, ((2 shl i) - 18) div 2);
            pbStyle.Canvas.Brush.Color := clWindowText;
            pbStyle.Canvas.FillRect(R);
          end;
        end;
      end;
    WBACT_ERASER:
      begin
        for i := 0 to 2 do
        begin
          R := Rect(2, i * 24 + 3, 44, (i + 1) * 24 + 3);
          InflateRect(R, -1, 0);
          if MyEraserWidth = 4 shl i then
          begin
            pbStyle.Canvas.Brush.Color := clHighlight;
            pbStyle.Canvas.FillRect(R);
            InflateRect(R, ((2 shl i) - 38) div 2, ((2 shl i) - 22) div 2);
            pbStyle.Canvas.Brush.Color := clHighlightText;
            pbStyle.Canvas.FillRect(R);
          end
          else
          begin
            InflateRect(R, ((2 shl i) - 38) div 2, ((2 shl i) - 22) div 2);
            pbStyle.Canvas.Brush.Color := clWindowText;
            pbStyle.Canvas.FillRect(R);
          end;
        end;
      end;
    WBACT_RECTANGLE, WBACT_ELLIPSE, WBACT_ROUNDRECT:
      begin
        for i := 0 to 2 do
        begin
          R := Rect(2, i * 24 + 3, 44, (i + 1) * 24 + 3);
          InflateRect(R, -1, 0);
          if i = MyRecBrush then
          begin
            pbStyle.Canvas.Brush.Color := clHighlight;
            pbStyle.Canvas.FillRect(R);
            pbStyle.Canvas.Pen.Color := clHighlightText;
          end
          else
            pbStyle.Canvas.Pen.Color := clWindowText;

          pbStyle.Canvas.Pen.Width := 2;
          pbStyle.Canvas.Pen.Style := psSolid;
          InflateRect(R, -4, -4);
          case i of
            0:
              begin
                pbStyle.Canvas.Brush.Style := bsClear;
                pbStyle.Canvas.Rectangle(R);
              end;
            1:
              begin
                pbStyle.Canvas.Brush.Color := clDkGray;
                pbStyle.Canvas.Brush.Style := bsSolid;
                pbStyle.Canvas.Rectangle(R);
              end;
            2:
              begin
                pbStyle.Canvas.Brush.Color := clDkGray;
                pbStyle.Canvas.Brush.Style := bsSolid;
                pbStyle.Canvas.Pen.Color := clDkGray;
                pbStyle.Canvas.Rectangle(R);
              end;
          end;
        end;
      end;
  end;
end;

procedure TfrmAnyQWB.pbColorPickDblClick(Sender: TObject);
var
  index: Integer;
  p: Tpoint;
  X, Y: Integer;
begin
  P := pbColorPick.ScreenToClient(Mouse.CursorPos);
  X := p.X;
  Y := P.Y;
  if (X mod 16 in [2..13]) and (Y mod 16 in [2..13]) then
  begin
    if x div 16 < 2 then exit;
    index := (Y div 16) * 14 + (X div 16) - 2;
    ColorDialog1.Color := colorTable[Index];
    if ColorDialog1.Execute then
    begin
      colorTable[Index] := ColorDialog1.Color;
      pbColorPick.Refresh;
    end;
  end;
end;

procedure TfrmAnyQWB.pbColorPickMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  index: Integer;
begin
  if (X mod 16 in [2..13]) and (Y mod 16 in [2..13]) then
  begin
    if x div 16 < 2 then exit;
    index := (Y div 16) * 14 + (X div 16) - 2;

    case MyAct.Act of
      WBACT_FILL:
        begin
          MyDrawState.Brush.Color := colorTable[Index];
        end;
    else
      begin
        MyDrawState.Pen.Color := colorTable[Index];
      end;
    end;
    pbColorPick.Refresh;
  end;
end;

procedure TfrmAnyQWB.pbColorPickPaint(Sender: TObject);
var
  R: TRect;
  x, y: integer;
  i: Integer;
begin
  R := rect(0, 0, 31, 31);
  DrawEdge(pbColorPick.Canvas.Handle, R, BDR_SUNKENINNER or BDR_SUNKENOUTER, BF_RECT);
  if MyAct.Act = WBACT_FILL then
    pbColorPick.Canvas.Brush.Color := MyDrawState.Brush.Color
  else
    pbColorPick.Canvas.Brush.Color := MyDrawState.Pen.Color;
  InflateRect(R, -2, -2);
  pbColorPick.Canvas.FillRect(R);

  for i := 0 to 27 do
  begin
    X := 32 + (i mod 14) * 16;
    Y := 0 + (i div 14) * 16;
    R := Rect(x, y, x + 15, y + 15);
    DrawEdge(pbColorPick.Canvas.Handle, R, BDR_SUNKENINNER or BDR_SUNKENOUTER, BF_RECT);
    pbColorPick.Canvas.Brush.Color := Colortable[i];
    InflateRect(R, -2, -2);
    pbColorPick.Canvas.FillRect(R);
  end;
end;

procedure TfrmAnyQWB.btnTextFontClick(Sender: TObject);
begin
  FontDialog1.Font := MyDrawState.Font;
  if FontDialog1.Execute then
    MyDrawState.Font := FontDialog1.Font;
end;

procedure TfrmAnyQWB.ImgBoardMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if Button <> mbLeft then exit;
  if DrawIng then
    FinishCurrAct;
  DrawIng := true;
  if MyAct.Act = WBACT_TEXT then
  begin

  end;
  case MyAct.Act of
    WBACT_ERASER:
      begin
        DoBegin(X, Y);
        if length(MyActData) < SizeOf(TPoint) then
          setlength(MyActData, SizeOf(TPoint));
        PPoint(MyActData)^ := Point(X, Y);
        MyAct.EndPos := Point(X, Y);
        MyAct.PenColor := MyDrawState.Pen.Color;
        MyAct.PenWidth := MyEraserWidth;
        MyAct.PenStyle := Integer(MyDrawState.Pen.Style);

        MyAct.DataSize := 0;
        DoAct(MyAct, nil);
        SendCurAct;
        MyAct.StartPos := MyAct.EndPos;
      end;
    WBACT_PEN, WBACT_FILL, WBACT_LINE:
      begin
        DoBegin(X, Y);
        if length(MyActData) < SizeOf(TPoint) then
          setlength(MyActData, SizeOf(TPoint));
        PPoint(MyActData)^ := Point(X, Y);
        MyAct.EndPos := Point(X, Y);
        MyAct.DataSize := 0;
        MyAct.PenColor := MyDrawState.Pen.Color;
        MyAct.PenWidth := MyDrawState.Pen.Width;
        MyAct.PenStyle := Integer(MyDrawState.Pen.Style);
        MyAct.BrushColor := MyDrawState.Brush.Color;
        DoAct(MyAct, nil);
        SendCurAct;
        MyAct.StartPos := MyAct.EndPos;
      end;
    WBACT_TEXT:
      begin
{        if TextEdit<> nil then
        begin
          MyAct.EndPos.X := MyAct.StartPos.X + TextEdit.ClientWidth - 12;
          MyAct.EndPos.Y := MyAct.StartPos.Y + TextEdit.ClientHeight - 4;
          MyAct.PenColor := TextEdit.Font.Color;
          MyAct.PenWidth := TextEdit.Font.Size;
          MyAct.PenStyle := 0;
          if fsBold in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 1;
          if fsItalic in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 2;
          if fsUnderline in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 4;
          if fsStrikeOut in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 8;
          MyAct.DataSize := length(TextEdit.Font.Name)+2+length(TextEdit.Lines.Text)+1;
          SetLength(MyActData, MyAct.DataSize);
          StrCopy(Pchar(@MyActData[0]),Pchar(TextEdit.Font.Name+#13+#10+TextEdit.Lines.Text+#0));
          DoAct(MyAct, @MyActData[0]);
          TextEdit.Free;
          TextEdit := nil;
          SendCurAct;
        end;    {}
      end;
  end;
  DoBegin(X, Y);
end;

procedure TfrmAnyQWB.ImgBoardMouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  if not DrawIng then
    exit;
  case MyAct.Act of
    WBACT_ERASER, WBACT_PEN:
      begin
        MyAct.EndPos := Point(X, Y);
        if not _Task.Sending and (_Task.Status<>'connecting') and (_Task.Status<>'') then
        begin
          MyAct.DataSize := 0;
          DoAct(MyAct, nil);
          SendCurAct;
          MyAct.StartPos := MyAct.EndPos;
        end;
      end;
    WBACT_LINE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;

          MoveTo(MyAct.StartPos.X, MyAct.StartPos.Y);
          Lineto(MyAct.EndPos.X, MyAct.EndPos.Y);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmNotXor;
          MoveTo(MyAct.StartPos.X, MyAct.StartPos.Y);
          Lineto(MyAct.EndPos.X, MyAct.EndPos.Y);
        end;
      end;
    WBACT_RECTANGLE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          Brush := MyDrawState.Brush;
          case MyRecBrush of
            0: Brush.Style := bsClear;
            1: Brush.Color := clWhite;
            2: Brush.Color := Pen.Color;
          end;
          Rectangle(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmNotXor;
          Rectangle(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
        end;
      end;
    WBACT_ELLIPSE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          Brush := MyDrawState.Brush;
          case MyRecBrush of
            0: Brush.Style := bsClear;
            1: Brush.Color := clWhite;
            2: Brush.Color := Pen.Color;
          end;
          Ellipse(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmNotXor;
          Ellipse(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
        end;
      end;
    WBACT_ROUNDRECT:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          Brush := MyDrawState.Brush;
          case MyRecBrush of
            0: Brush.Style := bsClear;
            1: Brush.Color := clWhite;
            2: Brush.Color := Pen.Color;
          end;
          RoundRect(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y, 16, 16);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmNotXor;
          RoundRect(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y, 16, 16);
        end;
      end;
    WBACT_FILL:
      begin
        exit;
      end;
  end;
end;

procedure TfrmAnyQWB.ImgBoardMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if Button <> mbLeft then exit;
  if MyAct.Act <> WBAct_Paste then
    DrawIng := false;
  case MyAct.Act of
    WBACT_LINE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          MoveTo(MyAct.StartPos.X, MyAct.StartPos.Y);
          Lineto(MyAct.EndPos.X, MyAct.EndPos.Y);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmCopy;
          MyAct.PenColor := MyDrawState.Pen.Color;
          MyAct.PenWidth := MyDrawState.Pen.Width;
          MyAct.PenStyle := Integer(MyDrawState.Pen.Style);
          MyAct.DataSize := 0;
          DoAct(MyAct, nil);
          SendCurAct;
//          MoveTo(MyAct.StartPos.X, MyAct.StartPos.Y);
//          Lineto(MyAct.EndPos.X, MyAct.EndPos.Y);
        end;
      end;
    WBACT_RECTANGLE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          Brush := MyDrawState.Brush;
          Brush.Style := bsSolid;
          case MyRecBrush of
            0: Brush.Style := bsClear;
            1: Brush.Color := clWhite;
            2: Brush.Color := Pen.Color;
          end;
          Rectangle(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
          Pen.Mode := pmCopy;
          MyAct.EndPos := Point(X, Y);
          MyAct.PenColor := MyDrawState.Pen.Color;
          MyAct.PenWidth := MyDrawState.Pen.Width;
          MyAct.PenStyle := Integer(MyDrawState.Pen.Style);
          MyAct.BrushColor := Brush.Color;
          MyAct.BrushStyle := Integer(Brush.Style);
          MyAct.DataSize := 0;
          DoAct(MyAct, nil);
          SendCurAct;
//          Rectangle(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
        end;
      end;
    WBACT_ELLIPSE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          Brush := MyDrawState.Brush;
          case MyRecBrush of
            0: Brush.Style := bsClear;
            1: Brush.Color := clWhite;
            2: Brush.Color := Pen.Color;
          end;
          Ellipse(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmCopy;
          MyAct.PenColor := MyDrawState.Pen.Color;
          MyAct.PenWidth := MyDrawState.Pen.Width;
          MyAct.PenStyle := Integer(MyDrawState.Pen.Style);
          MyAct.BrushColor := Brush.Color;
          MyAct.BrushStyle := Integer(Brush.Style);
          MyAct.DataSize := 0;
          DoAct(MyAct, nil);
          SendCurAct;
//          Ellipse(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y);
        end;
      end;
    WBACT_ROUNDRECT:
      begin
        with ImgBoard.Canvas do
        begin
          Pen := MyDrawState.Pen;
          Pen.Mode := pmNotXor;
          Brush := MyDrawState.Brush;
          case MyRecBrush of
            0: Brush.Style := bsClear;
            1: Brush.Color := clWhite;
            2: Brush.Color := Pen.Color;
          end;
          RoundRect(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y, 16, 16);
          MyAct.EndPos := Point(X, Y);
          Pen.Mode := pmCopy;
          MyAct.PenColor := MyDrawState.Pen.Color;
          MyAct.PenWidth := MyDrawState.Pen.Width;
          MyAct.PenStyle := Integer(MyDrawState.Pen.Style);
          MyAct.BrushColor := Brush.Color;
          MyAct.BrushStyle := Integer(Brush.Style);
          MyAct.DataSize := 0;
          DoAct(MyAct, nil);
          SendCurAct;
//          RoundRect(MyAct.StartPos.X, MyAct.StartPos.Y, MyAct.EndPos.X, MyAct.EndPos.Y, 16, 16);
        end;
      end;
    WBACT_TEXT:
      begin
        TextEdit := TMemo.Create(Application);
        begin
          TextEdit.OnChange := TextChange;
          TextEdit.BorderStyle := bsSingle;
          TextEdit.Left := X + ImgBoard.Left;
          TextEdit.Top := y + ImgBoard.Top;
          TextEdit.Font := MyDrawState.Font;
          TextEdit.Height := abs(MyDrawState.Font.Height) + 10;
          TextEdit.Width := abs(MyDrawState.Font.Height) + 16;
          TextEdit.WordWrap := false;
          TextEdit.Parent := ImgBoard.Parent;
          TextEdit.Ctl3D := False;
          TextEdit.SetFocus;
        end;
        DrawIng := True;
      end;
  end;
end;

procedure TfrmAnyQWB.tbEraserClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_ERASER;
  MakeEraserCursor;
  ImgBoard.Cursor := crWBEraser;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbFillClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_FILL;
  ImgBoard.Cursor := crWBFill;
  MyDrawState.Brush.Style := bsSolid;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbPenClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_PEN;
  ImgBoard.Cursor := crWBPen;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbTextClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_TEXT;
  ImgBoard.Cursor := crIBeam;
  btnTextFont.Visible := True;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbLineClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_LINE;
  ImgBoard.Cursor := crWBCross;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbEllipseClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_ELLIPSE;
  ImgBoard.Cursor := crWBCross;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbRectangleClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_RECTANGLE;
  ImgBoard.Cursor := crWBCross;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.tbRoundRectClick(Sender: TObject);
begin
  FinishCurrAct;
  MyAct.Act := WBACT_ROUNDRECT;
  ImgBoard.Cursor := crWBCross;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
end;

procedure TfrmAnyQWB.sbClearClick(Sender: TObject);
var
  i: Integer;
begin
  FinishCurrAct;
  MyAct.DataSize := 0;
  MyAct.Act := WBACT_CLEAR;
  DoAct(MyAct, nil);
  SendCurAct;
  for i := 0 to ToolBar1.ButtonCount - 1 do
    if ToolBar1.Buttons[i].Down then
      ToolBar1.Buttons[i].Click;
end;

procedure TfrmAnyQWB.DoAct(Act: TWBACT; ActData: PByte);
var
  i: Integer;
  sl: TStrings;
  x, y, sx, sy, eX, eY, dX, DY, ox, oy: Integer;
  R: TRect;
  s: TMemoryStream;
begin
  if Act.Flag <> 'AnyQ' then
    exit;
  case Act.Act of
    WBACT_CLEAR:
      begin
        with ImgBoard.Canvas do
        begin
          CopyMode := cmWhiteness; { copy everything as white }
          CopyRect(ClipRect, Canvas, ClipRect); { copy bitmap over itself }
          CopyMode := cmSrcCopy; { restore normal mode }
          DrawIng := false;
        end;
      end;
    WBACT_ERASER:
      begin
        with ImgBoard.Canvas do
        begin
          Brush.Color := clWhite;
          Brush.Style := bsSolid;
          x := Act.StartPos.X;
          Y := Act.StartPos.Y;
          sx := x;
          sy := y;
          eX := Act.EndPos.X;
          eY := Act.EndPos.Y;
          Dx := abs(ex - x);
          dy := abs(ey - y);
          ox := 1;
          oy := 1;
          if x > ex then ox := -1;
          if y > ey then oy := -1;
          FillRect(Rect(x - Act.PenWidth div 2, y - Act.PenWidth div 2, x + Act.PenWidth div 2, y + Act.PenWidth div 2));
          while (X <> eX) or (y <> Ey) do
          begin
            if dy > dx then
            begin
              y := y + oy;
              x := sx + round(ox * abs(y - sy) * dx / dy);
            end
            else
            begin
              x := x + ox;
              y := sy + round(oy * abs(x - sx) * dy / dx);
            end;
            FillRect(Rect(x - Act.PenWidth div 2, y - Act.PenWidth div 2, x + Act.PenWidth div 2, y + Act.PenWidth div 2));
          end;
        end;
      end;
    WBACT_PEN, WBACT_LINE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen.Color := Act.PenColor;
          Pen.Width := Act.PenWidth;
          Pen.Style := TPenstyle(Act.PenStyle);
          pen.Mode := pmCopy;
          MoveTo(Act.StartPos.X, Act.StartPos.Y);
          LineTo(Act.EndPos.X, Act.EndPos.Y);
        end;
      end;
    WBACT_FILL:
      begin
        with ImgBoard.Canvas do
        begin
          Brush.Color := Act.BrushColor;
          Brush.Style := bsSolid;
          FloodFill(Act.StartPos.X, Act.StartPos.Y, ImgBoard.Canvas.Pixels[Act.StartPos.X, Act.StartPos.Y], fsSurface);
        end;
      end;
    WBACT_RECTANGLE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen.Color := Act.PenColor;
          Pen.Width := Act.PenWidth;
          Pen.Style := TPenstyle(Act.PenStyle);
          pen.Mode := pmCopy;
          Brush.Color := Act.BrushColor;
          Brush.Style := TBrushStyle(Act.BrushStyle);
          Rectangle(Act.StartPos.X, Act.StartPos.Y, Act.EndPos.X, Act.EndPos.Y);
        end;
      end;
    WBACT_ELLIPSE:
      begin
        with ImgBoard.Canvas do
        begin
          Pen.Color := Act.PenColor;
          Pen.Width := Act.PenWidth;
          Pen.Style := TPenstyle(Act.PenStyle);
          pen.Mode := pmCopy;
          Brush.Color := Act.BrushColor;
          Brush.Style := TBrushStyle(Act.BrushStyle);
          Ellipse(Act.StartPos.X, Act.StartPos.Y, Act.EndPos.X, Act.EndPos.Y);
        end;
      end;
    WBACT_ROUNDRECT:
      begin
        with ImgBoard.Canvas do
        begin
          Pen.Color := Act.PenColor;
          Pen.Width := Act.PenWidth;
          Pen.Style := TPenstyle(Act.PenStyle);
          pen.Mode := pmCopy;
          Brush.Color := Act.BrushColor;
          Brush.Style := TBrushStyle(Act.BrushStyle);
          RoundRect(Act.StartPos.X, Act.StartPos.Y, Act.EndPos.X, Act.EndPos.Y, 16, 16);
        end;
      end;

    WBACT_TEXT:
      begin
        if Act.DataSize <= 1 then exit;
        sl := TStringList.Create;
        sl.Text := PChar(ActData);

        ImgBoard.Canvas.Font.Name := Sl[0];
        sl.Delete(0);
        ImgBoard.Canvas.Font.Color := Act.PenColor;
        ImgBoard.Canvas.Font.Size := Act.PenWidth;
        ImgBoard.Canvas.Font.Style := [];
        ImgBoard.Canvas.Brush.Color := Act.BrushColor;
        ImgBoard.Canvas.Brush.Style := TBrushStyle(Act.BrushStyle);
        if (Act.PenStyle and 1) > 0 then ImgBoard.Canvas.Font.Style := ImgBoard.Canvas.Font.Style + [fsBold];
        if (Act.PenStyle and 2) > 0 then ImgBoard.Canvas.Font.Style := ImgBoard.Canvas.Font.Style + [fsItalic];
        if (Act.PenStyle and 4) > 0 then ImgBoard.Canvas.Font.Style := ImgBoard.Canvas.Font.Style + [fsUnderline];
        if (Act.PenStyle and 8) > 0 then ImgBoard.Canvas.Font.Style := ImgBoard.Canvas.Font.Style + [fsStrikeOut];
        R := Rect(act.StartPos, Act.EndPos);
        DrawText(ImgBoard.Canvas.Handle, pchar(sl.Text), Length(sl.Text), R, DT_NOCLIP);
        ImgBoard.Invalidate;
      end;
    WBACT_PASTE:
      begin
        if Act.DataSize <= 0 then exit;
        s := TMemoryStream.Create;
        s.Write(ActData^, Act.DataSize);
        with TBitmap.Create do
        begin
          S.Seek(0, 0);
          LoadFromStream(s);
          s.Free;
          BitBlt(ImgBoard.Canvas.Handle, Act.StartPos.X, Act.StartPos.Y,
            Act.EndPos.X - Act.StartPos.X, Act.EndPos.Y - Act.StartPos.Y,
            Canvas.Handle, 0, 0, SRCCOPY);
          Free;
          ImgBoard.Invalidate;
        end;
      end;
  end;
end;

procedure TfrmAnyQWB.DoBegin(X, Y: Integer; ISSelf: Boolean);
begin
  if isSelf then begin
    if length(MyActData) < SizeOf(TPoint) then
      setlength(MyActData, SizeOf(TPoint));
    MyAct.StartPos := Point(X, Y);
    MyAct.EndPos := Point(X, Y);
    MyDrawState.Point := Point(X, Y);
  end
  else
  begin

  end;
end;

procedure TfrmAnyQWB.DoInit(InitData: Pointer; ISSelf: Boolean);
begin
  if ISSelf then
  begin

  end
  else
  begin

  end;
end;

procedure TfrmAnyQWB.FormCreate(Sender: TObject);
begin
  inherited;
  Screen.Cursors[crWBPen] := LoadCursor(HInstance, 'CURSOR_PEN');
  Screen.Cursors[crWBCross] := LoadCursor(HInstance, 'CURSOR_CROSS');
  Screen.Cursors[crWBFill] := LoadCursor(HInstance, 'CURSOR_FILL');

  with ImgBoard.Canvas do
  begin
    CopyMode := cmWhiteness; { copy everything as white }
    CopyRect(ClipRect, Canvas, ClipRect); { copy bitmap over itself }
    CopyMode := cmSrcCopy; { restore normal mode }
  end;
  ImgBoard.Cursor := crWBPen;
  MyAct.Flag := 'AnyQ';

  MyDrawState.Pen := TPen.Create;
  MyDrawState.Brush := TBrush.Create;
  MyDrawState.Font := TFont.Create;
  MyDrawState.Pen.Assign(ImgBoard.Canvas.Pen);
  MyDrawState.Brush.Assign(ImgBoard.Canvas.Brush);
  MyDrawState.Font.Assign(ImgBoard.Canvas.Font);
  MyDrawState.Pen.Color := clBlack;
  MyDrawState.Brush.Color := clBlack;

  MyRecBrush := 0;
  MyEraserWidth := 4;
  MyDrawState.Pen.Width := 2;

  MyAct.Act := WBACT_PEN;

  pbColorPick.Refresh;
end;

procedure TfrmAnyQWB.TextChange(Sender: TObject);
var
  linecount: Integer;
  lineidx: Integer;
  Size: TSize;
  DC: HDC;
begin
  linecount := SendMessage(TMemo(Sender).Handle, EM_GETLINECOUNT, 0, 0);
  lineidx := SendMessage(TMemo(Sender).Handle, EM_LINEFROMCHAR, TMemo(Sender).SelStart, 0);
  if linecount * (abs(MyDrawState.Font.Height) + 2) + 8 > TMemo(Sender).Height then
    TMemo(Sender).Height := linecount * (abs(MyDrawState.Font.Height) + 2) + 8;

  DC := GetDC(TMemo(Sender).Handle);
  SelectObject(DC, TMemo(Sender).Font.Handle);
  GetTextExtentPoint32(DC, PChar(TMemo(Sender).Lines[lineidx]), Length(TMemo(Sender).Lines[lineidx]), Size);
  TMemo(Sender).Width := max(TMemo(Sender).Width, Size.cx + 16);
  ReleaseDC(TMemo(Sender).Handle, DC);
end;

procedure TfrmAnyQWB.Init;
var
  iq: TJabberIQ;
  myip: Widestring;
  q: TXMLTag;
  tmp_id: TJabberID;
  tmps: string;
  pri: TJabberPres;
  taskguid: TGUID;
  hosts : TStringList;
  i: integer;
begin
  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);
      Close;
      exit;
    end;
    tmps := pri.fromJID.full;
  end
  else
    tmps := Jid;
  tmp_id.Free;

  CreateGUID(taskguid);
  TaskID := taskguid;

  try
    _Task := TAnyQBaseUDPTask.Create(UDPController, taskguid);
    _Task.OnRcvData := UdpRcv;
    _Task.OnRcvStatus := UdpRcvStatus;
    _Task.OnTimeOut := UdpTimeout;
    _Task.OnFail := UdpFail;
    hosts := TStringList.Create;
    UDPController.GetUDPInfo(hosts);

    iq := TJabberIQ.Create(MainSession, MainSession.generateID, WBCallback, 300);
    with iq do begin
      Namespace := XMLNS_AnyQUDP;
      iqType := 'set';
      toJid := tmps;
      qTag.AddBasicTag('taskid', GUIDToString(_Task.TaskID));
      qTag.AddBasicTag('type', 'whiteboard');
      qTag.AddBasicTag('sync', 'false');
      for i:= 0 to hosts.Count-1 do
        qTag.AddBasicTag('host', hosts[i]);
      Send;
    end;
    hosts.Free;
  except
    InitIBB;
  end;

{
  iq := TJabberIQ.Create(MainSession, MainSession.generateID, WBCallback, 300);
  with iq do begin
    Namespace := XMLNS_IQOOB;
    iqType := 'set';
    toJid := tmps;
    qTag.AddBasicTag('url', 'whiteboard:' + myip);
    qTag.AddBasicTag('desc', '白板');
    Send();
  end;

  frmAnyQ.IdTCPServerW.OnExecute := IdTCPServerWExecute;
  frmAnyQ.IdTCPServerW.OnDisconnect := IdTCPServerWDisConnect;
  frmAnyQ.IdTCPServerW.Active := true;  {}
end;

procedure TfrmAnyQWB.FinishCurrAct;
var
  i: integer;
begin
  if DrawIng then
  begin
    DrawIng := False;
    case MyAct.Act of
      WBACT_TEXT:
        begin
          if TextEdit <> nil then
          begin
            MyAct.EndPos.X := MyAct.StartPos.X + TextEdit.ClientWidth - 12;
            MyAct.EndPos.Y := MyAct.StartPos.Y + TextEdit.ClientHeight - 4;
            MyAct.PenColor := TextEdit.Font.Color;
            MyAct.PenWidth := TextEdit.Font.Size;
            MyAct.PenStyle := 0;
            if fsBold in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 1;
            if fsItalic in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 2;
            if fsUnderline in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 4;
            if fsStrikeOut in TextEdit.Font.Style then MyAct.PenStyle := MyAct.PenStyle and 8;
            MyAct.BrushColor := clWhite;
            MyAct.BrushStyle := BS_SOLID;
            MyAct.DataSize := length(TextEdit.Font.Name) + 2 + length(TextEdit.Lines.Text) + 1;
            SetLength(MyActData, MyAct.DataSize);
            StrCopy(Pchar(@MyActData[0]), Pchar(TextEdit.Font.Name + #13 + #10 + TextEdit.Lines.Text + #0));
            DoAct(MyAct, @MyActData[0]);

            TextEdit.Free;
            TextEdit := nil;
            SendCurAct;
            for i := 0 to ToolBar1.ButtonCount - 1 do
              if ToolBar1.Buttons[i].Down then
                ToolBar1.Buttons[i].Click;
          end;
        end;
      WBACT_PASTE:
        begin
          if PasteImg <> nil then
          begin
            MyAct.StartPos.X := Pastepnl.Left + ImgBoard.Left;
            MyAct.StartPos.Y := Pastepnl.Top + ImgBoard.Top;
            MyAct.EndPos.X := MyAct.StartPos.X + PasteImg.ClientWidth;
            MyAct.EndPos.Y := MyAct.StartPos.Y + PasteImg.ClientHeight;

            DoAct(MyAct, @MyActData[0]);
//            BitBlt(ImgBoard.Canvas.Handle, MyAct.StartPos.x,MyAct.StartPos.y,
//                PasteImg.Width, PasteImg.Height, PasteImg.Canvas.Handle,0,0,SRCCOPY);

            PasteImg.Free;
            PasteImg := nil;
            Pastepnl.Free;
            Pastepnl := nil;
            SendCurAct;
            for i := 0 to ToolBar1.ButtonCount - 1 do
              if ToolBar1.Buttons[i].Down then
                ToolBar1.Buttons[i].Click;
          end;
        end;
    end; {}
  end;
end;

procedure TfrmAnyQWB.tbCapWindowClick(Sender: TObject);
var
  s: TStream;
  bmp: TBitmap;
begin
  FinishCurrAct;
  MyAct.Act := WBACT_PASTE;
  ImgBoard.Cursor := crArrow;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
  Hide;
  S := WBCaptureScreen(CMWindow);
  Show;
  if S.Size = 0 then exit;
  bmp := TBitmap.Create;
  s.Seek(0, 0);
  bmp.LoadFromStream(s);
  MyAct.DataSize := s.size;
  SetLength(MyActData, s.size);
  s.Seek(0, 0);
  S.Read(MyActData[0], s.size);
  s.Free;
  PasteImg := TImage.Create(Application);
  PasteImg.Width := bmp.Width;
  PasteImg.Height := bmp.Height;
  PasteImg.Picture.Assign(bmp);
  Bmp.Free;
  Pastepnl := TPanel.Create(Application);
  Pastepnl.Width := PasteImg.Width;
  Pastepnl.Height := PasteImg.Height;
  Pastepnl.BevelInner := bvNone;
  Pastepnl.BevelOuter := bvNone;
  Pastepnl.Parent := ImgBoard.Parent;
  Pastepnl.OnMouseDown := PastepnlMouseDown;
  PasteImg.OnMouseDown := PastepnlMouseDown;
  PasteImg.Parent := Pastepnl;
  DrawIng := true;
end;

procedure TfrmAnyQWB.tbCapRectClick(Sender: TObject);
var
  s: TStream;
  bmp: TBitmap;
begin
  FinishCurrAct;
  MyAct.Act := WBACT_PASTE;
  ImgBoard.Cursor := crArrow;
  btnTextFont.Visible := False;
  pbColorPick.Refresh;
  pbStyle.Refresh;
  Hide;
  S := WBCaptureScreen(CMRect);
  Show;
  if S.Size = 0 then exit;
  bmp := TBitmap.Create;
  s.Seek(0, 0);
  bmp.LoadFromStream(s);
  MyAct.DataSize := s.size;
  SetLength(MyActData, s.size);
  s.Seek(0, 0);
  S.Read(MyActData[0], s.size);
  s.Free;
  PasteImg := TImage.Create(Application);
  PasteImg.Width := bmp.Width;
  PasteImg.Height := bmp.Height;
  PasteImg.Picture.Assign(bmp);
  Bmp.Free;
  Pastepnl := TPanel.Create(Application);
  Pastepnl.Width := PasteImg.Width;
  Pastepnl.Height := PasteImg.Height;
  Pastepnl.BevelInner := bvNone;
  Pastepnl.BevelOuter := bvNone;
  Pastepnl.Parent := ImgBoard.Parent;
  Pastepnl.OnMouseDown := PastepnlMouseDown;
  PasteImg.OnMouseDown := PastepnlMouseDown;
  PasteImg.Parent := Pastepnl;
  DrawIng := true;
end;

procedure TfrmAnyQWB.PastepnlMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
const
  sc_dragmove = $F012;
begin
  releasecapture;
  Pastepnl.perform(wm_syscommand, sc_dragmove, 0);
end;

procedure TfrmAnyQWB.SendCurAct;
var
  i: Integer;
  List: TList;
  Buf: array of Byte;
begin
  if SendByIBB then
  begin
    sendCurActByIBB;
  end
  else
  begin
    setlength(Buf, sizeof(MyAct)+MyAct.DataSize);
    Move(MyACT, BUF[0], sizeof(MyAct));
    Move(MyActData[0], BUF[sizeof(MyAct)], MyAct.DataSize);
    _task.SendData(BUF[0], sizeof(MyAct)+MyAct.DataSize);

{    _task.SendData(MyACT, sizeof(MyAct));
    _task.SendData(MyActData[0], MyAct.DataSize);

{    if frmAnyQ.IdTCPServerW.Active then
    begin
      List := frmAnyQ.IdTCPServerW.Threads.LockList;
      try
        for i := 0 to List.Count - 1 do
        try
          TIdPeerThread(List.Items[i]).Connection.WriteBuffer(MyACT, sizeof(MyAct), false);
          if MyAct.DataSize > 0 then
            TIdPeerThread(List.Items[i]).Connection.WriteBuffer(MyActData[0], MyAct.DataSize, True);
        except
          TIdPeerThread(List.Items[i]).Stop;
        end;
      finally
        frmAnyQ.IdTCPServerW.Threads.UnlockList;
      end;
    end
    else
      if frmAnyQ.IdTCPClientW.Connected then
      begin
        frmAnyQ.IdTCPClientW.WriteBuffer(MyACT, sizeof(MyAct), false);
        if MyAct.DataSize > 0 then
          frmAnyQ.IdTCPClientW.WriteBuffer(MyActData[0], MyAct.DataSize, True);
      end;{}
  end;
end;

procedure TfrmAnyQWB.WBCallback(event: string; tag: TXMLTag);
var
  errtag: TXMLTag;
begin
  Enabled := true;
  Caption := '白板';
  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
          begin
            initIBB;
            exit;
          end
          else
            if GetAttribute('code') = '406' then
              ShowRiserWindow(nil, '对方拒绝与您使用白板！', ico_info)
            else
              ShowRiserWindow(nil, '对方无法与您使用白板！', ico_info);
          Close;
          exit;
        end;
    end;

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

procedure TfrmAnyQWB.InitIBB;
begin
  SendByIBB := true;
end;

procedure TfrmAnyQWB.FormDestroy(Sender: TObject);
begin
  inherited;
  if TextEdit <> nil then
    FreeAndNil(TextEdit);
  if PasteImg <> nil then
    FreeAndNil(PasteImg);
  if Pastepnl <> nil then
    FreeAndNil(Pastepnl);
  if UDPController<>nil then
    if _task<> nil then
      FreeAndNil(_task);

{  if frmAnyQ.IdTCPClientW.Connected then
  begin
    frmAnyQ.IdTCPClientW.Disconnect;
  end;
  if frmAnyQ.IdTCPServerW.Active then
  begin
    frmAnyQ.IdTCPServerW.Active := false;
    frmAnyQ.IdTCPServerW.OnExecute := nil;
  end; {}
end;

procedure TfrmAnyQWB.IdTCPServerWDisConnect(AThread: TIdPeerThread);
begin
//

end;

procedure TfrmAnyQWB.IdTCPServerWExecute(AThread: TIdPeerThread);
var
  Act: TWBACT;
  ACTData: array of Byte;
begin
  AThread.Connection.ReadBuffer(Act, sizeof(Act));
  if Act.DataSize > 0 then
  begin
    setlength(ACTData, Act.DataSize);
    AThread.Connection.ReadBuffer(ACTData[0], Act.DataSize);
  end;

  DoAct(ACT, @ACTdata[0]);
  application.ProcessMessages;
end;

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

procedure TfrmAnyQWB.connecturl(url: widestring);
var
  iq, q: TXMLTag;
  IP: widestring;
begin
  Ip := Url;
  Delete(IP, 1, 11);
{  frmAnyQ.IdTCPClientW.Host := IP;
  try
    frmAnyQ.IdTCPClientW.Connect(15000);

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

    iq := TXMLTag.Create('iq');
    iq.setAttribute('to', jid);
    iq.setAttribute('type', 'result');
    iq.setAttribute('id', reqID);
    MainSession.SendTag(iq);
    Enabled := true;
    Caption := '白板';
  except
    iq := TXMLTag.Create('iq');
    with iq do begin
      setAttribute('to', JID);
      setAttribute('id', reqID);
      setAttribute('type', 'error');
      AddBasicTag('error', '用户无法直接连接').setAttribute('code', '404');
    end;
    MainSession.SendTag(iq);
    SendByIBB := true;
    Enabled := true;
    Caption := '白板';
  end;{}
end;

procedure TfrmAnyQWB.sendnotstart;
var
  iq: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  with iq do begin
    setAttribute('to', JID);
    setAttribute('id', reqID);
    setAttribute('type', 'error');
    AddBasicTag('error', '用户无法启用白板').setAttribute('code', '405');
  end;
  MainSession.SendTag(iq);
end;

{ TClientHandleThread }
{
procedure TClientHandleThread.Draw;
begin
  frmAnyQWB.DoAct(Act, @Actdata[0]);
end;

procedure TClientHandleThread.Execute;
begin
  while not Terminated do
  begin
    if not frmAnyQ.IdTCPClientW.Connected then
    begin
      Terminate;
    end
    else
    try
      frmAnyQ.IdTCPClientW.ReadBuffer(Act, sizeof(Act));
      if Act.DataSize > 0 then
      begin
        setlength(ACTData, Act.DataSize);
        frmAnyQ.IdTCPClientW.ReadBuffer(ACTData[0], Act.DataSize);
      end;

      Synchronize(Draw);
    except
    end;
  end;
  ClientHandleThread := nil;
end;
{}
procedure TfrmAnyQWB.sendCurActByIBB;
var
  EnCoder: TIdEncoderMIME;
  _iq: TXMLTag;
  buf: array of byte;
  bufsize: integer;
  bufpos: Integer;
  CM: TMemoryStream;
  sending: Boolean;
  seqNo: cardinal;
  seqCount: cardinal;
  Buffer: string;
begin
  BufSize := Sizeof(MyAct) + MyAct.DataSize;
  setlength(Buf, BufSize);
  Move(MyACt, Buf[0], Sizeof(MyAct));
  Move(MyActDAta[0], Buf[Sizeof(MyAct)], MyAct.DataSize);

  seqNo := 0;
  seqCount := BufSize div (4096 * 3 div 4);
  if (BufSize * 4) mod (4096 * 3) <> 0 then
    inc(seqCount);

  _iq := TXMLTag.Create('iq');
  _iq.setAttribute('id', MainSession.generateID());
  _iq.setAttribute('type', 'set');
  _iq.setAttribute('to', JID);
  bufpos := 0;
  repeat
    with _iq.AddTag('query') do
    begin
      setAttribute('xmlns', XMLNS_IBB);
      setAttribute('sid', 'whiteboard');
      setAttribute('seq', inttostr(seqNo));
      setAttribute('totalseq', inttostr(seqcount));
      with AddTag('taskinfo') do
        setAttribute('tasktype', 'whiteboard');

      EnCoder := TIdEncoderMIME.Create(nil);

      CM := TMemoryStream.Create;
      bufpos := bufpos + cm.Write(buf[bufPos], min(4096, bufsize - bufpos));
      cm.Seek(0, soFromBeginning);

      Buffer := EnCoder.Encode(cm);
      CM.Free;
      EnCoder.Free;
      with AddTag('data') do
      begin
        AddCData(copy(Buffer, 1, length(Buffer)));
      end;
      inc(seqNo);
      if seqNo >= seqcount then
        AddTag('close');
    end;
    MainSession.SendTag(_iq);

    Application.ProcessMessages;
  until seqNo >= seqcount;
end;

procedure TfrmAnyQWB.UdpRcv(sender: TObject; Adata: TStream);
var
  Buf: array of Byte;
  decsize: integer;
begin
  if Adata.Size <= 0 then
    exit;
  AData.Seek(0,0);

  if not _ReadData then
  begin
    if Adata.Size >= sizeof(_Act) then
    begin
      Adata.Read(_Act, sizeof(_Act));
      if _Act.Flag <> 'AnyQ' then
        exit;
      SetLength(_ActData, _Act.DataSize);
      _ReadSize := Adata.Read(_ActData[0], _Act.DataSize);
      _ReadData := _Act.DataSize > _ReadSize;
      if not _ReadData then
        DoAct(_ACT, @_ACTdata[0]);
    end;
  end
  else
  begin
    if _ReadSize + Adata.Size <= _Act.DataSize then
      Adata.Read(_ActData[_ReadSize], Adata.Size);
    _ReadSize := _ReadSize + Adata.Size;
    if _ReadSize>= _Act.DataSize then
    begin
      _ReadData := false;
      if _ReadSize > _Act.DataSize then
        exit;
      DoAct(_ACT, @_ACTdata[0]);
      application.ProcessMessages;
    end;
  end;
{  if _ReadData

      begin
        setlength(ACTData, Act.DataSize);
        AThread.Connection.ReadBuffer(ACTData[0], Act.DataSize);
      end;
    end;


  DoAct(ACT, @ACTdata[0]);
  application.ProcessMessages;
{}
end;

procedure TfrmAnyQWB.SendReady;
var
  iq, q: TXMLTag;
begin
  iq := TXMLTag.Create('iq');
  iq.setAttribute('to', jid);
  iq.setAttribute('type', 'result');
  iq.setAttribute('id', reqID);
  MainSession.SendTag(iq);
  Enabled := true;
  Caption := '白板';
end;

procedure TfrmAnyQWB.UdpFail(sender: TObject);
var
  hosts: TStringList;
  iq: TXMLTag;
  i: integer;
begin
  if TAnyQBaseUDPTask(Sender).Status='connected' then
  begin
    if IsCaller then
      InitIBB
    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(_Task.TaskID));
          for i:= 0 to hosts.Count-1 do
            AddBasicTag('host', hosts[i]);
        end;
      end;
      hosts.Free;
      MainSession.SendTag(iq);
    end;
  end
  else
  begin
    if not (TAnyQBaseUDPTask(Sender).Sending or TAnyQBaseUDPTask(Sender).Receiving) then
      exit;
    ShowRiserWindow(nil, '连接中断,白板终止', ico_info);
    Close;
  end;
end;

procedure TfrmAnyQWB.UdpRcvStatus(sender: TObject);
begin

end;

procedure TfrmAnyQWB.UdpTimeout(Sender: TObject);
begin

end;

end.
