unit BroadcastMsg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, RichEdit2, ExRichEdit, fRosterTree, ExtCtrls,
  TntStdCtrls, Dockable, ToolWin, ImgList;

type
  TfrmBroadcastMsg = class(TfrmDockable)
    GroupBox1: TGroupBox;
    Panel1: TPanel;
    frameTreeRoster1: TframeTreeRoster;
    Panel2: TPanel;
    Panel3: TPanel;
    txtMsg: TExRichEdit;
    Button1: TButton;
    Button2: TButton;
    lblSubject1: TLabel;
    txtSendSubject: TTntMemo;
    Label1: TLabel;
    Panel4: TPanel;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    ToolButton6: TToolButton;
    cboFontName: TComboBox;
    ToolButton7: TToolButton;
    cboFontSize: TComboBox;
    ToolButton8: TToolButton;
    BoldButton: TToolButton;
    ItalicButton: TToolButton;
    UnderlineButton: TToolButton;
    ToolButton9: TToolButton;
    ColorBox1: TColorBox;
    ToolButton4: TToolButton;
    EmoticonsButton: TToolButton;
    ToolbarImages: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure txtMsgSelectionChange(Sender: TObject);
    procedure cboFontNameChange(Sender: TObject);
    procedure cboFontSizeChange(Sender: TObject);
    procedure BoldButtonClick(Sender: TObject);
    procedure ItalicButtonClick(Sender: TObject);
    procedure UnderlineButtonClick(Sender: TObject);
    procedure ColorBox1Change(Sender: TObject);
    procedure EmoticonsButtonClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);

  private
    { Private declarations }
    _thread: string; // thread for conversation
    _Updateing: Boolean;
    procedure GetFontNames;
    function CurrText: TTextAttributes98;
    procedure SendMsg(L: TList);
    function GetThread(jid: widestring): string;
  public
    { Public declarations }
    ComController: TObject;
    procedure SetEmoticon(msn: boolean; imgIndex: integer);
  end;

var
  frmBroadcastMsg: TfrmBroadcastMsg;

implementation

{$R *.dfm}
uses GnuGetText, Emoticons, math, MsgDisplay, Jabber1, JabberMsg, XMLTag,
  ExUtils, ExSession, Session, Roster, JabberConst, XMLUtils, COMChatController,
  RiserWindow;

function TfrmBroadcastMsg.CurrText: TTextAttributes98;
begin
  if txtMsg.SelLength > 0 then Result := txtMsg.SelAttributes
  else Result := txtMsg.DefAttributes;
end;

procedure TfrmBroadcastMsg.FormCreate(Sender: TObject);
var
  i: integer;
  echat: TAnyQChat;
begin
  TranslateProperties(Self);

  _thread := '';

  frameTreeRoster1.Initialize();
  frameTreeRoster1.DrawRoster(False);

  GetFontNames;
  cboFontName.ItemIndex := cboFontName.Items.IndexOf(txtMsg.Font.Name);
  for i := 6 to 32 do
  begin
    cboFontSize.Items.Add(IntToStr(i));
  end;
  cboFontSize.ItemIndex := cboFontSize.Items.IndexOf(IntToStr(txtMsg.Font.Size));

    // COM interface for this MsgWindow
  echat := TAnyQChat.Create();
//    echat.setIM(Self);
  echat.ObjAddRef();
  ComController := echat;
end;

function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
  FontType: Integer; Data: Pointer): Integer; stdcall;
begin
  TStrings(Data).Add(LogFont.lfFaceName);
  Result := 1;
end;

procedure TfrmBroadcastMsg.GetFontNames;
var
  DC: HDC;
begin
  DC := GetDC(0);
  EnumFonts(DC, nil, @EnumFontsProc, Pointer(cboFontName.Items));
  ReleaseDC(0, DC);
  cboFontName.Sorted := True;
end;

procedure TfrmBroadcastMsg.txtMsgSelectionChange(Sender: TObject);
begin
  _Updateing := True;
  cboFontName.ItemIndex := cboFontName.items.indexof(txtMsg.SelAttributes.Name);
  cboFontSize.ItemIndex := cboFontSize.Items.indexof(IntToStr(txtMsg.SelAttributes.size));
  BoldButton.Down := fsBold in txtMsg.SelAttributes.Style;
  ItalicButton.Down := fsItalic in txtMsg.SelAttributes.Style;
  UnderlineButton.Down := fsUnderline in txtMsg.SelAttributes.Style;
  ColorBox1.Selected := txtMsg.SelAttributes.Color;
  _Updateing := False;
end;

procedure TfrmBroadcastMsg.cboFontNameChange(Sender: TObject);
begin
  if _Updateing then
    Exit;
  CurrText.Name := cboFontName.Text
end;

procedure TfrmBroadcastMsg.cboFontSizeChange(Sender: TObject);
begin
  if _Updateing then
    Exit;
  CurrText.Size := strtoint(cboFontSize.Text);
end;

procedure TfrmBroadcastMsg.BoldButtonClick(Sender: TObject);
begin
  if _Updateing then
    Exit;
  if BoldButton.Down then
    CurrText.Style := CurrText.Style + [fsBold]
  else
    CurrText.Style := CurrText.Style - [fsBold]
end;

procedure TfrmBroadcastMsg.ItalicButtonClick(Sender: TObject);
begin
  if _Updateing then
    Exit;
  if ItalicButton.Down then
    CurrText.Style := CurrText.Style + [fsItalic]
  else
    CurrText.Style := CurrText.Style - [fsItalic];
end;

procedure TfrmBroadcastMsg.UnderlineButtonClick(Sender: TObject);
begin
  if _Updateing then
    Exit;
  if UnderlineButton.Down then
    CurrText.Style := CurrText.Style + [fsUnderline]
  else
    CurrText.Style := CurrText.Style - [fsUnderline];
end;

procedure TfrmBroadcastMsg.ColorBox1Change(Sender: TObject);
begin
  if _Updateing then
    Exit;
  CurrText.Color := ColorBox1.Selected;
end;

procedure TfrmBroadcastMsg.EmoticonsButtonClick(Sender: TObject);
var
  l, t: integer;
  cp: TPoint;
begin
    // Show the emoticons form
  cp := Point(EmoticonsButton.Width, EmoticonsButton.Height);
  cp := EmoticonsButton.ClientToScreen(cp);
  t := cp.Y;
  l := max(0, cp.X - frmEmoticons.Width);
  if ((t + frmEmoticons.Height) > Screen.Height) then
    t := Screen.Height - frmEmoticons.Height - EmoticonsButton.Height;

  frmEmoticons.Top := t;
  frmEmoticons.Left := l;
  frmEmoticons.OnSetEmoticon := SetEmoticon;
//    frmEmoticons.ChatWindow := Self;
  frmEmoticons.Show;
end;

procedure TfrmBroadcastMsg.SetEmoticon(msn: boolean; imgIndex: integer);
var
  l, i, m: integer;
  eo: TEmoticon;
begin
    // Setup some Emoticon
  m := -1;

  if (emoticon_list.Count = 0) then
    ConfigEmoticons();

  for i := 0 to emoticon_list.Count - 1 do begin
    eo := TEmoticon(emoticon_list.Objects[i]);
    if (((msn) and (eo.il = frmAnyQ.imgMSNEmoticons)) or
      ((not msn) and (eo.il = frmAnyQ.imgYahooEmoticons))) then begin
            // the image lists match
      if (eo.idx = imgIndex) then begin
        m := i;
        break;
      end;
    end;
  end;

  if (m >= 0) then begin
    l := length(txtMsg.Text);
    if ((l > 0) and ((txtMsg.Text[l]) <> ' ')) then
      txtMsg.SelText := ' ';
    txtMsg.SelText := emoticon_list[m];
  end;
end;

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

procedure TfrmBroadcastMsg.Button1Click(Sender: TObject);
var
  l: Tlist;
  txt: widestring;
begin
  txt := txtMsg.WideLines.Text;
  if txt = '' then
  begin
    ShowRiserWindow(nil, '请输入广播内容', ico_info);
    abort;
    //raise Exception.Create('请输入广播内容');
  end;

  if (ComController <> nil) then
    TAnyQChat(ComController).fireBeforeMsg(txt);

  if txt = '' then exit;

  l := frameTreeRoster1.GetCheckedList;
  if l.Count = 0 then
  begin
    L.free;
    ShowRiserWindow(nil, '请选择广播对象', ico_info);
    abort;
    //Raise Exception.Create('请选择广播对象');
  end;

  SendMsg(l);
  L.free;
  Close;
end;

procedure TfrmBroadcastMsg.SendMsg(L: TList);
var
  x2, xml, txt: WideString;
  msg: TJabberMessage;
  mtag: TXMLTag;
  i: Integer;
begin
  txt := getInputText(txtMsg);

  if (txt = '') then exit;

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

    //add rtf
  txtSendSubject.SetFocus;
  txtMsg.SetFocus;

  txtMsg.SelStart := 0;
  txtMsg.SelLength := Length(txt);
  Msg.rtf := txtMsg.RTFSelText;

  Msg.Subject := txtSendSubject.Lines.Text;

  msg.id := MainSession.generateID();

  for i := 0 to L.Count - 1 do
  begin
    Msg.ToJID := TJabberRosterItem(L.Items[i]).jid.full;
    msg.thread := GetThread(Msg.ToJID);

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

      // plugin stuff
    if (ComController <> nil) then
      x2 := TAnyQChat(ComController).fireAfterMsg(txt);
    if (x2 <> '') then
      mtag.addInsertedXML(x2);

    if (xml <> '') then
      mtag.addInsertedXML(xml);

    MainSession.SendTag(mtag);

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

  Msg.Free();
end;

function TfrmBroadcastMsg.GetThread(jid: widestring): 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 TfrmBroadcastMsg.Button2Click(Sender: TObject);
begin
  Close;
end;

end.

