www.pudn.com > 实景（图形）聊天室源代码（绝对高水 准，超酷）.zip > chat.pas

{ *********************************************************************** } 
{                                                                         } 
{ Copular Chat Client v3.0 Source Code                                    } 
{ Chat Form Unit                                                          } 
{                                                                         } 
{ Copyright (c) 1998-2002 SAF Studio                                      } 
{                                                                         } 
{ Author  : Niu Yu Ping                                                   } 
{ Nickname: DecimalOX                                                     } 
{ Address : Jilin City China                                              } 
{                                                                         } 
{ QICQ    : 103106262                                                     } 
{ Homepage: www.safree.com                                                } 
{ EMail   : decimalox@sohu.com                                            } 
{                                                                         } 
{ *********************************************************************** } 
 
unit chat; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  DXClass, IniFiles, KsHooks, KsForms, KsSkinForms, ExtCtrls, AppEvnts, 
  ImgList, KsItems, EpIIItems, Menus, KsMenus, EpIIMenus, EpIIBitmaps, 
  ScktComp, DXSprite, DXInput, DXDraws, DxMap, ComCtrls, StdCtrls, 
  FatThings, KsCheckBoxs, KsSkinCheckBoxs, KsButtons, KsSkinButtons, 
  AHMTCommandLabel, KsControls, KsPanels, EpIIPanels, Sprite, IRCTags, 
  ShellApi, DIB; 
 
const 
  AUTHOR_NAME: string = 'decimalox'; 
  CLIENT_VERSION: string = 'Copular Chat v3.0.0.2'; 
 
  ERROR_MESSAGE_1: string='输入中包含有非法字符'; 
  ERROR_MESSAGE_2: string='请认真填写所有信息'; 
  ERROR_MESSAGE_3: string='昵称中不能包含有空格'; 
  ERROR_MESSAGE_4: string='两次输入的密码不一致'; 
  ERROR_MESSAGE_5: string='服务器拒绝请求'; 
  ERROR_MESSAGE_6: string='权限不够'; 
 
  ERROR_MAP_LOAD: string='地图文件已损坏，请重新下载'; 
 
  CLIENT_CONFIG_FILE: string='chat.cfg'; 
  CLIENT_DEFAULT_CONFIG_FILE: string='default.cfg'; 
  EMOTE_FILE: string = 'emote.dat'; 
 
  SYSTEM_INFO: string='[系统信息]'; 
  INTO_ROOM: string='满怀激情的加入了我们伟大的聊天事业'; 
  OUT_ROOM: string='带着无限的遗憾离我们而去'; 
  CLIENT_TIME_OUT: string='长时间没有发言，自动离开了聊天室'; 
 
  SYSTEM_INFO_TITLE_COLOR: DWORD=$0000FF; 
  SYSTEM_INFO_COLOR: DWORD=clGreen; 
 
type 
  TChatForm = class(TDXForm) 
    DxMap: TDxMap; 
    DXInput: TDXInput; 
    DXTimer: TDXTimer; 
    DXSpriteEngine: TDXSpriteEngine; 
    Panel1: TPanel; 
    Panel3: TPanel; 
    OnlineList: TListView; 
    Panel2: TPanel; 
    Panel5: TPanel; 
    DXDraw: TDXDraw; 
    Panel7: TPanel; 
    EpBitmapList1: TEpBitmapList; 
    EpPanel1: TEpPanel; 
    SpeakList: TFatMemo; 
    EpPanel2: TEpPanel; 
    Label1: TLabel; 
    TalkTo: TComboBox; 
    Sound: TLabel; 
    Label3: TLabel; 
    SpeakText: TComboBox; 
    DXImageList: TDXImageList; 
    Face: TLabel; 
    WebURL: TAHMCommandLabel; 
    FacePopMenu: TEpPopupMenu; 
    CustomItem1: TEpItem; 
    CustomItem2: TEpItem; 
    CustomItem3: TEpItem; 
    CustomItem4: TEpItem; 
    CustomItem5: TEpItem; 
    FaceList: TImageList; 
    ApplicationEvents1: TApplicationEvents; 
    Label6: TLabel; 
    Image1: TImage; 
    CustomItem6: TEpItem; 
    CustomItem7: TEpItem; 
    CustomItem8: TEpItem; 
    CustomItem9: TEpItem; 
    CustomItem10: TEpItem; 
    DXHeadList: TDXImageList; 
    TalkTimer: TTimer; 
    DXMapDraw: TDXDraw; 
    LogonBtn: TSeSkinButton; 
    AllSpeak: TSeSkinCheckBox; 
    AutoScroll: TSeSkinCheckBox; 
    SeSkinForm1: TSeSkinForm; 
    procedure DXDrawInitialize(Sender: TObject); 
    procedure DXDrawFinalize(Sender: TObject); 
    procedure DXTimerTimer(Sender: TObject; LagCount: Integer); 
    procedure DXDrawMouseDown(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure DXDrawMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure FormDestroy(Sender: TObject); 
    procedure SpeakTextKeyPress(Sender: TObject; var Key: Char); 
    procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket); 
    procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure ClientError(Sender: TObject; Socket: TCustomWinSocket; 
      ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
    procedure LogonBtnClick(Sender: TObject); 
    procedure FaceClick(Sender: TObject); 
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception); 
    procedure SoundClick(Sender: TObject); 
    procedure OnlineListMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure TalkToClick(Sender: TObject); 
    procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); 
    procedure ClientConnecting(Sender: TObject; Socket: TCustomWinSocket); 
    procedure DXMapDrawMouseUp(Sender: TObject; Button: TMouseButton; 
      Shift: TShiftState; X, Y: Integer); 
    procedure CustomItem1Click(Sender: TObject); 
    procedure SpeakListLinkClick(Sender: TObject; Link: String); 
    procedure AllSpeakClick(Sender: TObject); 
    procedure TalkTimerTimer(Sender: TObject); 
    procedure DXMapDrawInitialize(Sender: TObject); 
    procedure DXMapDrawFinalize(Sender: TObject); 
    procedure DXMapDrawRestoreSurface(Sender: TObject); 
    procedure FormResize(Sender: TObject); 
    procedure FormShow(Sender: TObject); 
    procedure AutoScrollClick(Sender: TObject); 
  private 
    { Private declarations } 
    FMapName, //map name 
    CommandTeam: string; //command buffer 
    DefVer: Boolean; //default client version 
    AlreadyLogon: Boolean; 
    SelfName: string; 
 
    //self sprite 
    Me: TPlayerSprite; 
    Connected: Boolean; 
 
    //System message 
    SysText: string; 
 
    //face bitmap 
    FaceBmp: TBitmap; 
 
    CanSpeak: Boolean; 
 
    //radius of ellipse in the small map 
    EllipseR: Integer; 
 
    MapSurface: TDirectDrawSurface; 
 
    //work directory 
    WorkDir: string; 
 
    //small map name 
    LittleMapName: string; 
 
    //get a command string from buffer 
    function PopFromCommandTeam(var CommandTeam: string): string; 
 
    //search a sprite by caption from the online list 
    function FindOnline(ACaption: string): Integer; 
 
    //draw rectangle 
    procedure DrawRect(X, Y, Width, Height: Integer; Color: TColor); 
 
    //draw text into rectangle 
    procedure DrawText(X, Y: Integer; Text: string; TextColor, 
      BKColor: TColor; IsCaption: Boolean=False); 
 
    //logon to server 
    procedure Logon; 
 
    //send a command string to server 
    procedure SendCommand(CommandLine: string); 
 
    //draw a gradual ellipse on small map 
    procedure DrawEllipse(X, Y, MaxR, Speed: Integer); 
 
    //load map and necessary information from file 
    procedure LoadMap(MapName: string); 
  public 
    { Public declarations } 
    Client: TClientSocket; 
    Players: TPlayers; 
    constructor Create(AOwner: TComponent; MapName: string); reintroduce; 
  end; 
 
var 
  ChatForm: TChatForm; 
 
implementation 
 
uses 
  Logon, Main, Tools, Core; 
 
{$R *.DFM} 
 
procedure TChatForm.DXDrawInitialize(Sender: TObject); 
begin 
  //begin to refresh surface 
  DXTimer.Enabled:=True; 
end; 
 
procedure TChatForm.DXDrawFinalize(Sender: TObject); 
begin 
  //end refresh 
  DXTimer.Enabled:=False; 
end; 
 
procedure TChatForm.DXTimerTimer(Sender: TObject; LagCount: Integer); 
var 
  I, J: Integer; 
  TmpStr, TmpSound, TmpSend, TmpRece: string; 
  TmpSprite: TPlayerSprite; 
begin 
  if not DXDraw.CanDraw then 
    Exit; 
 
  //update DirectX components status and refresh 
  DXInput.Update; 
  DXSpriteEngine.Move(LagCount); 
  DXSpriteEngine.Dead; 
  DXDraw.Surface.Fill(0); 
  DXSpriteEngine.Draw; 
 
  with DXDraw.Surface.Canvas do 
  begin 
    //draw system message 
    Brush.Style:=bsClear; 
    Font.Name:='MS Sans Serif'; 
    Font.Charset:=GB2312_CHARSET; 
    Font.Size := 9; 
    Font.Color:=$00DEEFEF; 
    TextOut(5, 3, SysText); 
 
    //draw sprites' talk 
    for I:=0 to Players.Count-1 do 
      with Players.Items[I] do 
      begin 
        for J:=Talk.Count-1 downto 0 do 
        begin 
          if Talk.OnlyOne[J] then 
            TmpSound:='悄悄的' 
          else 
            TmpSound:=''; 
 
          if Talk.Send[J]=SelfName then 
            TmpSend:='你' 
          else 
            TmpSend:=Talk.Send[J]; 
 
          if Talk.Rece[J]=SelfName then 
            TmpRece:='你' 
          else 
            TmpRece:=Talk.Rece[J]; 
 
            TmpStr:=Format('%s%s对%s说：%s', [TmpSend, 
              TmpSound,  TmpRece, Talk.Items[J]]); 
 
          if TmpRece='你' then 
            DrawText(Trunc(WorldX-3-TextWidth(TmpStr) div 2)-8, Trunc(WorldY-30)-(Talk.Count-J)*20-3, 
               TmpStr, clNavy, TColor($57D1FF)) 
          else 
            DrawText(Trunc(WorldX-3-TextWidth(TmpStr) div 2)-8, Trunc(WorldY-30)-(Talk.Count-J)*20-3, 
               TmpStr, clNavy, clInfoBK); 
 
          //draw face 
          FaceList.GetBitmap(Talk.Face[J], FaceBmp); 
          Draw(Trunc(WorldX-3-TextWidth(TmpStr) div 2)-5,Trunc(WorldY-30)-(Talk.Count-J)*20-3, 
            FaceBmp); 
 
          Inc(Talk.Life[J]); 
          if Talk.Life[J]>=500 then 
            RollTalk; 
        end; 
        TmpSprite:=nil; 
 
        if IsMe then 
          TmpSprite:=Players.Items[I] 
        else 
          DrawText(Trunc(WorldX-3-TextWidth(Caption) div 2)-7, Trunc(WorldY-30)-3, 
             Caption, clBlack, TColor($00F3E3CF), True); 
 
        if TmpSprite<>nil then 
          DrawText(Trunc(WorldX-3-TextWidth(TmpSprite.Caption) div 2)-7, Trunc(WorldY-30)-3, 
             TmpSprite.Caption, clBlack, clYellow, True); 
      end; 
    Release; 
  end; 
  DXDraw.Flip; 
 
  //refresh small map 
  if not DXMapDraw.CanDraw then 
    Exit; 
 
  DXMapDraw.Surface.Fill(0); 
 
  DXMapDraw.Surface.Draw(0, 0, MapSurface.ClientRect, MapSurface, True); 
 
  for I:=0 to Players.Count-1 do 
    with Players.Items[I] do 
      with DXMapDraw.Surface.Canvas do 
      begin 
        Brush.Style:=bsClear; 
 
        if IsMe then 
        begin 
          Pen.Color:=clYellow; 
 
          Ellipse(Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2)), 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2)), 
            Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2))+3, 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2))+3); 
 
          DrawEllipse(Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2)), 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2)), DXMapDraw.Width, 2); 
        end 
        else 
        begin 
          Pen.Color:=clWhite; 
          MoveTo(Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2))-FLAGSIZE, 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2))-FLAGSIZE); 
          LineTo(Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2))+FLAGSIZE+1, 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2))+FLAGSIZE+1); 
 
          MoveTo(Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2))+FLAGSIZE, 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2))-FLAGSIZE); 
 
          LineTo(Trunc((DXMapDraw.Width/MapW)*(X+MapW div 2))-FLAGSIZE-1, 
            Trunc((DXMapDraw.Height/MapH)*(Y+MapH div 2))+FLAGSIZE+1); 
        end; 
        Release; 
      end; 
 
  DXMapDraw.Flip; 
end; 
 
procedure TChatForm.DXDrawMouseDown(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
begin 
  if Me=nil then 
    Exit; 
  Me.AnchorX := X; 
  Me.AnchorY := Y; 
end; 
 
procedure TChatForm.DXDrawMouseUp(Sender: TObject; Button: TMouseButton; 
  Shift: TShiftState; X, Y: Integer); 
var 
  TmpStr: string; 
begin 
  if Me=nil then 
    Exit; 
 
  if Button = mbRight then 
    with Me do 
      SendCommand(CreateCommandLine(PLAYER_MOVE, 
        CreateParamLine([SelfName, FloatToStr(X+(AnchorX - worldx - width div 2)), 
        FloatToStr(Y+(AnchorY - worldy - height div 2))]))) 
  else 
    with Me do 
    begin 
      TmpStr:=Players.GetSpriteAt(X+(AnchorX - worldx - width div 2), 
            Y+(AnchorY - worldy - height div 2)); 
      if TmpStr<>'' then 
        TalkTo.ItemIndex:=TalkTo.Items.IndexOf(TmpStr); 
    end; 
end; 
 
procedure TChatForm.FormDestroy(Sender: TObject); 
begin 
  Me.Free; 
  Me:=nil; 
  FaceBmp.Free; 
  FaceBmp:=nil; 
  Players.Free; 
  Players:=nil; 
  Client.Free; 
  Client:=nil; 
end; 
 
procedure TChatForm.SpeakTextKeyPress(Sender: TObject; var Key: Char); 
begin 
  if Key=#13 then 
  begin 
    if not AlreadyLogon then 
      Exit; 
 
    if not CanSpeak then 
    begin 
      ErrorDlg(Handle, '发言太快，小心被踢出'); 
      Exit; 
    end; 
 
    if Length(SpeakText.Text)>80 then 
    begin 
      ErrorDlg(Handle, '发言太长，请尽量长话短说'); 
      Exit; 
    end; 
 
    if TalkTo.Text=SelfName then 
    begin 
      ErrorDlg(Handle, '不许自言自语'); 
      Exit; 
    end; 
 
    if (Sound.Caption='悄悄') and (TalkTo.Text='所有人') then 
    begin 
      ErrorDlg(Handle, '不能对所有人说悄悄话'); 
      Exit; 
    end; 
 
    if SpeakText.Text<>'' then 
    begin 
      SendCommand(CreateCommandLine(TALK, CreateParamLine([SelfName, 
        TalkTo.Text, IntToStr(Ord(Sound.Caption='悄悄')),  IntToStr(Face.Tag), 
        SpeakText.Text]))); 
 
      if SpeakText.Items.IndexOf(SpeakText.Text)=-1 then 
        SpeakText.Items.Add(SpeakText.Text); 
 
      SpeakText.Text:=''; 
 
      CanSpeak:=False; 
      //begin account the interval between two talks 
      TalkTimer.Enabled:=True; 
    end; 
  end; 
end; 
 
procedure TChatForm.ClientRead(Sender: TObject; Socket: TCustomWinSocket); 
var 
  I, J: Integer; 
  TmpCmdLn,TmpParam,TmpStr: string; 
  TmpCmd: DWORD; 
  L: TFatLine; 
begin 
  //update command buffer 
  CommandTeam:=CommandTeam+Socket.ReceiveText; 
 
  //get a piece of command 
  TmpCmdLn:=PopFromCommandTeam(CommandTeam); 
 
  while (TmpCmdLn<>NO_COMMAND_LINE) and (TmpCmdLn<>NO_COMMAND) do 
  begin 
    TmpCmd:=GetCommand(TmpCmdLn); 
    TmpParam:=GetParam(TmpCmdLn); 
 
    //do corresponding operation by command 
 
    if TmpCmd=CHECK_VERSION then 
    begin 
      DefVer:=not Boolean(StrToInt(GetParam(TmpCmdLn,1))); 
      if DefVer then 
      begin 
        ErrorDlg(Handle, '你使用的聊天室版本已经过期，可能无法正常使用，请到“甜不辣”网站升级'); 
        Close; 
      end 
      else 
      begin 
        Logon; 
      end; 
    end; 
 
    if TmpCmd=LOGON_SERVER_OK then 
    begin 
      if StrToInt(GetParam(TmpCmdLn,1))<>0 then 
        AlreadyLogon:=False; 
 
      case StrToInt(GetParam(TmpCmdLn,1)) of 
        0:begin 
          Top:=0; 
          SpeakText.SetFocus; 
        end; 
 
        1:begin 
            MainForm.UserName:=''; 
            MainForm.Password:=''; 
            ErrorDlg(Handle,'昵称不存在'); 
            Logon; 
        end; 
 
        2:begin 
            MainForm.UserName:=''; 
            MainForm.Password:=''; 
            ErrorDlg(Handle,'密码错误'); 
            Logon; 
        end; 
 
        3:begin 
            MainForm.UserName:=''; 
            MainForm.Password:=''; 
            ErrorDlg(Handle,'此昵称已经在聊天室中'); 
            Logon; 
        end; 
      end; 
    end; 
 
    if TmpCmd=GET_ONLINE_LIST_OK then 
    begin 
      OnlineList.Items.Clear; 
      TalkTo.Items.Clear; 
      Players.Clear; 
 
      TalkTo.Items.Add('所有人'); 
 
      with OnlineList.Items.Insert(0) do 
      begin 
        Caption:='所有人'; 
        SubItems.Add(' '); 
        SubItems.Add('用户'); 
      end; 
 
      I:=1; 
 
      while I<=StrToInt(GetParam(TmpCmdLn,1))*6 do 
      begin 
        J:=Players.Add(DXSpriteEngine.Engine, GetParam(TmpCmdLn,I+1), StrToIntDef(GetParam(TmpCmdLn,3),0)); 
 
        with Players.Items[J] do 
        begin 
          Image := DXHeadList.Items[StrToIntDef(GetParam(TmpCmdLn,I+4), 0)]; 
          AnimStart := 4; 
          AnimCount := 2; 
 
          PathInf.FObstacle:=Me.PathInf.FObstacle; 
          if LowerCase(Caption)=LowerCase(SelfName) then 
          begin 
            Me.Free; 
            Me:=Self.Players.Items[J]; 
            IsMe:=True; 
            Go(0, 0) 
          end 
          else 
            Go(StrToFloat(GetParam(TmpCmdLn, I+5)), StrToFloat(GetParam(TmpCmdLn, I+6))); 
        end; 
 
        TalkTo.Items.Add(GetParam(TmpCmdLn, I+1)); 
 
        with OnlineList.Items.Add do 
        begin 
          Caption:=GetParam(TmpCmdLn,I+1); 
 
          if GetParam(TmpCmdLn, I+2)='0' then 
            SubItems.Add('女') 
          else 
            SubItems.Add('男'); 
 
          if StrToIntDef(GetParam(TmpCmdLn, I+3), 0)>=150 then 
            SubItems.Add('管理员') 
          else 
            SubItems.Add('用户'); 
        end; 
        Inc(I,6); 
      end; 
 
      TalkTo.ItemIndex:=0; 
      I:=0; 
 
      while (ISelfName) do 
        Inc(I); 
    end; 
 
    if TmpCmd=LOGON_SERVER then 
    begin 
      if FindOnline(GetParam(TmpCmdLn,1))<>-1 then 
        Exit; 
 
      I:=Players.Add(DXSpriteEngine.Engine, GetParam(TmpCmdLn,1), StrToIntDef(GetParam(TmpCmdLn,3),0)); 
 
      with Players.Items[I] do 
      begin 
        Image := DXHeadList.Items[StrToIntDef(GetParam(TmpCmdLn,4), 0)]; 
        PathInf.FObstacle:=Me.PathInf.FObstacle; 
        if LowerCase(Caption)=LowerCase(SelfName) then 
        begin 
          Me:=Self.Players.Items[I]; 
          IsMe:=True; 
        end; 
        Go(0, 0); 
      end; 
 
      TalkTo.Items.Add(Players.Items[I].Caption); 
 
      with OnlineList.Items.Add do 
      begin 
        Caption:=Players.Items[I].Caption; 
 
        if GetParam(TmpCmdLn, 2)='0' then 
          SubItems.Add('女') 
        else 
          SubItems.Add('男'); 
 
        if StrToIntDef(GetParam(TmpCmdLn, 3), 0)>=150 then 
          SubItems.Add('管理员') 
        else 
          SubItems.Add('用户'); 
      end; 
    end; 
 
    if TmpCmd=LOGOUT_SERVER then 
    begin 
      I:=FindOnline(GetParam(TmpCmdLn,1)); 
      if I<>-1 then 
        OnlineList.Items.Delete(I); 
 
      I:=TalkTo.Items.IndexOf(GetParam(TmpCmdLn,1)); 
      if I<>-1 then 
        TalkTo.Items.Delete(I); 
 
      I:=Players.FindByCaption(GetParam(TmpCmdLn,1)); 
      if I<>-1 then 
        Players.Delete(I); 
    end; 
 
    if TmpCmd=PLAYER_MOVE then 
    begin 
      I:=Players.FindByCaption(GetParam(TmpCmdLn, 1)); 
      if I<>-1 then 
        Players.Items[I].Go(StrToFloat(GetParam(TmpCmdLn, 2)),StrToFloat(GetParam(TmpCmdLn, 3))); 
    end; 
 
    if TmpCmd=LOGOUT_SERVER_OK then 
      case StrToInt(GetParam(TmpCmdLn,1)) of 
 
        -1:ErrorDlg(Handle,ERROR_MESSAGE_5); 
 
        0:begin 
            OnlineList.Items.Clear; 
            AlreadyLogon:=False; 
            InfoDlg(Handle,'已经离开了聊天室'); 
        end; 
      end; 
 
    if TmpCmd=TALK  then 
    begin 
      I:=Players.FindByCaption(GetParam(TmpCmdLn, 1)); 
      if I<>-1 then 
      begin 
        Players.Items[I].Speak(GetParam(TmpCmdLn, 1),GetParam(TmpCmdLn, 2), GetParam(TmpCmdLn, 5), 
          StrToIntDef(GetParam(TmpCmdLn, 4), 0), Boolean(StrToIntDef(GetParam(TmpCmdLn, 3),0))); 
 
        with Players.Items[I].Talk do 
        begin 
          if (not AllSpeak.Checked) then 
            if (SelfName<>Send[Count-1]) and (SelfName<>Rece[Count-1]) then 
              Exit; 
 
          L:=SpeakList.Lines.AddNew; 
 
          if Send[Count-1]=SelfName then 
            TmpStr:=TAG_COLOR+'4'+TAG_BEGINLINK+TAG_UNDERLINE+Send[Count-1]+TAG_UNDERLINE+TAG_ENDLINK+TAG_COLOR 
          else 
            TmpStr:=TAG_COLOR+'12'+TAG_BEGINLINK+TAG_UNDERLINE+Send[Count-1]+TAG_UNDERLINE+TAG_ENDLINK+TAG_COLOR; 
 
          TmpStr:=TmpStr+TAG_COLOR+'1'+FacePopMenu.Items[Face[Count-1]].Caption+'的对'+TAG_COLOR; 
 
          if Rece[Count-1]=SelfName then 
            TmpStr:=TmpStr+TAG_COLOR+'4'+TAG_BEGINLINK+TAG_UNDERLINE+Rece[Count-1]+TAG_UNDERLINE+TAG_ENDLINK+TAG_COLOR 
          else 
            TmpStr:=TmpStr+TAG_COLOR+'12'+TAG_BEGINLINK+TAG_UNDERLINE+Rece[Count-1]+TAG_UNDERLINE+TAG_ENDLINK+TAG_COLOR; 
 
          if OnlyOne[Count-1] then 
            TmpStr:=TmpStr+TAG_COLOR+'1稍稍说:'+TAG_COLOR 
          else 
            TmpStr:=TmpStr+TAG_COLOR+'1说：'+TAG_COLOR; 
 
          if (SelfName=Send[Count-1]) or (SelfName=Rece[Count-1]) then 
            Tmpstr:=TmpStr+TAG_COLOR+'1 '+Items[Count-1]+TAG_COLOR 
          else 
            Tmpstr:=TmpStr+TAG_COLOR+'1 '+Items[Count-1]+TAG_COLOR; 
 
          L.AsIrcText:=TmpStr; 
        end; 
      end; 
    end; 
 
    if TmpCmd=ADVER_TEXT then 
    begin 
      SysText:=Format('系统信息：%s', [GetParam(TmpCmdLn,1)]); 
    end; 
 
    TmpCmdLn:=PopFromCommandTeam(CommandTeam); 
  end; 
end; 
 
function TChatForm.PopFromCommandTeam(var CommandTeam: string): string; 
var 
  I: Integer; 
begin 
  if Copy(CommandTeam,1,2)<>CMD_FLAG then 
  begin 
    I:=0; 
    repeat 
      Inc(I); 
    until 
      ((Copy(CommandTeam,I,2)=CMD_FLAG) and 
        (Copy(CommandTeam,I+2,2)<>CMD_FLAG)) or 
          (I>=Length(CommandTeam)); 
    if I>=Length(CommandTeam) then 
    begin 
      CommandTeam:=''; 
      Result:=NO_COMMAND_LINE; 
      Exit; 
    end 
    else 
      CommandTeam:=Copy(CommandTeam,I,Length(CommandTeam)-I+1); 
  end; 
 
  I:=2; 
  while (ICMD_FLAG) do 
    Inc(I); 
 
  if I>=Length(CommandTeam) then 
  begin 
    Result:=NO_COMMAND; 
    Exit; 
  end; 
 
  Result:=Copy(CommandTeam,1,I+1); 
  CommandTeam:=Copy(CommandTeam,I+2,Length(CommandTeam)-I-1); 
end; 
 
function TChatForm.FindOnline(ACaption: string): Integer; 
var 
  I: Integer; 
begin 
  Result:=-1; 
  for I:=0 to OnlineList.Items.Count-1 do 
    if OnlineList.Items[I].Caption=ACaption then 
    begin 
      Result:=I; 
      Exit; 
    end; 
end; 
 
procedure TChatForm.ClientConnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
  Connected:=True; 
  SysText:=Format('系统信息：%s', ['已连接服务器']); 
  SendCommand(CreateCommandLine(CHECK_VERSION,CLIENT_VERSION)); 
end; 
 
procedure TChatForm.ClientError(Sender: TObject; Socket: TCustomWinSocket; 
  ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
begin 
  Connected:=False; 
  SysText:=Format('系统信息：%s', ['无法连接服务器']); 
  if MessageBox(Handle,'无法连接服务器,是否再次连接','错误', 
    MB_YESNO or MB_ICONQUESTION)=idYes then 
      Client.Open 
    else 
    begin 
      LogonBtn.Enabled:=False; 
      Close; 
    end; 
  ErrorCode:=0; 
end; 
 
procedure TChatForm.LogonBtnClick(Sender: TObject); 
begin 
  if not Connected then 
    Exit; 
 
  if AlreadyLogon then 
  begin 
    if MessageBox(Handle, '是否重新登录', '确认', MB_YESNO or MB_ICONQUESTION)=idNo then 
    begin 
      SpeakText.SetFocus; 
      Exit; 
    end; 
    MainForm.UserName:=''; 
    MainForm.Password:=''; 
    Client.Close; 
    Client.Open; 
  end 
  else 
    Logon; 
end; 
 
procedure TChatForm.FaceClick(Sender: TObject); 
begin 
  FacePopMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y); 
end; 
 
procedure TChatForm.DrawRect(X, Y: LongInt; Width, Height: LongInt; Color: TColor); 
var 
  RDC: TRect; 
begin 
  with DXDraw.Surface.Canvas do 
  begin 
    if Color=clNone then 
    begin 
      Brush.Style:=bsClear; 
      Pen.Style:=psClear; 
    end 
    else 
    begin 
      Brush.Color:=Color; 
      Pen.Color:=Color; 
    end; 
 
    Pie(X, Y, X+Height, Y+Height, X+Height, 50, X+Height, 150); 
    RDC.Left:=X+Height div 2; 
    RDC.Top:=Y; 
    RDC.Right:=X+Width; 
    RDC.Bottom:=Y+Height; 
    FillRect(RDC); 
    Pie(X+Width-Height div 2, Y, X+Width+Height div 2, Y+Height, X+Width+Height div 2, 0, X+Width+Height div 2,0); 
  end; 
end; 
 
procedure TChatForm.DrawText(X, Y: Integer; Text: string; TextColor, BKColor: TColor; 
  IsCaption:Boolean=False); 
begin 
  with DXDraw.Surface.Canvas do 
  begin 
    if IsCaption then 
      DrawRect(X, Y, TextWidth(Text)+10, TextHeight(Text)+4, BKColor) 
    else 
      DrawRect(X, Y, TextWidth(Text)+20, TextHeight(Text)+4, BKColor); 
    Font.Color:=TextColor; 
    if BKColor=crNone then 
      Font.Style:=[fsBold] 
    else 
      Font.Style:=[]; 
    if IsCaption then 
      TextOut(X+10, Y+2, Text) 
    else 
      TextOut(X+20, Y+2, Text); 
  end; 
end; 
 
procedure TChatForm.ApplicationEvents1Exception(Sender: TObject; 
  E: Exception); 
begin 
  try 
  except 
    on E:Exception do 
  end; 
end; 
 
procedure TChatForm.SoundClick(Sender: TObject); 
begin 
  if Sound.Caption='大声' then 
    Sound.Caption:='悄悄' 
  else 
    Sound.Caption:='大声'; 
  SpeakText.SetFocus; 
end; 
 
procedure TChatForm.OnlineListMouseUp(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
var 
  TmpItem: TListItem; 
begin 
  TmpItem:=OnlineList.GetItemAt(X, Y); 
  if TmpItem<>nil then 
    TalkTo.ItemIndex:=TalkTo.Items.IndexOf(TmpItem.Caption); 
  SpeakText.SetFocus; 
end; 
 
procedure TChatForm.TalkToClick(Sender: TObject); 
begin 
  SpeakText.SetFocus; 
end; 
 
procedure TChatForm.ClientDisconnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
  Connected:=False; 
  AlreadyLogon:=False; 
end; 
 
procedure TChatForm.Logon; 
begin 
  Screen.Cursor:=crHourGlass; 
  Me:=TPlayerSprite.Create(nil); 
  with Me do 
  begin 
    Image:=DXHeadList.Items[0]; 
    Caption:='Me'; 
    MakeMap(DXMap); 
  end; 
  if (MainForm.UserName<>'') and (MainForm.Password<>'') then 
  begin 
    SelfName:=MainForm.UserName; 
    SendCommand(CreateCommandLine(LOGON_SERVER, 
      CreateParamLine([LowerCase(MainForm.UserName),MainForm.Password]))); 
    AlreadyLogon:=True; 
  end 
  else 
    with TLogonForm.Create(Self) do 
      try 
        Screen.Cursor:=crDefault; 
        if ShowModal=mrOK then 
        begin 
          SelfName:=NickName.Text; 
          MainForm.UserName:=LowerCase(NickName.Text); 
          MainForm.Password:=Password.Text; 
          SendCommand(CreateCommandLine(LOGON_SERVER, 
            CreateParamLine([LowerCase(NickName.Text),Password.Text]))); 
          AlreadyLogon:=True; 
        end 
        else 
        begin 
          MainForm.UserName:=''; 
          MainForm.Password:=''; 
          Self.Close; 
        end; 
      finally 
        Free; 
        SpeakText.SetFocus; 
      end; 
  Screen.Cursor:=crDefault; 
end; 
 
procedure TChatForm.SendCommand(CommandLine: string); 
var 
  TmpCmd: DWORD; 
begin 
  TmpCmd:=GetCommand(CommandLine); 
 
  if (TmpCmd=CHECK_VERSION) or (TmpCmd=LOGON_SERVER) then 
    Client.Socket.SendText(CommandLine) 
  else 
    if AlreadyLogon then 
      Client.Socket.SendText(CommandLine); 
end; 
 
procedure TChatForm.ClientConnecting(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
  SysText:=Format('系统信息：%s', ['正在连接服务器']); 
end; 
 
procedure TChatForm.DXMapDrawMouseUp(Sender: TObject; 
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 
begin 
  if Me=nil then 
    Exit; 
 
  SendCommand(CreateCommandLine(PLAYER_MOVE, 
    CreateParamLine([SelfName, FloatToStr((x / (Sender as TDXDraw).width) * MapW-MapW div 2), 
    FloatToStr((y / (Sender as TDXDraw).height)*MapH- MapH div 2)]))); 
 
{  Me.Go((x / (Sender as TDXDraw).width) * MapW-MapW div 2, 
    (y / (Sender as TDXDraw).height)*MapH- MapH div 2);} 
end; 
 
procedure TChatForm.CustomItem1Click(Sender: TObject); 
begin 
  Face.Tag:=(Sender as TEPItem).ImageIndex; 
  Face.Caption:=(Sender as TEPItem).Caption; 
  SpeakText.SetFocus; 
end; 
 
procedure TChatForm.SpeakListLinkClick(Sender: TObject; Link: String); 
begin 
  TalkTo.ItemIndex:=TalkTo.Items.IndexOf(Link); 
  SpeakText.SetFocus; 
end; 
 
procedure TChatForm.AllSpeakClick(Sender: TObject); 
begin 
  SpeakText.SetFocus; 
end; 
 
procedure TChatForm.TalkTimerTimer(Sender: TObject); 
begin 
  CanSpeak:=True; 
  TalkTimer.Enabled:=False; 
end; 
 
procedure TChatForm.DXMapDrawInitialize(Sender: TObject); 
begin 
  MapSurface:=TDirectDrawSurface.Create(DXMapDraw.DDraw); 
end; 
 
procedure TChatForm.DXMapDrawFinalize(Sender: TObject); 
begin 
  Mapsurface.Free; 
  Mapsurface:=nil; 
end; 
 
procedure TChatForm.DXMapDrawRestoreSurface(Sender: TObject); 
begin 
  MapSurface.LoadFromGraphic(DXImageList.Items.Find(LittleMapName).Picture.Graphic); 
end; 
 
procedure TChatForm.DrawEllipse(X, Y, MaxR, Speed: Integer); 
begin 
  Inc(EllipseR); 
  if EllipseR>MaxR*Speed then 
    EllipseR:=0; 
 
  with DXMapDraw.Surface.Canvas do 
  begin 
    Brush.Style:=bsClear; 
    Pen.Color:=clYellow; 
    Ellipse(X-EllipseR+3, Y-EllipseR+3, X+EllipseR, Y+EllipseR); 
  end; 
end; 
 
procedure TChatForm.LoadMap(MapName: string); 
var 
  f: TIniFile; 
  TmpStr: string; 
begin 
  Screen.Cursor:=crHourGlass; 
  Client.Close; 
 
  FMapName:=MapName; 
 
  f:=TIniFile.Create(WorkDir+'\Maps\'+MapName+'.map'); 
 
  try 
    try 
      TmpStr:=f.ReadString('Map', 'Caption', ''); 
      Caption:=Format('Copular Chat v3.0 - %s', [TmpStr]); 
 
      TmpStr:=f.ReadString('Data', 'Resource', ''); 
      DXImageList.Items.LoadFromFile(WorkDir+'\Maps\'+TmpStr); 
 
      TmpStr:=f.ReadString('Data', 'MapFile', ''); 
      DXMap.DrawMap(WorkDir+'\Maps\'+TmpStr); 
 
      LittleMapName:=f.ReadString('Data', 'LittleMap', ''); 
 
      TmpStr:=f.ReadString('Server', 'Address', ''); 
      Client.Address:=TmpStr; 
 
      TmpStr:=f.ReadString('Server', 'Port', ''); 
      Client.Port:=StrToIntDef(TmpStr, 8064); 
    except 
      ErrorDlg(Handle, ERROR_MAP_LOAD); 
      Close; 
    end; 
  finally 
    F.Free; 
  end; 
  Screen.Cursor:=crDefault; 
  Client.Open; 
end; 
 
procedure TChatForm.FormResize(Sender: TObject); 
begin 
  if (Width<=320) or (Height<=280) then 
    Exit; 
 
  DXDraw.Finalize; 
  DXDraw.Initialize; 
 
  with DXSpriteEngine.Engine do 
  begin 
    X:=Width div 2; 
    Y:=Height div 2; 
  end; 
 
  DXSpriteEngine.Draw; 
 
  if Me<>nil then 
    Me.Go(Me.X+0.1, Me.Y+0.1); 
 
end; 
 
constructor TChatForm.Create(AOwner: TComponent; MapName: string); 
var 
  I: Integer; 
begin 
  inherited Create(AOwner); 
  Client:=TClientSocket.Create(Self); 
  Client.OnConnect:=ClientConnect; 
  Client.OnConnecting:=ClientConnecting; 
  Client.OnDisconnect:=ClientDisConnect; 
  Client.OnError:=ClientError; 
  Client.OnRead:=ClientRead; 
   
  Top:=Screen.Height; 
  Left:=0; 
  Width:=Screen.Width; 
  Height:=Screen.Height-30; 
 
  CanSpeak:=True; 
  SysText:='系统信息：'; 
  EllipseR:=0; 
  SpeakList.Lines.Clear; 
 
  Players:=TPlayers.Create(Self); 
 
  FaceBmp:=TBitmap.Create; 
  FaceBmp.TransparentColor:=clWhite; 
  FaceBmp.Transparent:=True; 
 
  DXImageList.Items.MakeColorTable; 
  DXDraw.ColorTable := DXImageList.Items.ColorTable; 
  DXDraw.DefColorTable := DXImageList.Items.ColorTable; 
  DXDraw.UpdatePalette; 
 
  WorkDir:=GetCurrentDir; 
  DXHeadList.Items.LoadFromFile(WorkDir+'\Res\Head.Res'); 
 
  with DXHeadList do 
    for I:=0 to Items.Count-1 do 
    begin 
      Items[I].Transparent:=True; 
      Items[I].TransparentColor:=TColor($522108); 
    end; 
 
  LoadMap(MapName); 
end; 
 
procedure TChatForm.FormShow(Sender: TObject); 
begin 
  AutoScroll.Refresh; 
end; 
 
procedure TChatForm.AutoScrollClick(Sender: TObject); 
begin 
  if AutoScroll.Checked then 
    SpeakList.StickText:=stBottom 
  else 
    SpeakList.StickText:=stNone; 
  SpeakText.SetFocus; 
end; 
 
end.