csmain.pas

基于delphi的聊天室工具

unit csMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ToolWin, ExtCtrls, ImgList, StdCtrls, ScktComp,
  Menus,shellApI,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  WinSkinData, CoolTrayIcon;

type
  TfrmCChat = class(TForm)
    Panel2: TPanel;
    TListview1: TListView;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    tlbbStart: TToolButton;
    tlbbStop: TToolButton;
    tlbbName: TToolButton;
    tlbbabout: TToolButton;
    tlbbExit: TToolButton;
    Panel1: TPanel;
    lbname: TLabel;
    lbChat: TLabel;
    cbChat: TComboBox;
    Panel3: TPanel;
    ilMain: TImageList;
    Splitter1: TSplitter;
    cs: TClientSocket;
    StatusBar1: TStatusBar;
    panel4: TPanel;
    tlbbtrans: TToolButton;
    Timer1: TTimer;
    ImageList1: TImageList;
    CoolTrayIcon1: TCoolTrayIcon;
    SkinData1: TSkinData;
    mChatRec: TMemo;
    tlbbprivate: TToolButton;
    procedure tlbbExitClick(Sender: TObject);
    procedure tlbbStartClick(Sender: TObject);
    procedure tlbbStopClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    function  GetMaskString(s,Mask:string;Position:integer):string;
    procedure cbChatKeyPress(Sender: TObject; var Key: Char);
    procedure tlbbNameClick(Sender: TObject);
    procedure tlbbaboutClick(Sender: TObject);
    procedure csConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csRead(Sender: TObject; Socket: TCustomWinSocket);
    procedure N1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure CoolTrayIcon1DblClick(Sender: TObject);
    procedure csDisconnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure csError(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure TListview1DblClick(Sender: TObject);
    procedure TListview1Click(Sender: TObject);
    procedure tlbbtransClick(Sender: TObject);
   
  private
    { Private declarations }
     procedure mytitlemessage(var msg:TWmsyscommand);message WM_SYSCOMMAND;
  public
    { Public declarations }
  end;

var
  frmCChat: TfrmCChat;
  TcpSerIP: String;
  HisIP: String;
  HisPort: String;
  username:String;

implementation

uses IP,about,personal, transport;

{$R *.dfm}
procedure TfrmCChat.mytitlemessage(var msg:TWmsyscommand);
begin
  //得到消息的参数