chatroomunit.~pas

企业通comicq是一个通讯工具软件,一个通讯工具软件

unit ChatRoomUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, CheckLst, ComCtrls, ExtCtrls, Menus;

type
  TChatRoomForm = class(TForm)
    StatusBar: TStatusBar;
    Panel1: TPanel;
    Panel2: TPanel;
    ChatEdit: TEdit;
    cbUserList: TComboBox;
    ChatMsgRichEdit: TRichEdit;
    cbStyle: TComboBox;
    UserListBox: TListBox;
    Splitter1: TSplitter;
    btnSend: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    PrivateChatCheckBox: TCheckBox;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure UserListBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure UserListBoxDblClick(Sender: TObject);
    procedure ChatEditKeyPress(Sender: TObject; var Key: Char);
    procedure btnSendClick(Sender: TObject);
    procedure N1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    NickName:String;
    UserInRoomList:TStringList;
    function  FindIP(const IP:String):Integer;
    function  GetNickNameByIP(const IP:string):String;
    procedure InitUserInfo;
  end;

var
  ChatRoomForm: TChatRoomForm;

implementation

{$R *.DFM}

procedure TChatRoomForm.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
MainForm.InChatRoom:=False;
MainForm.SendOutRoomMsg;
Action:=caFree;
end;

procedure TChatRoomForm.UserListBoxMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
var
  i:Integer;
  UserName,UserIP,s:String;
begin
{加入下面代码，可以在鼠标移以用户昵称上方时显示用户的IP和机器名，
但是我的同事表示强烈的反对，所以我把它们注释掉了，各位可以根据情况
自己决定取舍}
{i:=UserListBox.ItemAtPos(Point(X,Y),True);
if i=-1 then
  UserListBox.Hint:='聊天室用户'
else
  begin
  s:=UserInRoomList.Strings[i];
  UserIP:=Copy(s,1,IPLen);
  UserName:=MainForm.GetComputerNameByIP(UserIP);
  UserListBox.Hint:='机器名：'+UserName+#13#10+'IP：'+UserIP;
  end;}
end;

procedure TChatRoomForm.FormCreate(Sender: TObject);
begin
UserInRoomList:=TStringList.Create;
InitUserInfo;
cbUserList.ItemIndex:=0;
end;

procedure TChatRoomForm.FormDestroy(Sender: TObject);
begin
UserInRoomList.Free;
end;

procedure TChatRoomForm.UserListBoxDblClick(Sender: TObject);
var
  i:Integer;
begin
i:=UserListBox.ItemIndex;
cbUserList.ItemIndex:=i;
end;

function TChatRoomForm.FindIP(const IP: String): Integer;
//在UserInRoomList中查找指定IP
var
  i:Integer;
begin
Result:=-1;
for i:=0 to UserInRoomList.Count-1 do
  begin
  if Trim(UserInRoomList.Strings[i])=Trim(IP) then
    begin
    Result:=i;
    Exit;
    end;
  end;
end;

procedure TChatRoomForm.InitUserInfo;
//初始化用户信息
begin
UserInRoomList.Clear;
UserListBox.Clear;
cbUserList.Clear;
UserInroomList.Add(MainForm.BroadCastIP);
UserListBox.Items.Add('所有人');
cbUserList.Items.Add('所有人');
end;

procedure TChatRoomForm.ChatEditKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
  btnSend.Click;
end;

function TChatRoomForm.GetNickNameByIP(const IP: string): String;
var
  i:Integer;
begin
Result:='';
i:=FindIP(IP);
if i>=0 then
  begin
  Result:=UserlistBox.Items[i];
  end;
end;

procedure TChatRoomForm.btnSendClick(Sender: TObject);
var
  IP,Msg:String;
  i:Integer;
begin
if ChatEdit.Text='' then
  begin
  MessageBox(0,'请先输入你想说的话！','干嘛呢，你？',MB_ICONINFORMATION+MB_OK);
  exit;
  end;
i:=cbColor.ItemIndex;
Msg:='['+NickName+'] '+cbStyle.Text+' 对 ['+cbUserList.Text+'] 说:'+ChatEdit.Text;
Msg:=Format('%-2s',[IntToStr(i)])+Msg;
if PrivateChatCheckBox.Checked then
  begin
  IP:=UserInRoomList.Strings[cbUserList.itemindex];
  MainForm.SendMsg(IP,Msg);
  MainForm.SendMsg(MainForm.LocalIP,Msg);
  end
else
  MainForm.SendChatRoomMsg(MainForm.BroadCastIP,Msg);
  
ChatEdit.Clear;
end;

procedure TChatRoomForm.N1Click(Sender: TObject);
begin
ChatMsgRichEdit.Clear;
end;

end.