main_frm.~pas

一个简单的RICH聊天程序

unit Main_frm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, ScktComp;

type
  TfrmMain = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    mmStatus: TMemo;
    stbrInfo: TStatusBar;
    btnLink: TButton;
    btnClose: TButton;
    btnListen: TButton;
    btnClear: TButton;
    Splitter1: TSplitter;
    redtTalk: TRichEdit;
    cscktTalk: TClientSocket;
    sscktTalk: TServerSocket;
    procedure btnClearClick(Sender: TObject);
    procedure btnListenClick(Sender: TObject);
    procedure btnLinkClick(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure cscktTalkLookup(Sender: TObject; Socket: TCustomWinSocket);
    procedure cscktTalkConnecting(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure cscktTalkConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure cscktTalkDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure cscktTalkRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure sscktTalkListen(Sender: TObject; Socket: TCustomWinSocket);
    procedure sscktTalkClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure sscktTalkAccept(Sender: TObject; Socket: TCustomWinSocket);
    procedure sscktTalkClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure redtTalkKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  frmMain: TfrmMain;

implementation

{$R *.dfm}
uses Param_frm;

procedure TfrmMain.btnClearClick(Sender: TObject);
begin
  //redtTalk.Lines.Clear;
  mmStatus.Lines.Clear;
  ShowMessage(IntToStr(redtTalk.SelStart));
end;

procedure TfrmMain.btnListenClick(Sender: TObject);
begin
  if not sscktTalk.Active then
    if cscktTalk.Active then
      ShowMessage('已经打开客户端不能再做服务器')
    else
      if frmParam.ShowModal = 13 then begin
        sscktTalk.Port := StrToInt(frmParam.edtPort.Text);
        sscktTalk.Active := true;
      end;
end;

procedure TfrmMain.btnLinkClick(Sender: TObject);
begin
  if not cscktTalk.Active then
    if sscktTalk.Active then
      ShowMessage('已经是服务器不能再做客户端')
    else
      if frmParam.ShowModal = 13 then begin
        cscktTalk.Address := frmParam.edtIP.Text;
        cscktTalk.Port := StrToInt(frmParam.edtPort.Text);
        cscktTalk.Active := true;
      end;
end;

procedure TfrmMain.btnCloseClick(Sender: TObject);
begin
  sscktTalk.Close;
  cscktTalk.Close;
  stbrInfo.Panels[0].Text := '';
end;

procedure TfrmMain.cscktTalkLookup(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('正在查找服务器 ' + cscktTalk.Address);
end;

procedure TfrmMain.cscktTalkConnecting(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('正在连接服务器 ' + cscktTalk.Address);
end;

procedure TfrmMain.cscktTalkConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('已经连接服务器 ' + cscktTalk.Address + ' 端口: ' + IntToStr(cscktTalk.Port));
  stbrInfo.Panels[0].Text := '已经连接服务器 ' + cscktTalk.Address  + ' 端口: ' + IntToStr(cscktTalk.Port);
end;

procedure TfrmMain.cscktTalkDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('断开服务器 ' + cscktTalk.Address);
  stbrInfo.Panels[0].Text := '断开服务器 ' + cscktTalk.Address;
end;

procedure TfrmMain.cscktTalkRead(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  redtTalk.SelAttributes.Name := '隶书';
  redtTalk.SelAttributes.Color := clRed;
  redtTalk.Lines.Add('对方: ' + Socket.ReceiveText);
  redtTalk.SelAttributes.Name := '宋体';
  redtTalk.SelAttributes.Color := clBlue;
end;

procedure TfrmMain.sscktTalkListen(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('正在监听 ' + IntToStr(sscktTalk.Port) + '端口');
  stbrInfo.Panels[0].Text := '正在监听 ' + IntToStr(sscktTalk.Port) + '端口';
end;

procedure TfrmMain.sscktTalkClientConnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('客户端 ' + Socket.RemoteAddress + '正在请求连接');
end;

procedure TfrmMain.sscktTalkAccept(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('接受客户端 ' + Socket.RemoteAddress + '的连接请求');
end;

procedure TfrmMain.sscktTalkClientDisconnect(Sender: TObject;
  Socket: TCustomWinSocket);
begin
  mmStatus.Lines.Add('客户端 ' + Socket.RemoteAddress + '断开连接');
end;

procedure TfrmMain.redtTalkKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_RETURN then begin
    if cscktTalk.Active then begin
      cscktTalk.Socket.SendText(redtTalk.Lines.Strings[redtTalk.Lines.Count - 1]);
    end;
    if sscktTalk.Active and (sscktTalk.Socket.ActiveConnections > 0) then begin
      sscktTalk.Socket.Connections[0].SendText(redtTalk.Lines.Strings[redtTalk.Lines.Count - 1]);
    end;
  end;
end;

end.