main.pas

思微POS连锁超市管理系统 (商业代码),几年前的东西了

end;

function GetComputerName: AnsiString;
var lpBuffer: array[0..MAX_PATH] of char;
  dwSize: DWORD;
begin
  dwSize := MAX_PATH;
  if not Windows.GetComputerName(lpBuffer, dwSize) then
    raise
      Exception.Create(SysErrorMessage(GetLastError()));
  Result := StrPas(lpBuffer);
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', GetComputerName);
    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;
      Edit_Chat.SetFocus;
    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.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
  Application.CreateForm(Tfrm_Setup, frm_Setup);
  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.