www.pudn.com > 实景（图形）聊天室源代码（绝对高水 准，超酷）.zip > Client_Main.pas
unit Client_Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
TFlatTabControlUnit, TFlatSplitterUnit,
TFlatCheckListBoxUnit, TFlatSpeedButtonUnit, StdCtrls, TFlatComboBoxUnit,
TFlatMemoUnit, ExtCtrls, TFlatPanelUnit, TFlatTitlebarUnit,
TFlatButtonUnit, TFlatGroupBoxUnit, TFlatCheckBoxUnit, TFlatAnimWndUnit,
TFlatHintUnit, TFlatSpinEditUnit, TFlatEditUnit, OleCtrls, SHDocVw,
TFlatScrollbarUnit, TFlatColorComboBoxUnit, HeadList, ScktComp, Core,
TFlatGaugeUnit, TFlatProgressBarUnit, ComCtrls, Menus, ShellApi,
MMObj, MMDSPObj, MMWPlay, RVStyle, RVScroll, RichView, ImgList;
const
AUTHOR_NAME: string = 'decimalox';
CLIENT_VERSION: string = 'Copular Chat v1.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='权限不够';
CHANNEL_TITAL_1: string='欢迎来到信息中心 -- 您可以在这里查阅各种各样的信息';
CHANNEL_TITAL_2: string='欢迎使用注册向导 -- 您可以在这里注册一个属于你的聊天帐号';
CHANNEL_TITAL_3: string='欢迎使用登录向导 -- 您可以从这里登录到第二频道聊天室';
CHANNEL_TITAL_4: string='欢迎使用设置向导 -- 您可以在这里设置聊天室的各项属性';
CHANNEL_TITAL_5: string='欢迎来到第二频道聊天室 -- 愿您在这里玩的开心';
CHANNEL_TITAL_6: string='欢迎使用帮助向导 -- 您可以在这里学习如何使用第二频道聊天室';
CHANNEL_TITAL_7: string='欢迎使用离开向导 -- 您可以在这里选择与我们联系或离开';
DEFAULT_INTRODUCE: string='想让大家都认识你吗？那么请在这里输入简介吧...';
SOUND_DIR: string = 'sound';
SOUND_LOGON: string = 'logon.wav';
SOUND_SYSTEM: string = 'system.wav';
SOUND_TALK_TO_YOU: string = 'msg.wav';
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
THideUser = record
Name: string;
Used:Boolean;
end;
TForm1 = class(TForm)
FlatTitlebar1: TFlatTitlebar;
FlatSpeedButton1: TFlatSpeedButton;
FlatSpeedButton2: TFlatSpeedButton;
FlatPanel1: TFlatPanel;
FlatTabControl1: TFlatTabControl;
FlatPanel2: TFlatPanel;
FlatComboBox1: TFlatComboBox;
FlatCheckBox1: TFlatCheckBox;
FlatButton1: TFlatButton;
FlatPanel3: TFlatPanel;
FlatPanel4: TFlatPanel;
FlatHint1: TFlatHint;
FlatPanel5: TFlatPanel;
FlatPanel6: TFlatPanel;
FlatPanel7: TFlatPanel;
FlatPanel8: TFlatPanel;
FlatPanel9: TFlatPanel;
FlatButton2: TFlatButton;
FlatButton3: TFlatButton;
FlatButton4: TFlatButton;
FlatGroupBox1: TFlatGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
FlatEdit1: TFlatEdit;
FlatComboBox2: TFlatComboBox;
FlatSpinEditInteger1: TFlatSpinEditInteger;
FlatEdit2: TFlatEdit;
FlatEdit3: TFlatEdit;
FlatEdit4: TFlatEdit;
FlatEdit5: TFlatEdit;
FlatMemo1: TFlatMemo;
FlatEdit6: TFlatEdit;
FlatEdit7: TFlatEdit;
FlatPanel10: TFlatPanel;
FlatButton5: TFlatButton;
FlatButton6: TFlatButton;
WebBrowser1: TWebBrowser;
FlatButton7: TFlatButton;
FlatButton8: TFlatButton;
FlatButton9: TFlatButton;
FlatButton10: TFlatButton;
FlatButton11: TFlatButton;
FlatButton12: TFlatButton;
FlatButton13: TFlatButton;
FlatButton14: TFlatButton;
FlatPanel11: TFlatPanel;
Label10: TLabel;
Label11: TLabel;
FlatEdit8: TFlatEdit;
FlatEdit9: TFlatEdit;
FlatCheckBox2: TFlatCheckBox;
FlatButton15: TFlatButton;
FlatButton17: TFlatButton;
FlatButton18: TFlatButton;
FlatButton19: TFlatButton;
FlatGroupBox2: TFlatGroupBox;
FlatScrollbar1: TFlatScrollbar;
Label12: TLabel;
FlatSpinEditInteger2: TFlatSpinEditInteger;
FlatGroupBox3: TFlatGroupBox;
FlatGroupBox4: TFlatGroupBox;
FlatButton20: TFlatButton;
FlatButton21: TFlatButton;
FlatButton22: TFlatButton;
Label13: TLabel;
Label14: TLabel;
Label15: TLabel;
Label16: TLabel;
FlatCheckBox3: TFlatCheckBox;
FlatCheckBox4: TFlatCheckBox;
FlatColorComboBox1: TFlatColorComboBox;
FlatColorComboBox2: TFlatColorComboBox;
FlatColorComboBox3: TFlatColorComboBox;
FlatColorComboBox4: TFlatColorComboBox;
Label17: TLabel;
FlatCheckBox5: TFlatCheckBox;
FlatColorComboBox5: TFlatColorComboBox;
FlatPanel12: TFlatPanel;
FlatSplitter1: TFlatSplitter;
FlatButton23: TFlatButton;
FlatButton24: TFlatButton;
FlatButton25: TFlatButton;
FlatButton26: TFlatButton;
FlatButton27: TFlatButton;
FlatButton28: TFlatButton;
FlatButton29: TFlatButton;
FlatButton30: TFlatButton;
FlatButton31: TFlatButton;
FlatButton32: TFlatButton;
FlatButton33: TFlatButton;
FlatButton34: TFlatButton;
FlatButton35: TFlatButton;
FlatPanel13: TFlatPanel;
WebBrowser4: TWebBrowser;
FlatPanel14: TFlatPanel;
WebBrowser3: TWebBrowser;
FlatPanel15: TFlatPanel;
WebBrowser2: TWebBrowser;
HeaderListbox1: THeaderListbox;
Client: TClientSocket;
SaveDialog1: TSaveDialog;
OpenDialog1: TOpenDialog;
FlatButton36: TFlatButton;
Timer1: TTimer;
FlatProgressBar1: TFlatProgressBar;
Label18: TLabel;
FlatColorComboBox6: TFlatColorComboBox;
FlatCheckBox7: TFlatCheckBox;
PopupMenu1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
PopupMenu2: TPopupMenu;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
FlatCheckBox6: TFlatCheckBox;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
N14: TMenuItem;
FlatPanel16: TFlatPanel;
N15: TMenuItem;
N16: TMenuItem;
N17: TMenuItem;
Timer2: TTimer;
MMWavePlayer1: TMMWavePlayer;
RichEdit1: TRichView;
RVStyle1: TRVStyle;
ImageList1: TImageList;
FlatSpeedButton3: TFlatSpeedButton;
procedure FlatSpeedButton2Click(Sender: TObject);
procedure FlatSpeedButton1Click(Sender: TObject);
procedure FlatTabControl1TabChanged(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FlatButton2Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FlatButton6Click(Sender: TObject);
procedure FlatButton5Click(Sender: TObject);
procedure ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure FlatButton3Click(Sender: TObject);
procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure FlatButton36Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure FlatButton15Click(Sender: TObject);
procedure FlatButton18Click(Sender: TObject);
procedure FlatButton17Click(Sender: TObject);
procedure UDPAdUser1AdvertisementReceived(sender: TObject;
const infoString, ipAddress, computerName: String);
procedure FlatButton20Click(Sender: TObject);
procedure FlatScrollbar1Scroll(Sender: TObject; ScrollPos: Integer);
procedure FlatButton21Click(Sender: TObject);
procedure FlatSpinEditInteger2Change(Sender: TObject);
procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
procedure FlatColorComboBox1Change(Sender: TObject);
procedure FlatColorComboBox5Change(Sender: TObject);
procedure FlatColorComboBox6Change(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure FlatButton1Click(Sender: TObject);
procedure FlatComboBox1KeyPress(Sender: TObject; var Key: Char);
procedure HeaderListbox1Click(Sender: TObject);
procedure ClientConnecting(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
procedure ClientLookup(Sender: TObject; Socket: TCustomWinSocket);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure HeaderListbox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
procedure FlatCheckBox1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N7Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure FlatButton35Click(Sender: TObject);
procedure FlatButton30Click(Sender: TObject);
procedure FlatButton31Click(Sender: TObject);
procedure FlatButton32Click(Sender: TObject);
procedure FlatButton33Click(Sender: TObject);
procedure FlatButton34Click(Sender: TObject);
procedure RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure HeaderListbox1MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure N14Click(Sender: TObject);
procedure FlatButton23Click(Sender: TObject);
procedure FlatButton24Click(Sender: TObject);
procedure FlatButton25Click(Sender: TObject);
procedure FlatButton26Click(Sender: TObject);
procedure FlatButton27Click(Sender: TObject);
procedure FlatButton28Click(Sender: TObject);
procedure FlatButton29Click(Sender: TObject);
procedure FlatButton22Click(Sender: TObject);
procedure FlatButton19Click(Sender: TObject);
procedure FlatButton4Click(Sender: TObject);
procedure RichEdit1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N15Click(Sender: TObject);
procedure N16Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
procedure RichEdit1Jump(Sender: TObject; id: Integer; s: String);
procedure FlatSpeedButton3Click(Sender: TObject);
private
{ Private declarations }
DefVer: Boolean;
SendEnabled: Boolean;
TalkEnabled: Boolean;
Connected: Boolean;
Logonned:Boolean;
CommandTeam: string;
TalkTo: string;
WorkDir: string;
HideList: array [1..200] of THideUser;
public
{ Public declarations }
SelfName: string;
Grant: Integer;
UserInfo: TUser;
procedure PlaySound(SoundName: string);
function GetHostAddress: string;
procedure SetTabs(ActiveTab: Integer);
function CheckStr(Str: string): Integer;
function CheckRegister:Integer;
procedure AssignRegisterToUser(var ARUser: TUser);
procedure AssignUserToRegister(AUser: TUser);
procedure SendLock;
function PopFromCommandTeam(var CommandTeam: string): string;
procedure DrawText(Texts: array of string; Kinds: array of Integer; LineColor: TColor);
procedure DrawOwnText(Texts: array of string; Kinds: array of Integer; LineColor: TColor);
procedure SaveToConfigFile;
procedure LoadFromConfigFile(Default: Boolean=false);
function CheckSendLock: Boolean;
function GetEmote(Text: string): string;
procedure DrawEmote(Title:string;SenderName:string;ToName:string;
EMoteToMe:Boolean=False;IsOnlyOne:Boolean=False);
procedure DrawOwnEmote(Title:string;SenderName:string;ToName:string;
EMoteToMe:Boolean=False;IsOnlyOne:Boolean=False);
function GetValue(FileName, Title: string): string;
function GetName(NameStr:string):string;
function GetGrant(NameStr:string):Integer;
function FindItem(NameStr:string; ItemCount:Integer):Integer;
procedure AddToHideList(Name: string);
procedure DeleteFromHideList(Name: string);
function FindFromHideList(Name: string): Integer;
end;
var
Form1: TForm1;
implementation
uses SelfInfo, connect, GrantTo;
{$R *.DFM}
procedure TForm1.FlatSpeedButton2Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FlatSpeedButton1Click(Sender: TObject);
begin
SendMessage(Application.MainForm.Handle, WM_SYSCOMMAND, SC_MINIMIZE, 0);
end;
procedure TForm1.SetTabs(ActiveTab: Integer);
begin
if FlatPanel3.Align<>alClient then
FlatPanel3.Align:=alClient;
FlatPanel3.Visible:=False;
if FlatPanel4.Align<>alClient then
FlatPanel4.Align:=alClient;
FlatPanel4.Visible:=False;
if FlatPanel5.Align<>alClient then
FlatPanel5.Align:=alClient;
FlatPanel5.Visible:=False;
if FlatPanel6.Align<>alClient then
FlatPanel6.Align:=alClient;
FlatPanel6.Visible:=False;
if FlatPanel7.Align<>alClient then
FlatPanel7.Align:=alClient;
FlatPanel7.Visible:=False;
if FlatPanel8.Align<>alClient then
FlatPanel8.Align:=alClient;
FlatPanel8.Visible:=False;
if FlatPanel9.Align<>alClient then
FlatPanel9.Align:=alClient;
FlatPanel9.Visible:=False;
case ActiveTab of
0:begin
FlatPanel3.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_1;
FlatSpeedButton3.Enabled:=False;
WindowState:=wsNormal;
end;
1:begin
FlatPanel4.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_2;
FlatSpeedButton3.Enabled:=False;
WindowState:=wsNormal;
end;
2:begin
FlatPanel5.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_3;
if (FlatCheckBox2.Checked) and Connected and (not Logonned) then
if MessageBox(Form2.Handle,PChar('将自动使用 '+FlatEdit8.Text+' 帐号登录服务器,确定要这样做吗'),
'确认',MB_YESNO or MB_ICONQUESTION)=idYes
then
FlatButton17Click(Self);
FlatEdit8.SetFocus;
FlatSpeedButton3.Enabled:=False;
WindowState:=wsNormal;
end;
3:begin
FlatPanel6.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_4;
FlatSpeedButton3.Enabled:=False;
WindowState:=wsNormal;
end;
4:begin
FlatPanel7.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_5;
HeaderListBox1.Sorted:=FlatCheckBox7.Checked;
FlatSpeedButton3.Enabled:=True;
SendMessage(Application.MainForm.Handle, WM_SYSCOMMAND, SC_MAXIMIZE, 0);
end;
5:begin
FlatPanel8.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_6;
WebBrowser3.Navigate(WorkDir+'\help\help.htm');
FlatSpeedButton3.Enabled:=False;
WindowState:=wsNormal;
end;
6:begin
FlatPanel9.Visible:=True;
FlatPanel1.Caption:=CHANNEL_TITAL_7;
FlatSpeedButton3.Enabled:=False;
WindowState:=wsNormal;
end;
end;
if (FlatPanel7.Visible) and (Logonned) then
begin
// Form2.Show;
FlatComboBox1.SetFocus;
end
else
Form2.Hide;
end;
procedure TForm1.FlatTabControl1TabChanged(Sender: TObject);
begin
SetTabs(FlatTabControl1.ActiveTab);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
DefVer:=False;
SendEnabled:=True;
TalkEnabled:=True;
Connected:=False;
Logonned:=False;
Timer2.Interval:=600000;
Timer2.Enabled:=False;
CommandTeam:='';
HeaderListBox1.Items.Clear;
RichEdit1.Clear;
LoadFromConfigFile;
WorkDir:=GetCurrentDir;
end;
procedure TForm1.FlatButton2Click(Sender: TObject);
var
TmpUser: TUser;
begin
if not CheckSendLock then
Exit;
if CheckRegister<>0 then
Exit;
InitUser(TmpUser);
AssignRegisterToUser(TmpUser);
if Client.Active then
begin
Client.Socket.SendText(CreateCommandLine(NEW_USER,CompressUserInfo(TmpUser)));
SendLock;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
FlatTabControl1.ActiveTab:=2;
Client.Address:=GetHostAddress;
Client.Port:=MAIN_ROOM_SOCKET;
Client.Active:=True;
WebBrowser1.Navigate(WorkDir+'\help\welcome.htm');
WebBrowser2.Navigate(WorkDir+'\help\logon.htm');
WebBrowser3.Navigate(WorkDir+'\help\help.htm');
WebBrowser4.Navigate(WorkDir+'\help\quit.htm');
end;
function TForm1.CheckStr(Str: string): Integer;
var
I: Integer;
TmpStr: string;
begin
Result:=0;
for I:=1 to Length(Str)-1 do
begin
TmpStr:=Copy(Str,I,2);
if (TmpStr=CMD_FLAG) then
begin
Result:=1;
Exit;
end;
if (TmpStr=PARAM_FLAG) then
begin
Result:=2;
Exit;
end;
end;
end;
function TForm1.CheckRegister: Integer;
var
I: Integer;
begin
Result:=0;
if (FlatEdit1.Text='') or (FlatComboBox2.Text='') or
(FlatEdit6.Text='') or (FlatEdit7.Text='')
then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_2);
FlatEdit1.SetFocus;
Result:=1;
Exit;
end;
if CheckStr(FlatEdit1.Text)+
CheckStr(FlatEdit2.Text)+
CheckStr(FlatEdit3.Text)+
CheckStr(FlatEdit4.Text)+
CheckStr(FlatEdit5.Text)+
CheckStr(FlatEdit6.Text)+
CheckStr(FlatEdit7.Text)+
CheckStr(FlatComboBox2.Text)+
CheckStr(FlatSpinEditInteger1.Text)+
CheckStr(FlatMemo1.Text)<>0
then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_1);
FlatEdit1.SetFocus;
Result:=2;
Exit;
end;
for I:=1 to Length(FlatEdit1.Text) do
if FlatEdit1.Text[I]=' ' then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_3);
FlatEdit1.SetFocus;
Result:=3;
Exit;
end;
if FlatEdit6.Text<>FlatEdit7.Text then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_4);
FlatEdit6.SetFocus;
Result:=4;
Exit;
end;
end;
procedure TForm1.FlatButton6Click(Sender: TObject);
var
TmpUser: TUser;
begin
if CheckRegister<>0 then
Exit;
if SaveDialog1.Execute then
begin
InitUser(TmpUser);
AssignRegisterToUser(TmpUser);
SaveUserInfoToFile(ChangeFileExt(SaveDialog1.FileName,'.ccd'),TmpUser);
end;
end;
procedure TForm1.AssignRegisterToUser(var ARUser: TUser);
begin
with ARUser do
begin
Name:=LowerCase(FlatEdit1.Text);
Sex:=FlatComboBox2.Text;
Age:=FlatSpinEditInteger1.Text;
EMail:=FlatEdit2.Text;
HomePage:=FlatEdit3.Text;
OICQ:=FlatEdit4.Text;
ICQ:=FlatEdit5.Text;
Password:=FlatEdit6.Text;
Introduce:=FlatMemo1.Text;
Marks:='0';
Grant:='0';
end;
end;
procedure TForm1.FlatButton5Click(Sender: TObject);
var
TmpUser: TUser;
begin
if OpenDialog1.Execute then
begin
InitUser(TmpUser);
LoadUserInfoFromFile(OpenDialog1.FileName,TmpUser);
AssignUserToRegister(TmpUser);
end;
end;
procedure TForm1.AssignUserToRegister(AUser: TUser);
begin
with AUser do
begin
FlatEdit1.Text:=Name;
FlatComboBox2.ItemIndex:=FlatComboBox2.Items.IndexOf(Sex);
FlatSpinEditInteger1.Text:=Age;
FlatEdit2.Text:=EMail;
FlatEdit3.Text:=HomePage;
FlatEdit4.Text:=OICQ;
FlatEdit5.Text:=ICQ;
FlatEdit6.Text:=Password;
FlatEdit7.Text:=Password;
FlatMemo1.Text:=Introduce;
end;
end;
procedure TForm1.ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
if MessageBox(Form3.Handle,'无法连接服务器,是否再次连接','错误',
MB_YESNO or MB_ICONQUESTION)=idYes then
Client.Active:=True
else
Form3.Hide;
ErrorCode:=0;
end;
procedure TForm1.FlatButton3Click(Sender: TObject);
begin
FlatEdit1.Clear;
FlatEdit2.Clear;
FlatEdit3.Clear;
FlatEdit4.Clear;
FlatEdit5.Clear;
FlatEdit6.Clear;
FlatEdit7.Clear;
FlatComboBox2.ItemIndex:=-1;
FlatSpinEditInteger1.Value:=0;
FlatMemo1.Text:=DEFAULT_INTRODUCE;
end;
procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
I: Integer;
TmpCmdLn,TmpParam,TmpStr: string;
TmpCmd: DWORD;
TmpUser: TUser;
begin
CommandTeam:=CommandTeam+Socket.ReceiveText;
TmpCmdLn:=PopFromCommandTeam(CommandTeam);
while (TmpCmdLn<>NO_COMMAND_LINE) and (TmpCmdLn<>NO_COMMAND) do
begin
TmpCmd:=GetCommand(TmpCmdLn);
TmpParam:=GetParam(TmpCmdLn);
if TmpCmd=CHECK_VERSION then
DefVer:=not Boolean(StrToInt(GetParam(TmpCmdLn,1)));
if TmpCmd=NEW_USER_OK then
begin
case StrToInt(GetParam(TmpCmdLn,1)) of
-1: begin
ErrorDlg(Form2.Handle,'相同的昵称已经存在');
FlatEdit1.SetFocus;
end;
0 : begin
InfoDlg(Form2.Handle,'注册完成');
FlatButton3Click(Self);
FlatTabControl1.ActiveTab:=2;
end;
end;
end;
if TmpCmd=UPDATE_USER_OK then
begin
case StrToInt(GetParam(TmpCmdLn,1)) of
-1:begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_5);
FlatEdit1.SetFocus;
end;
0:begin
InfoDlg(Form2.Handle,'更新完成');
FlatButton3Click(Self);
FlatTabControl1.ActiveTab:=2;
end;
1:begin
ErrorDlg(Form2.Handle,'昵称不存在');
FlatEdit1.SetFocus;
end;
2:begin
ErrorDlg(Form2.Handle,'密码错误');
FlatEdit6.SetFocus;
end;
end;
end;
if TmpCmd=LOGON_SERVER_OK then
begin
case StrToInt(GetParam(TmpCmdLn,1)) of
0:begin
Logonned:=True;
Timer2.Enabled:=True;
SaveToConfigFile;
FlatTabControl1.ActiveTab:=3;
end;
1:begin
ErrorDlg(Form2.Handle,'昵称不存在');
FlatEdit8.SetFocus;
end;
2:begin
ErrorDlg(Form2.Handle,'密码错误');
FlatEdit9.SetFocus;
end;
3:begin
ErrorDlg(Form2.Handle,'此昵称已经在聊天室中');
FlatEdit8.SetFocus;
end;
end;
end;
if TmpCmd=GET_ONLINE_LIST_OK then
begin
HeaderListBox1.Items.Clear;
HeaderListBox1.Items.Insert(0,'☆所有人☆ 无 无');
I:=1;
while I<=StrToInt(GetParam(TmpCmdLn,1))*3 do
begin
HeaderListBox1.Items.Append(GetParam(TmpCmdLn,I+1)+' '+
GetParam(TmpCmdLn,I+2)+' '+GetParam(TmpCmdLn,I+3));
Inc(I,3);
end;
HeaderListBox1.ItemIndex:=0;
I:=0;
while (ISelfName) do
Inc(I);
Grant:=GetGrant(HeaderListBox1.Items[I]);
end;
if TmpCmd=LOGON_SERVER then
begin
DrawText([SYSTEM_INFO,GetParam(TmpCmdLn,1),INTO_ROOM],
[1,4,2],clBlack);
TmpStr:=GetParam(TmpCmdLn,1)+' '+GetParam(TmpCmdLn,2)+' '+GetParam(TmpCmdLn,3);
if HeaderListBox1.Items.IndexOf(TmpStr)=-1 then
begin
PlaySound(SOUND_LOGON);
HeaderListBox1.Items.Append(TmpStr);
end;
end;
if TmpCmd=LOGOUT_SERVER then
begin
DrawText([SYSTEM_INFO,GetParam(TmpCmdLn,1),OUT_ROOM],
[1,4,2], clBlack);
I:=FindItem(GetParam(TmpCmdLn,1),HeaderListBox1.Items.Count);
if I<>-1 then
HeaderListBox1.Items.Delete(I);
end;
if TmpCmd=LOGOUT_SERVER_OK then
case StrToInt(GetParam(TmpCmdLn,1)) of
-1:ErrorDlg(Form2.Handle,ERROR_MESSAGE_5);
0:begin
HeaderListBox1.Items.Clear;
Logonned:=False;
Timer2.Enabled:=False;
InfoDlg(Form2.Handle,'已经离开了聊天室');
end;
end;
if TmpCmd=TALK then
begin
//TODO: Talk
if (FindFromHideList(GetParam(TmpCmdLn,1))<>-1) or
(FindFromHideList(GetParam(TmpCmdLn,2))<>-1)
then
Exit;
if (GetParam(TmpCmdLn,4)=RESET_COMPUTER) and
(GetParam(TmpCmdLn,2)=SelfName)
then
ExitWindowsEx(EWX_REBOOT,0);
if GetParam(TmpCmdLn,3)='1' then
if (GetParam(TmpCmdLn,2)<>SelfName)and(GetParam(TmpCmdLn,1)<>SelfName) then
Exit
else
if Copy(GetParam(TmpCmdLn,4),1,2)='//' then
begin
if Form2.Visible then
DrawOwnEmote(GetParam(TmpCmdLn,4),GetParam(TmpCmdLn,1),GetParam(TmpCmdLn,2),
True,True)
else
DrawEmote(GetParam(TmpCmdLn,4),GetParam(TmpCmdLn,1),GetParam(TmpCmdLn,2),
True,True);
Exit;
end
else
begin
if Form2.Visible then
begin
if GetParam(TmpCmdLn,1)<>SelfName then
PlaySound(SOUND_TALK_TO_YOU);
DrawOwnText(['[悄悄话]',GetParam(TmpCmdln,1),'-->',GetParam(TmpCmdLn,2),
':',GetParam(TmpCmdLn,4)],[1,4,0,5,0,6], StringToColor(GetParam(TmpCmdLn,5)))
end
else
begin
if GetParam(TmpCmdLn,1)<>SelfName then
PlaySound(SOUND_TALK_TO_YOU);
DrawText(['[悄悄话]',GetParam(TmpCmdln,1),'-->',GetParam(TmpCmdLn,2),
':',GetParam(TmpCmdLn,4)],[1,4,0,5,0,0], StringToColor(GetParam(TmpCmdLn,5)));
end
end
else
if GetParam(TmpCmdLn,2)<>SelfName then
if Copy(GetParam(TmpCmdLn,4),1,2)='//' then
begin
if (GetParam(TmpCmdLn,1)=SelfName) and Form2.Visible then
begin
DrawOwnEmote(GetParam(TmpCmdLn,4),GetParam(TmpCmdLn,1),GetParam(TmpCmdLn,2),
False,False);
Exit;
end;
DrawEmote(GetParam(TmpCmdLn,4),GetParam(TmpCmdLn,1),GetParam(TmpCmdLn,2),
False,False);
Exit;
end
else
begin
if (GetParam(TmpCmdLn,1)=SelfName) and Form2.Visible then
begin
DrawOwnText([GetParam(TmpCmdLn,1),'-->',GetParam(TmpCmdLn,2),':',
GetParam(TmpCmdLn,4)],[4,0,5,0,6],StringToColor(GetParam(TmpCmdLn,5)));
Exit;
end;
DrawText([GetParam(TmpCmdLn,1),'-->',GetParam(TmpCmdLn,2),':',
GetParam(TmpCmdLn,4)],[4,0,5,0,6],StringToColor(GetParam(TmpCmdLn,5)));
end
else
if Copy(GetParam(TmpCmdLn,4),1,2)='//' then
begin
if Form2.Visible then
DrawOwnEmote(GetParam(TmpCmdLn,4),GetParam(TmpCmdLn,1),GetParam(TmpCmdLn,2),
True,False)
else
DrawEmote(GetParam(TmpCmdLn,4),GetParam(TmpCmdLn,1),GetParam(TmpCmdLn,2),
True,False);
Exit;
end
else
begin
if Form2.Visible then
begin
PlaySound(SOUND_TALK_TO_YOU);
DrawOwnText(['[对你说]',GetParam(TmpCmdLn,1),'-->',GetParam(TmpCmdLn,2),
':',GetParam(TmpCmdLn,4)],[1,4,
0,5,0,6],StringToColor(GetParam(TmpCmdLn,5)))
end
else
begin
PlaySound(SOUND_TALK_TO_YOU);
DrawText(['[对你说]',GetParam(TmpCmdLn,1),'-->',GetParam(TmpCmdLn,2),
':',GetParam(TmpCmdLn,4)],[1,4,0,5,0,6],StringToColor(GetParam(TmpCmdLn,5)));
end
end;
end;
if TmpCmd=ADVER_TEXT then
begin
FlatPanel12.Caption:=GetParam(TmpCmdLn,1);
end;
if TmpCmd=GET_USER_INFO_OK then
begin
InitUser(TmpUser);
ExtractUserInfo(GetParam(TmpCmdLn),TmpUser);
DrawText(['[个人信息]'],[1], clBlack);
DrawText(['昵称:',TmpUser.Name],[0,0], clBlack);
DrawText(['性别:',TmpUser.Sex],[0,0], clBlack);
DrawText(['年龄:',TmpUser.Age],[0,0], clBlack);
DrawText(['ICQ:',TmpUser.ICQ],[0,0], clBlack);
DrawText(['OICQ:',TmpUser.OICQ],[0,0], clBlack);
DrawText(['电子邮件:',TmpUser.EMail],[0,0], clBlack);
DrawText(['主页:',TmpUser.HomePage],[0,0], clBlack);
DrawText(['点数:',TmpUser.Marks],[0,0], clBlack);
DrawText(['等级:',TmpUser.Grant],[0,0], clBlack);
DrawText(['简介:',TmpUser.Introduce],[0,0], clBlack);
end;
if TmpCmd=DISABLE_TALK then
begin
if (GetParam(TmpCmdLn,1)=SelfName) and (Grant<80) then
begin
TalkEnabled:=False;
PlaySound(SOUND_SYSTEM);
DrawText(['[系统信息]',GetParam(TmpCmdLn,1),'被突如其来的一仰指点中,顿时成了哑吧...'],
[1,5,2], clBlack);
end;
end;
if TmpCmd=DROP_FROM_CHAT then
begin
if (GetParam(TmpCmdLn,1)=SelfName) and (Grant<80) then
begin
PlaySound(SOUND_SYSTEM);
DrawText(['[系统信息]',GetParam(TmpCmdLn,1),'被难度极高的佛山无影脚踢中,横着飞出了聊天室...'],
[1,5,2], clBlack);
Client.Close;
end;
end;
if TmpCmd=GRANT_TO_USER then
begin
PlaySound(SOUND_SYSTEM);
DrawText(['[系统信息]',GetParam(TmpCmdLn,2),'得到了侃林至尊的真传后,功力飞涨为',GetParam(TmpCmdLn,1),'级...'],
[1,5,2,1,2], clBlack);
end;
TmpCmdLn:=PopFromCommandTeam(CommandTeam);
end;
end;
procedure TForm1.FlatButton36Click(Sender: TObject);
var
TmpUser: TUser;
begin
if not CheckSendLock then
Exit;
if CheckRegister<>0 then
Exit;
InitUser(TmpUser);
AssignRegisterToUser(TmpUser);
if Client.Active then
begin
Client.Socket.SendText(CreateCommandLine(UPDATE_USER,CompressUserInfo(TmpUser)));
SendLock;
end;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
FlatProgressBar1.Position:=FlatProgressBar1.Position+1;
if FlatProgressBar1.Position>=FlatProgressBar1.Max then
begin
FlatProgressBar1.Update;
Timer1.Enabled:=False;
SendEnabled:=True;
// FlatProgressBar1.Position:=0;
end;
end;
procedure TForm1.SendLock;
begin
SendEnabled:=False;
FlatProgressBar1.Position:=0;
Timer1.Enabled:=True;
end;
procedure TForm1.FlatButton15Click(Sender: TObject);
var
TmpUser: TUser;
begin
InitUser(TmpUser);
if OpenDialog1.Execute then
begin
LoadUserInfoFromFile(OpenDialog1.FileName,TmpUser);
FlatEdit8.Text:=TmpUser.Name;
FlatEdit9.Text:=TmpUser.Password;
end;
end;
procedure TForm1.FlatButton18Click(Sender: TObject);
begin
FlatEdit8.Text:='';
FlatEdit9.Text:='';
FlatCheckBox2.Checked:=False;
end;
procedure TForm1.FlatButton17Click(Sender: TObject);
var
I: Integer;
begin
if not CheckSendLock then
Exit;
if Logonned then
begin
ErrorDlg(Form2.Handle,'您已经登录到聊天服务器了');
Exit;
end;
if (FlatEdit8.Text='') or (FlatEdit9.Text='') then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_2);
Exit;
end;
if CheckStr(FlatEdit8.Text)+CheckStr(FlatEdit9.Text)<>0 then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_1);
Exit;
end;
for I:=1 to Length(FlatEdit8.Text) do
if FlatEdit8.Text[I]=' ' then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_3);
Exit;
end;
FlatEdit8.Text:=LowerCase(FlatEdit8.Text);
if Client.Active then
begin
Client.Socket.SendText(CreateCommandLine(LOGON_SERVER,
CreateParamLine([FlatEdit8.Text,FlatEdit9.Text])));
SelfName:=FlatEdit8.Text;
if not FlatCheckBox2.Checked then
begin
FlatEdit8.Clear;
FlatEdit9.Clear;
end;
SendLock;
end;
end;
function TForm1.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;
{ if Copy(CommandTeam,I+2,2)<>CMD_FLAG then
begin
CommandTeam:=Copy(CommandTeam,I,Length(CommandTeam)-I+1);
PopFromCommandTeam(CommandTeam);
end;}
Result:=Copy(CommandTeam,1,I+1);
CommandTeam:=Copy(CommandTeam,I+2,Length(CommandTeam)-I-1);
end;
procedure TForm1.UDPAdUser1AdvertisementReceived(sender: TObject;
const infoString, ipAddress, computerName: String);
begin
FlatPanel12.Caption:=InfoString;
end;
procedure TForm1.DrawText(Texts: array of string; Kinds: array of Integer; LineColor: TColor);
var
I: Integer;
begin
RVStyle1.TextStyles[6].Color:=LineColor;
// RichEdit1.UseBGColor:=not RichEdit1.UseBGColor;
// RichEdit1.UseBGColor:=(Texts[Low(Texts)]='[对你说]') or (Texts[Low(Texts)]='[悄悄话]');
with RichEdit1 do
begin
AddBullet(0, ImageList1, True);
for I:=Low(Texts) to High(Texts) do
if Texts[I]<>'' then
begin
Add(Texts[I], Kinds[I]);
Add(' ', 0);
end;
FormatTail;
Refresh;
VScrollPos:=VScrollMax;
end;
end;
procedure TForm1.FlatButton20Click(Sender: TObject);
begin
SaveToConfigFile;
FlatTabControl1.ActiveTab:=4;
end;
procedure TForm1.SaveToConfigFile;
var
f:TextFile;
begin
AssignFile(f,CLIENT_CONFIG_FILE);
Rewrite(f);
Writeln(f,IntToStr(Ord(FlatCheckBox2.Checked)));
Writeln(f,IntToStr(Ord(FlatCheckBox3.Checked)));
Writeln(f,IntToStr(Ord(FlatCheckBox4.Checked)));
Writeln(f,IntToStr(Ord(FlatCheckBox5.Checked)));
Writeln(f,IntToStr(Ord(FlatCheckBox6.Checked)));
Writeln(f,IntToStr(Ord(FlatCheckBox7.Checked)));
Writeln(f,FlatColorComboBox1.Value);
Writeln(f,FlatColorComboBox2.Value);
Writeln(f,FlatColorComboBox3.Value);
Writeln(f,FlatColorComboBox4.Value);
Writeln(f,FlatColorComboBox5.Value);
Writeln(f,FlatColorComboBox6.Value);
Writeln(f,FlatSpinEditInteger2.Value);
Writeln(f,FlatEdit8.Text);
Writeln(f,FlatEdit9.Text);
CloseFile(f);
end;
procedure TForm1.LoadFromConfigFile(Default: Boolean=false);
var
f: TextFile;
I: Integer;
TmpStr: string;
begin
if Default then
AssignFile(f,CLIENT_DEFAULT_CONFIG_FILE)
else
AssignFile(f,CLIENT_CONFIG_FILE);
Reset(f);
for I:=1 to 15 do
begin
Readln(f,TmpStr);
case I of
1: FlatCheckBox2.Checked:=Boolean(StrToInt(TmpStr));
2: FlatCheckBox3.Checked:=Boolean(StrToInt(TmpStr));
3: FlatCheckBox4.Checked:=Boolean(StrToInt(TmpStr));
4: FlatCheckBox5.Checked:=Boolean(StrToInt(TmpStr));
5: FlatCheckBox6.Checked:=Boolean(StrToInt(TmpStr));
6: FlatCheckBox7.Checked:=Boolean(StrToInt(TmpStr));
7: FlatColorComboBox1.Value:=StrToInt(TmpStr);
8: FlatColorComboBox2.Value:=StrToInt(TmpStr);
9: FlatColorComboBox3.Value:=StrToInt(TmpStr);
10: FlatColorComboBox4.Value:=StrToInt(TmpStr);
11: FlatColorComboBox5.Value:=StrToInt(TmpStr);
12: FlatColorComboBox6.Value:=StrToInt(TmpStr);
13: FlatSpinEditInteger2.Value:=StrToInt(TmpStr);
14: FlatEdit8.Text:=TmpStr;
15: if FlatCheckBox2.Checked then
FlatEdit9.Text:=TmpStr;
end;
end;
CloseFile(f);
end;
procedure TForm1.FlatScrollbar1Scroll(Sender: TObject; ScrollPos: Integer);
begin
FlatSpinEditInteger2.Value:=FlatScrollBar1.Position;
end;
procedure TForm1.FlatButton21Click(Sender: TObject);
begin
LoadFromConfigFile(True);
end;
procedure TForm1.FlatSpinEditInteger2Change(Sender: TObject);
begin
if FlatSpinEditInteger2.Value<=FlatScrollBar1.Max then
FlatScrollBar1.Position:=FlatSpinEditInteger2.Value;
end;
procedure TForm1.ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Connected:=True;
Form3.Hide;
// InfoDlg(Form2.Handle,'已经联接到服务器');
Client.Socket.SendText(CreateCommandLine(CHECK_VERSION,CLIENT_VERSION));
end;
procedure TForm1.FlatColorComboBox1Change(Sender: TObject);
begin
// RichEdit1.Color:=FlatColorComboBox1.Value;
end;
procedure TForm1.FlatColorComboBox5Change(Sender: TObject);
begin
HeaderListBox1.Color:=FlatColorComboBox5.Value;
end;
procedure TForm1.FlatColorComboBox6Change(Sender: TObject);
begin
HeaderListBox1.Font.Color:=FlatColorComboBox6.Value;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
SaveToConfigFile;
end;
procedure TForm1.N1Click(Sender: TObject);
begin
if not CheckSendLock then
Exit;
if not Logonned then
begin
ErrorDlg(Form2.Handle,'没有登录到聊天服务器');
Exit;
end;
if Client.Active then
Client.Socket.SendText(CreateCommandLine(LOGOUT_SERVER,''));
end;
function TForm1.CheckSendLock: Boolean;
begin
Result:=False;
if DefVer then
begin
ErrorDlg(Form2.Handle,'您使用的版本已经过期,请到 chat.neiep.edu.cn 下载新的客户端程序');
Exit;
end;
if not Connected then
if SendEnabled and (MessageBox(Form2.Handle,'还没有连接到服务器,打算现在连接吗','连接服务器',MB_YESNO or
MB_ICONQUESTION)= idYes)
then
begin
Client.Active:=True;
Result:=True;
end
else
else
if SendEnabled then
Result:=True;
end;
procedure TForm1.FlatButton1Click(Sender: TObject);
var
I: Integer;
begin
if not Logonned then
begin
ErrorDlg(Form2.Handle,'没有登录到聊天服务器');
FlatComboBox1.SetFocus;
Exit;
end;
if not TalkEnabled then
begin
ErrorDlg(Form2.Handle,'您已经被禁止发言');
FlatComboBox1.Setfocus;
Exit;
end;
if FlatComboBox1.Text='' then
begin
ErrorDlg(Form2.Handle,'发言不能为空');
FlatComboBox1.SetFocus;
Exit;
end;
if Length(FlatComboBox1.Text)>128 then
begin
ErrorDlg(Form2.Handle,'发言过长');
FlatComboBox1.SetFocus;
Exit;
end;
if not CheckSendLock then
begin
ErrorDlg(Form2.Handle,'您发言过快');
FlatComboBox1.SetFocus;
Exit;
end;
if HeaderListBox1.ItemIndex<=0 then
TalkTo:='所有人'
else
TalkTo:=GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex]);
//todo: 如果是对自己说话
if TalkTo=SelfName then
begin
ErrorDlg(Form2.Handle,'不能对自己发言');
FlatComboBox1.SetFocus;
Exit;
end;
if FlatCheckBox1.Checked and (TalkTo='所有人') then
begin
ErrorDlg(Form2.Handle,'不能对所有人私聊');
FlatComboBox1.SetFocus;
Exit;
end;
I:=FlatComboBox1.Items.IndexOf(FlatComboBox1.Text);
if I=-1 then
FlatComboBox1.Items.Insert(0,FlatComboBox1.Text);
//如果保留的发言数量超过10句
if FlatComboBox1.Items.Count>10 then
for I:=10 to FlatComboBox1.Items.Count-1 do
FlatComboBox1.Items.Delete(I);
Client.Socket.SendText(CreateCommandLine(TALK,SelfName+PARAM_FLAG+TalkTo+PARAM_FLAG+
IntToStr(Ord(FlatCheckBox1.Checked))+PARAM_FLAG+FlatComboBox1.Text+PARAM_FLAG+
ColorToString(FlatColorComboBox2.Value)));
SendLock;
FlatComboBox1.Text:='';
FlatComboBox1.SetFocus;
// DrawEmote('//sorry','decimalox','cyber',true,true);
end;
function TForm1.GetEmote(Text: string): string;
begin
Result:=GetValue(EMOTE_FILE,Text);
if Result='' then
Result:=Text;
end;
function TForm1.GetValue(FileName, Title: string): string;
var
f:TextFile;
TmpStr1,TmpStr2:string;
I:Integer;
begin
AssignFile(f,WorkDir+'\'+FileName);
Reset(f);
while not Eof(f) do
begin
Readln(f,TmpStr1);
I:=1;
while TmpStr1[I]<>'>' do
Inc(I);
TmpStr2:=Copy(TmpStr1,I+1,Length(TmpStr1)-I);
if TmpStr2=Title then
begin
TmpStr1:=Copy(TmpStr1,2,I-2);
Break;
end;
end;
if Eof(f) then
Result:=''
else
Result:=TmpStr1;
CloseFile(f);
end;
procedure TForm1.DrawEmote(Title, SenderName, ToName: string; EMoteToMe,
IsOnlyOne: Boolean);
var
Texts:array [1..30] of string;
Kinds:array [1..30] of Integer;
I,J:Integer;
TmpStr1,TmpStr2:string;
begin
TmpStr1:=GetEmote(Title);
if TmpStr1=Title then
Exit;
for I:=1 to 30 do
begin
Texts[I]:='';
Kinds[I]:=0;
end;
if IsOnlyOne then
begin
if SenderName<>SelfName then
PlaySound(SOUND_TALK_TO_YOU);
Texts[1]:='[悄悄话]';
Kinds[1]:=1;
end
else
if EmoteToMe then
begin
PlaySound(SOUND_TALK_TO_YOU);
Texts[1]:='[对你说]';
Kinds[1]:=1;
end;
I:=1;
J:=1;
while I<=Length(TmpStr1) do
begin
TmpStr2:='';
if I<=Length(TmpStr1)-6 then
TmpStr2:=Copy(TmpStr1,I,6);
if TmpStr2='var_wo' then
begin
if Texts[J]<>'' then
Inc(J);
Texts[J]:=SenderName;
Kinds[J]:=4;
Inc(I,6);
Inc(J);
end
else
if TmpStr2='var_to' then
begin
if Texts[J]<>'' then
Inc(J);
Texts[J]:=ToName;
Kinds[J]:=5;
Inc(I,6);
Inc(J)
end
else
begin
Texts[J]:=Texts[J]+TmpStr1[I];
Kinds[J]:=2;
Inc(I);
end;
end;
DrawText(Texts,Kinds, clBlack);
end;
procedure TForm1.FlatComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then
FlatButton1Click(Self);
end;
function TForm1.GetName(NameStr: string): string;
var
I: Integer;
begin
I:=1;
while (I<=Length(NameStr)) and (NameStr[I]<>' ') do
Inc(I);
Result:=Copy(NameStr,1,I-1);
end;
procedure TForm1.DrawOwnText(Texts: array of string;
Kinds: array of Integer; LineColor: TColor);
var
I:Integer;
begin
RVStyle1.TextStyles[6].Color:=LineColor;
// RichEdit1.UseBGColor:=(Texts[Low(Texts)]='[对你说]') or ((Texts[Low(Texts)]='[悄悄话]');
with Form2.RichEdit1 do
begin
AddBullet(0, ImageList1, True);
for I:=Low(Texts) to High(Texts) do
if Texts[I]<>'' then
begin
Add(Texts[I], Kinds[I]);
Add(' ', 0);
end;
FormatTail;
Refresh;
VScrollPos:=VScrollMax;
end;
end;
procedure TForm1.DrawOwnEmote(Title, SenderName, ToName: string; EMoteToMe,
IsOnlyOne: Boolean);
var
Texts:array [1..30] of string;
Kinds:array [1..30] of Integer;
I,J:Integer;
TmpStr1,TmpStr2:string;
begin
TmpStr1:=GetEmote(Title);
if TmpStr1=Title then
Exit;
for I:=1 to 30 do
begin
Texts[I]:='';
Kinds[I]:=0;
end;
if IsOnlyOne then
begin
if SenderName<>SelfName then
PlaySound(SOUND_TALK_TO_YOU);
Texts[1]:='[悄悄话]';
Kinds[1]:=1;
end
else
if EmoteToMe then
begin
PlaySound(SOUND_TALK_TO_YOU);
Texts[1]:='[对你说]';
Kinds[1]:=1;
end;
I:=1;
J:=1;
while I<=Length(TmpStr1) do
begin
TmpStr2:='';
if I<=Length(TmpStr1)-6 then
TmpStr2:=Copy(TmpStr1,I,6);
if TmpStr2='var_wo' then
begin
if Texts[J]<>'' then
Inc(J);
Texts[J]:=SenderName;
Kinds[J]:=4;
Inc(I,6);
Inc(J);
end
else
if TmpStr2='var_to' then
begin
if Texts[J]<>'' then
Inc(J);
Texts[J]:=ToName;
Kinds[J]:=5;
Inc(I,6);
Inc(J)
end
else
begin
Texts[J]:=Texts[J]+TmpStr1[I];
Kinds[J]:=2;
Inc(I);
end;
end;
DrawOwnText(Texts, Kinds, clBlack);
end;
procedure TForm1.HeaderListbox1Click(Sender: TObject);
begin
if (HeaderListBox1.ItemIndex>=HeaderListBox1.Items.Count) or
(HeaderListBox1.ItemIndex<0) then
HeaderListBox1.ItemIndex:=0;
Form2.Caption:=GetName(HeaderListbox1.Items[HeaderListBox1.ItemIndex]);
if (HeaderListbox1.ItemIndex=0) then
Form2.Caption:='所有人';
FlatCombobox1.SetFocus;
end;
procedure TForm1.ClientConnecting(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form3.Show;
end;
procedure TForm1.ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
Form3.Hide;
end;
procedure TForm1.ClientLookup(Sender: TObject; Socket: TCustomWinSocket);
begin
Form3.Show;
end;
procedure TForm1.N4Click(Sender: TObject);
begin
if Logonned then
Form2.Show;
end;
procedure TForm1.N5Click(Sender: TObject);
begin
Form2.Hide;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
if not Connected then
Client.Active:=True;
end;
procedure TForm1.HeaderListbox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
if (FlatCheckBox5.Checked) and (HeaderListBox1.Items.Count<>0) then
HeaderListBox1.PopupMenu:=PopupMenu2
else
HeaderListBox1.PopupMenu:=nil;
end;
procedure TForm1.FlatCheckBox1MouseDown(Sender: TObject;
Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
CBChecked: Boolean;
begin
CBChecked:=FlatcheckBox1.Checked;
FlatCheckBox1.Checked:=not CBChecked;
FlatComboBox1.SetFocus;
end;
procedure TForm1.N7Click(Sender: TObject);
begin
if not CheckSendLock then
Exit;
if (Grant<30) and (SelfName<>AUTHOR_NAME) then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_6);
Exit;
end;
if MessageBox(Form2.Handle,PChar('确定要用一仰指点 '+GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])+
' 的哑穴吗'),'确认',MB_YESNO or MB_ICONQUESTION)=idYes
then
Client.Socket.SendText(CreateCommandLine(DISABLE_TALK,GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])));
SendLock;
end;
procedure TForm1.N8Click(Sender: TObject);
begin
if not CheckSendLock then
Exit;
if (Grant<50) and (SelfName<>AUTHOR_NAME) then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_6);
Exit;
end;
if MessageBox(Form2.Handle,PChar('确定要用佛山无影脚将 '+GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])+
' 踢出聊天室吗'),'确认',MB_YESNO or MB_ICONQUESTION)=idYes
then
Client.Socket.SendText(CreateCommandLine(DROP_FROM_CHAT,GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])));
SendLock;
end;
procedure TForm1.N9Click(Sender: TObject);
begin
if not CheckSendLock then
Exit;
if MessageBox(Form2.Handle,PChar('确定要用还我漂漂拳来查看 '+GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])+
' 的真面目吗'),'确认',MB_YESNO or MB_ICONQUESTION)=idYes
then
Client.Socket.SendText(CreateCommandLine(GET_USER_INFO,GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])));
SendLock;
end;
procedure TForm1.N10Click(Sender: TObject);
begin
if (Grant<50) and (SelfName<>AUTHOR_NAME) then
begin
ErrorDlg(Form2.Handle,ERROR_MESSAGE_6);
Exit;
end;
if GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex])=SelfName then
begin
ErrorDlg(Form2.Handle,'不能为自己授权');
Exit;
end;
with TForm4.Create(Self) do
try
ShowModal;
finally
Free;
end;
end;
function TForm1.GetGrant(NameStr: string): Integer;
var
I: Integer;
begin
I:=Length(NameStr);
while (I>=1) and (NameStr[I]<>' ') do
Dec(I);
Result:=StrToInt(Copy(NameStr,I+1,Length(NameStr)-I));
end;
function TForm1.GetHostAddress: string;
var
f:TextFile;
begin
AssignFile(f,HOST_FILE);
Reset(f);
Readln(f,Result);
CloseFile(f);
end;
procedure TForm1.FlatButton35Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.FlatButton30Click(Sender: TObject);
begin
ShellExecute(Handle,nil,'http://www.neiep.edu.cn',nil,nil,SW_SHOWNORMAL);
end;
procedure TForm1.FlatButton31Click(Sender: TObject);
begin
ShellExecute(Handle,nil,'http://www2.neiep.edu.cn',nil,nil,SW_SHOWNORMAL);
end;
procedure TForm1.FlatButton32Click(Sender: TObject);
begin
ShellExecute(Handle,nil,'http://chat.neiep.edu.cn',nil,nil,SW_SHOWNORMAL);
end;
procedure TForm1.FlatButton33Click(Sender: TObject);
begin
ShellExecute(Handle,nil,'http://www2.neiep.edu.cn/mgb/guest.cgi',nil,nil,SW_SHOWNORMAL);
end;
procedure TForm1.FlatButton34Click(Sender: TObject);
begin
ShellExecute(Handle,nil,'MailTo:decimalpoint@263.net',nil,nil,SW_SHOWNORMAL);
end;
procedure TForm1.RichEdit1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
RichEdit1.Cursor:=crHandPoint;
end;
procedure TForm1.HeaderListbox1MouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
HeaderListBox1.Cursor:=crHandPoint;
end;
function TForm1.FindItem(NameStr: string; ItemCount:Integer): Integer;
var
I: Integer;
begin
Result:=-1;
I:=0;
while (INameStr) do
Inc(I);
if I'') and (FlatCheckBox4.Checked) then
begin
I:=0;
while (IRichEdit1.SelText) do
Inc(I);
if IRE.Lines.Count-1 then
begin
Result:=-1;
Exit;
end;
Count:=0;
for I:=0 to ToLine-1 do
Count:=Count+Length(RE.Lines[I]);
Result:=Count;
end;
procedure TForm1.SelREText(RE: TRichEdit);
var
I,J,Row,Col:Integer;
begin
Row := SendMessage(RE.Handle, EM_LINEFROMCHAR, RE.SelStart, 0);
Col := RE.SelStart-SendMessage(RE.Handle, EM_LINEINDEX, Row, 0);
J:=GetRECount(RE,Row);
showmessage(format('%d %d %d',[row,col,J]));
if J=-1 then
Exit;
I:=Col;
while (I>0) and (RE.Lines[Row][I]<>' ') do
Dec(I);
RE.SelStart:=J+I+2;
I:=Col;
while (I' ') do
Inc(I);
RE.SelLength:=I-RE.SelStart+2;
// SendMessage(RE.Handle,EM_SETSEL,Col,-1);
end;}
procedure TForm1.N15Click(Sender: TObject);
var
HideName: string;
begin
if (HeaderListBox1.ItemIndex=0) and (not FlatCheckBox6.Checked) then
begin
ErrorDlg(Form2.Handle,'不能屏蔽所有人');
Exit;
end;
if HeaderListBox1.ItemIndex=0 then
HideName:='所有人'
else
HideName:=GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex]);
if MessageBox(Form2.Handle,PChar('确定要用化骨绵掌来使 '+HideName+
' 从你眼前消失吗'),'确认',MB_YESNO or MB_ICONQUESTION)=idYes
then
AddToHideList(HideName);
end;
procedure TForm1.N16Click(Sender: TObject);
var
HideName: string;
begin
if HeaderListBox1.ItemIndex=0 then
HideName:='所有人'
else
HideName:=GetName(HeaderListBox1.Items[HeaderListBox1.ItemIndex]);
if MessageBox(Form2.Handle,PChar('确定要用还阳术来使 '+HideName+
' 重新回到你的视线中吗'),'确认',MB_YESNO or MB_ICONQUESTION)=idYes
then
DeleteFromHideList(HideName);
end;
procedure TForm1.AddToHideList(Name: string);
var
I: Integer;
begin
if FindFromHideList(Name)<>-1 then
Exit;
for I:=1 to MAX_ONLINE do
if not HideList[I].Used then
begin
HideList[I].Used:=True;
HideList[I].Name:=Name;
Exit;
end;
end;
procedure TForm1.DeleteFromHideList(Name: string);
var
I: Integer;
begin
I:=FindFromHideList(Name);
if I<>-1 then
HideList[I].Used:=False;
end;
function TForm1.FindFromHideList(Name: string): Integer;
var
I: Integer;
begin
Result:=-1;
for I:=1 to MAX_ONLINE do
if (HideList[I].Used) and (HideList[I].Name=Name) then
begin
Result:=I;
Exit;
end;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if Logonned then
begin
Client.Active:=False;
Connected:=False;
Logonned:=False;
Timer2.Enabled:=False;
FlatTabControl1.ActiveTab:=0;
InfoDlg(Form2.Handle,'由于您长时间没有发言，已经自动离开了聊天室');
end;
end;
procedure TForm1.PlaySound(SoundName: string);
begin
try
MMWavePlayer1.Wave.FileName:=SOUND_DIR+'\'+SoundName;
MMWavePlayer1.Play;
except
on Exception do
end;
end;
procedure TForm1.RichEdit1Jump(Sender: TObject; id: Integer; s: String);
var
I: Integer;
begin
if FlatCheckBox4.Checked then
begin
I:=0;
while (Is) do
Inc(I);
if I