main.pas

局域网聊天程序

        end;
      end;
    end;
  end;
end;

procedure Tfrm_main.SendOnLine;
var
  CLine:array[1..127]of Char;
  tmpStr:String;
  I:Integer;
begin
  tmpStr:='2'+LuckName;
  for i:=1 to Length(tmpStr) do
    CLine[i]:=tmpStr[i];
  NMUDP_Chat.SendBuffer(CLine,Length(TmpStr));
end;

procedure Tfrm_main.SendOffLine;
var
  CLine:array[1..127]of Char;
  tmpStr:String;
  I:Integer;
begin
  tmpStr:='3'+LuckName;
  for i:=1 to Length(tmpStr) do
    CLine[i]:=tmpStr[i];
  NMUDP_Chat.SendBuffer(CLine,Length(TmpStr));
end;

procedure Tfrm_main.FormShow(Sender: TObject);
begin
  RE_Chat.Paragraph.Alignment:=taCenter;
//  RE_Chat.SelAttributes.Size:=11;
  RE_Chat.Lines.Add('欢迎来到无需服务器的局域网聊天室');
//  RE_Chat.SelAttributes.Size:=9;
  RE_Chat.Lines.Add('版本：1.1 - 支持表情');
  RE_Chat.Paragraph.Alignment:=taLeftJustify;
//  RE_Chat.SelAttributes.Color:=clYellow;

  with Tinifile.Create(GetExePath+'Chat.ini')do
  begin
    HostName:=ReadString('SysInfo','HostName','192.168.0.255');//'localhost';
    HostPort:=ReadInteger('SysInfo','HostPort',5656);
    LuckName:=ReadString('SysInfo','LuckName','Guest');
    Top:=ReadInteger('SysInfo','Top',Top);
    Left:=ReadInteger('SysInfo','Left',Left);
    Width:=ReadInteger('SysInfo','Width',Width);
    Height:=ReadInteger('SysInfo','Height',Height);
  end;
  NMUDP_Chat.ReportLevel := Status_Basic;
  NMUDP_Chat.RemoteHost:=HostName;
  NMUDP_Chat.RemotePort:=HostPort;
  NMUDP_Chat.LocalPort:=HostPort;

  Edit_LuckName.Text:=LuckName;
  SendOnLine;
  Edit_Chat.SetFocus;
end;

function Tfrm_main.Emote:Boolean;
var
  SourceStr:String;
  DestStr:String;
  EmoteS:TStringList;
  ReceverName:String;
  CChat:array[1..255]of Char;
  tmpStr,eStr,mStr,moteStr:String;
  I,tmpi:Integer;
begin
  Result:=false;
  SourceStr:=Edit_Chat.Text+' ';
  DestStr:=Copy(SourceStr,1,2);
  if DestStr='/e' then
  begin
    EmoteS:=TStringList.Create;
    try
      with TInifile.Create(GetExePath+'emotes.emt')do
      begin
        ReadSection('emote',EmoteS);
        RE_Chat.Lines.Add(#13);
        RE_Chat.Lines.Add('显示表情符号(//<表情符号>[<空格>附加语句])：');
        RE_Chat.Lines.Append(EmoteS.CommaText);
        RE_Chat.Lines.Add(#13);
        Edit_Chat.Text:=#0;
      end;
    finally
      EmoteS.Free;
    end;
    Result:=True;
  end;
  if DestStr='//' then
  begin
    tmpi:=Pos(' ',SourceStr);
    eStr:=Copy(SourceStr,3,tmpi-3);
    mStr:=Copy(SourceStr,tmpi+1,Length(SourceStr)-tmpi-1);
    ReceverName:=Edit_Who.Text;
    with TInifile.Create(GetExePath+'emotes.emt')do
    begin
      if ReceverName<>'' then
      begin
        tmpStr:=ReadString('emote_rec',eStr,'');
        moteStr:=FastReplace(tmpStr,'<Receiver>',ReceverName,false);
      end else
      begin
        moteStr:=ReadString('emote',eStr,'');
      end;
      if moteStr<>'' then
      begin
        tmpStr:='1'+LuckName+moteStr+' '+mStr;
        for i:=1 to Length(tmpStr) do
          CChat[i]:=tmpStr[i];
        NMUDP_Chat.SendBuffer(CChat,Length(TmpStr));
      end else
      begin
        RE_Chat.Lines.Add('对不起，表情符号//'+eStr+'看不懂！');
        Edit_Chat.Clear;
      end;
      Result:=True;
    end;  
  end;
end;

procedure Tfrm_main.BB_SendClick(Sender: TObject);
var
  CChat:array[1..255]of Char;
  tmpStr:String;
  I:Integer;
Begin
  if Edit_Chat.Text<>'' then
  begin
    if Emote then
    begin
      exit;
    end;
    if Edit_Who.Text='' then tmpStr:='1'+LuckName+'：'+Edit_Chat.Text
    else if Edit_Who.Text<>LuckName then tmpStr:='1'+LuckName+'对'+Edit_Who.Text+'说：'+Edit_Chat.Text
    else tmpStr:='1'+LuckName+'自言自语道：'+Edit_Chat.Text;
    for i:=1 to Length(tmpStr) do
      CChat[i]:=tmpStr[i];
    NMUDP_Chat.SendBuffer(CChat,Length(TmpStr));
  end else
    Showmessage('不好意思！消息为空不能发送！');
end;

procedure Tfrm_main.Edit_ChatKeyPress(Sender: TObject; var Key: Char);
begin
  If Key = #13 then
  Begin
    SB_SendClick(Sender);
  End;
end;

procedure Tfrm_main.CLB_UserListDblClick(Sender: TObject);
begin
  Edit_Who.Text:=CLB_UserList.Items.Strings[CLB_UserList.ItemIndex];
  Edit_Chat.SetFocus;
  Edit_Chat.SelStart:=Length(Edit_Chat.Text);
end;

procedure Tfrm_main.FormDblClick(Sender: TObject);
begin
  {if WindowState=wsMaximized then
    WindowState:=wsNormal;}
end;

procedure Tfrm_main.Edit_LuckNameKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
    if Edit_LuckName.Text<>LuckName then
    begin
      SendOffLine;
      LuckName:=Edit_LuckName.Text;
      SendOnLine;
    end;
end;

procedure Tfrm_main.PopItem_PasteUserNameClick(Sender: TObject);
begin
  Edit_Chat.Text:=Edit_Chat.Text+CLB_UserList.Items.Strings[CLB_UserList.ItemIndex];
  Edit_Chat.SetFocus;
  Edit_Chat.SelStart:=Length(Edit_Chat.Text);
end;

procedure Tfrm_main.CLB_UserListMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  if (Button=mbRight)and(CLB_UserList.ItemIndex<>-1)then
  begin
    if CLB_UserList.Checked[CLB_UserList.ItemIndex] then
    begin
      PopItem_IP.Tag:=1;
      PopItem_IP.Caption:='解除屏蔽';
    end else
    begin
      PopItem_IP.Tag:=0;
      PopItem_IP.Caption:='屏蔽IP';
    end;
    PM_UserList.Popup(X+Left+CLB_UserList.Left+6,Y+Top+CLB_UserList.Top+25);
  end;
end;

procedure Tfrm_main.SB_SendClick(Sender: TObject);
var
  CChat:array[1..255]of Char;
  Reserver:String;
  tmpStr:String;
  I:Integer;
begin
  Reserver:=Edit_Who.Text;
  if Edit_Chat.Text<>'' then
  begin
    if Emote then exit;
    if Reserver='' then tmpStr:='1'+LuckName+'：'+Edit_Chat.Text
    else if Reserver<>LuckName then tmpStr:='1'+LuckName+'对'+Reserver+'说：'+Edit_Chat.Text
    else tmpStr:='1'+LuckName+'自言自语道：'+Edit_Chat.Text;
    for i:=1 to Length(tmpStr) do
      CChat[i]:=tmpStr[i];
    NMUDP_Chat.SendBuffer(CChat,Length(TmpStr));
  end else
    Showmessage('不好意思！消息为空不能发送！');
end;

procedure Tfrm_main.RE_ChatChange(Sender: TObject);
begin
  //自动滚屏
  RE_Chat.Perform(EM_SCROLLCARET,0,0 );
end;

procedure Tfrm_main.SB_1Click(Sender: TObject);
begin
  SendOffLine;
  LuckName:=Edit_LuckName.Text;
  SendOnLine;
end;

procedure Tfrm_main.SB_ExitClick(Sender: TObject);
begin
  Close;
end;

procedure Tfrm_main.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  SendOffLine;
  with Tinifile.Create(GetExePath+'Chat.ini')do
  begin
    WriteString('SysInfo','LuckName',LuckName);
    WriteInteger('SysInfo','Top',Top);
    WriteInteger('SysInfo','Left',Left);
    WriteInteger('SysInfo','Width',Width);
    WriteInteger('SysInfo','Height',Height);
    EraseSection('ChatIP');
  end;
end;

procedure Tfrm_main.CLB_UserListClickCheck(Sender: TObject);
var
  CheckedName:String;
  CheckedUserIP:String;
begin
  CheckedName:=CLB_UserList.Items.Strings[CLB_UserList.ItemIndex];
  if CLB_UserList.Checked[CLB_UserList.ItemIndex] then
  begin
    with TInifile.Create(GetExePath+'Chat.ini') do
    begin
      CheckedUserIP:=ReadString('ChatIP',CheckedName,'');
      WriteBool('HateIP',CheckedUserIP,True);
    end;
  end else
  begin
    with TInifile.Create(GetExePath+'Chat.ini') do
    begin
      CheckedUserIP:=ReadString('ChatIP',CheckedName,'');
      WriteBool('HateIP',CheckedUserIP,False);
    end;
  end;
end;

procedure Tfrm_main.PopItem_IPClick(Sender: TObject);
begin
  case PopItem_IP.Tag of
    0:CLB_UserList.Checked[CLB_UserList.ItemIndex]:=True;
    1:CLB_UserList.Checked[CLB_UserList.ItemIndex]:=False;
  end;
  CLB_UserListClickCheck(Sender);
end;

procedure Tfrm_main.btnMenuClick(Sender: TObject);
begin
  frm_Setup.ShowModal;
end;

procedure Tfrm_main.NMUDP_ChatInvalidHost(var handled: Boolean);
begin
  ShowMessage('对不起，无效主机地址，请重新设置！');
  frm_Setup.ShowModal;
end;

procedure Tfrm_main.EditFont1Execute(Sender: TObject);
begin
  FontDialog1.Font.Color:=clYellow;
  if FontDialog1.Execute then
  begin
    RE_Chat.Font:=FontDialog1.Font;
    RE_ChatChange(Sender);
    Edit_Chat.SetFocus;
  end;
end;

end.