ss := TUdpSocket
.
Create(fmChat);
ss
.
LocalHost := ip;
if
length(uid) =
1
then
uid :=
'0'
+uid;
ss
.
LocalPort :=
'27'
+uid;
ss
.
OnReceive := fmChat
.
ssReceive;
ss
.
Open;
procedure
TfmChat
.
lstUsrDblClick(Sender: TObject);
var
page: TTabSheet;
mm,mm1: TRichEdit;
pnl, pnl1, pnl2 : TPanel;
sp: TSplitter;
btn : TButton;
begin
if
lstUsr
.
ItemIndex <> -
1
then
Begin
page := TTabSheet
.
Create(pgcChat);
page
.
Caption := lstUsr
.
Items[lstUsr
.
ItemIndex];
page
.
Name :=
'sh'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
page
.
PageControl := pgcChat;
pnl := TPanel
.
Create(page);
pnl
.
Align := alClient;
pnl
.
Name :=
'pnlcl'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
pnl
.
Caption :=
''
;
pnl
.
Parent := page;
pnl1 := TPanel
.
Create(pnl);
pnl1
.
Align := alClient;
pnl1
.
Name :=
'pnlchat'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
pnl1
.
Caption :=
''
;
pnl1
.
Parent := pnl;
pnl2 := TPanel
.
Create(pnl);
pnl2
.
Align := alBottom;
pnl2
.
Name :=
'pnlmsg'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
pnl2
.
Caption :=
''
;
pnl2
.
Height :=
200
;
pnl2
.
Parent := pnl;
sp := TSplitter
.
Create(pnl);
sp
.
Name :=
'spl'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
sp
.
Align := alBottom;
sp
.
Parent := pnl;
mm := TRichEdit
.
Create(pgcChat);
mm
.
Name :=
'rd'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
mm
.
Align := alClient;
mm
.
ScrollBars := ssVertical;
mm
.
WordWrap :=
True
;
mm
.
Parent := pnl1;
mm
.
ReadOnly :=
True
;
mm
.
Clear;
mm1 := TRichEdit
.
Create(pgcChat);
mm1
.
Name :=
'rdc'
+ (fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
mm1
.
Anchors := [akLeft,akTop,akRight,akBottom];
mm1
.
Height := pnl2
.
Height -
32
;
mm1
.
Width := pnl2
.
Width -
2
;
mm1
.
ScrollBars := ssVertical;
mm1
.
WordWrap :=
True
;
mm1
.
Parent := pnl2;
mm1
.
Clear;
btn := TButton
.
Create(pnl2);
btn
.
Width :=
80
;
btn
.
Height :=
22
;
btn
.
Caption :=
'Отправить'
;
btn
.
Left := pnl2
.
Width -
90
;
btn
.
Tag := strtoint(fmAdmin
.
lstLogId[lstUsr
.
ItemIndex]);
btn
.
Top := mm1
.
Top + mm1
.
Height +
5
;
btn
.
Anchors := [akRight,akBottom];
fmMain
.
zqry1
.
SQL
.
Text :=
'SELECT id, ip FROM users WHERE name="'
+lstUsr
.
Items[lstUsr
.
ItemIndex]+
'"'
;
fmMain
.
zqry1
.
Open;
if
Length(fmMain
.
ds1
.
DataSet
.
FieldByName(
'id'
).AsString) =
1
then
btn
.
Hint := fmMain
.
ds1
.
DataSet
.
FieldByName(
'ip'
).AsString+
':'
+
'270'
+fmMain
.
ds1
.
DataSet
.
FieldByName(
'id'
).AsString
else
btn
.
Hint := fmMain
.
ds1
.
DataSet
.
FieldByName(
'ip'
).AsString+
':'
+
'27'
+fmMain
.
ds1
.
DataSet
.
FieldByName(
'id'
).AsString;
btn
.
ShowHint :=
True
;
btn
.
OnClick := SendClick;
btn
.
Parent := pnl2;
end
;
end
;
procedure
TfmChat
.
SendClick(Sender: TObject);
var
p: TRichEdit;
ms: TStrings;
cs: TUdpSocket;
ip,port:
string
;
begin
p := pgcChat
.
FindComponent(
'rdc'
+IntToStr(TButton(Sender).tag))
as
TRichEdit;
if
Assigned(p)
then
begin
ms := p
.
Lines;
p := TRichEdit(pgcChat
.
FindComponent(
'rd'
+IntToStr(TButton(Sender).tag)));
if
Assigned(p)
then
begin
AddColoredLine(p,
'('
+DateTimeToStr(Now)+
')'
,clRed);
P
.
SelStart := Length(p
.
Text);
P
.
SelAttributes
.
Color := clBlack;
p
.
Lines
.
AddStrings(ms);
if
pos(
':'
,TButton(Sender).hint) <>
1
then
Begin
ip := copy(TButton(Sender).hint,
1
,pos(
':'
,TButton(Sender).hint)-
1
);
port := copy(TButton(Sender).hint,pos(
':'
,TButton(Sender).hint)+
1
,length(TButton(Sender).hint)-pos(
':'
,TButton(Sender).hint));
cs := TUdpSocket
.
Create(pgcChat);
cs
.
RemoteHost := ip;
cs
.
RemotePort := port;
cs
.
Name :=
'sck'
+IntToStr(TButton(Sender).tag);
try
if
cs
.
Connect
then
begin
case
Length(IntToStr(TButton(Sender).tag))
of
1
:cs
.
Sendln(
'00'
+IntToStr(TButton(Sender).tag)+ms
.
Text);
2
:cs
.
Sendln(
'0'
+IntToStr(TButton(Sender).tag)+ms
.
Text);
3
:cs
.
Sendln(IntToStr(TButton(Sender).tag)+ms
.
Text);
end
;
end
;
finally
cs
.
Disconnect;
end
;
end
;
ScrollToEnd(p);
end
;
end
;
end
;
procedure
TfmChat
.
ssReceive(Sender: TObject;Buf:
PAnsiChar
;
var
DataLen:
Integer
);
var
id:
String
;
p: TRichEdit;
ms: TStrings;
begin
id := IntToStr(StrToInt(Copy(Buf,
1
,
3
)));
ShowMessage(Buf);
p := pgcChat
.
FindComponent(
'rd'
+(id))
as
TRichEdit;
if
Assigned(p)
then
begin
ShowMessage(p
.
name);
AddColoredLine(p,lstUsr
.
Items[fmAdmin
.
lstLogId
.
IndexOf(id)]+
'('
+DateTimeToStr(Now)+
')'
,clRed);
P
.
SelStart := Length(p
.
Text);
P
.
SelAttributes
.
Color := clBlack;
ms
.
Text := copy(Buf,
4
,DataLen);
p
.
Lines
.
AddStrings(ms);
ScrollToEnd(p);
end
;
end
;