(*
Telegram coding
Position - Values - Sence
(byte)
0 - W Waiting for startgame
Q Request for joining
A Answer for request
S Game Started
T Game Stopped
M User Message (Chat)
U User Turn
Network Game ...noch im aufbau!
*)
unit _fm_Net;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, ComCtrls, Buttons, StdCtrls, ImgList, Psock, NMMSG, ScktComp,
Tabnotbk;
type
Tfm_Net = class(TForm)
Panel1 : TPanel;
Panel2 : TPanel;
btNetReload: TSpeedButton;
btRunGame : TSpeedButton;
Panel3 : TPanel;
meChat : TMemo;
Splitter1 : TSplitter;
Panel4 : TPanel;
Label1 : TLabel;
cbNetRes : TComboBox;
edMessage : TEdit;
nmClient : TNMMsg;
nmServer : TNMMSGServ;
StatusBar1: TStatusBar;
tmNet : TTimer;
tmDebug : TTimer;
Notebook1 : TNotebook;
SpeedButton1: TSpeedButton;
Label2 : TLabel;
Label3 : TLabel;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
cbNetPlayerName: TComboBox;
GroupBox1 : TGroupBox;
Image1 : TImage;
RadioButton1: TRadioButton;
RadioButton2: TRadioButton;
Image2 : TImage;
Label4 : TLabel;
Label5 : TLabel;
ComboBox1 : TComboBox;
ComboBox2 : TComboBox;
ComboBox3 : TComboBox;
ComboBox4 : TComboBox;
ComboBox5 : TComboBox;
ComboBox6 : TComboBox;
Edit1 : TEdit;
Label6 : TLabel;
Edit2 : TEdit;
Edit3 : TEdit;
Edit4 : TEdit;
Edit5 : TEdit;
procedure FormActivate(Sender: TObject);
procedure btRunGameClick(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
procedure edMessageKeyPress(Sender: TObject; var Key: Char);
procedure nmClientConnect(Sender: TObject);
procedure nmClientConnectionFailed(Sender: TObject);
procedure nmClientDisconnect(Sender: TObject);
procedure nmClientHostResolved(Sender: TComponent);
procedure nmClientMessageSent(Sender: TObject);
procedure nmClientStatus(Sender: TComponent; Status: String)
;
procedure nmServerClientContact(Sender: TObject);
procedure nmServerMSG(Sender: TComponent; const sFrom,
sMsg: String);
procedure nmServerStatus(Sender: TComponent; Status
: String);
procedure tmNetTimer(Sender: TObject);
procedure tmDebugTimer(Sender: TObject);
procedure FormClose(Sender: TObject; var
Action: TCloseAction);
procedure FormKeyPress(Sender: TObject;
var Key: Char);
procedure nmClientInvalidHost(var
Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
const
_iNetPortNr = 420012;
var
fm_Net : Tfm_Net;
{------------------------------------------------------------------------------}
{------------------------------------------------------------------------------}
implementation
{$R *.DFM}
uses
_fm_Main, LangSupp;
var
StartTime : TDateTime;
NetCurrUser: integer;
NetPlayers: integer;
{------------------------------------------------------------------------------}
procedure Tfm_Net.FormActivate(Sender: TObject);
begin
NetStartTime := Now;
HeadMaster := '';
NetPlayers := 0;
btRunGame.Enabled := false;
tmDebug.Enabled := true;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.FormResize(Sender: TObject);
begin
edMessage.Width := Width - 295
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.StatusBar1DrawPanel(StatusBar: TStatusBar;
Panel: TStatusPanel; const Rect: TRect);
begin
if (NetPlayers in [2..5]) then begin
StatusBar.Canvas.Brush.Color := $0033ffff;
StatusBar.Canvas.FillRect(Rect);
StatusBar.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+1,
Format(_M_cNetReadyCnt,[NetPlayers]));
end
else begin
StatusBar.Canvas.Brush.Color := $003333ff;
StatusBar.Canvas.FillRect(Rect);
if NetPlayers<2 then
StatusBar.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+1, _M_cNetErrLess)
else
StatusBar.Canvas.TextRect(Rect, Rect.Left+2, Rect.Top+1, _M_cNetErrMore);
end;
StatusBar.Update;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmClientConnect(Sender: TObject);
begin
StatusBar1.Panels[2].Text := 'Connected';
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmClientConnectionFailed(Sender: TObject);
begin
StatusBar1.Panels[2].Text := 'Connection Failed';
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmClientDisconnect(Sender: TObject);
begin
StatusBar1.Panels[2].Text := 'Disconnected';
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmClientHostResolved(Sender: TComponent);
begin
StatusBar1.Panels[2].Text := 'Host Resolved';
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmClientMessageSent(Sender: TObject);
begin
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmClientStatus(Sender: TComponent; Status: String);
begin
StatusBar1.Panels[2].Text := nmClient.Status;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmServerClientContact(Sender: TObject);
begin
nmServer.ReportLevel := Status_Basic;
nmServer.TimeOut := _iNetPortNr;
StatusBar1.Panels[2].Text := 'Client connected';
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmServerStatus(Sender: TComponent; Status: String);
begin
StatusBar1.Panels[2].Text := status;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.edMessageKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#13 then begin
// if cbNetRes.Text='' then
cbNetRes.ItemIndex := cbNetRes.Items.Add('127.0.0.1');
nmClient.Host := cbNetRes.Text;
nmClient.FromName := NetSelfName;
meChat.Lines.Add(TimeToStr(Time) + ': ' + nmClient.Host + ' > ' + edMessage.Text);
try
nmClient.PostIt('M'+edMessage.Text);
except
StatusBar1.Panels[2].Text := 'Error during transmitting';
end;
end;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.nmServerMSG(Sender: TComponent; const sFrom,
sMsg: String);
var
i : integer;
begin
{Form is active}
if fm_Net.Active then
case sMsg[1] of
{user Message (chat)}
'M':
meChat.Lines.Add(TimeToStr(Time) + ': ' + sFrom + ' < ' +
Copy(sMsg,2,length(sMsg)-1));
{reQuest from MASTER for joining}
'Q': begin
{WE ARE MASTER}
if (HeadMaster=NetSelfName) or (HeadMaster='') then
{incoming not from us}
if (sFrom<>NetSelfName) then begin
meChat.Lines.Add(TimeToStr(Time) + ': ' + sFrom +
' - MASTER => 2 MASTERS IN NET!');
btRunGame.Enabled := false;
if Strtofloat(Copy(sMsg,2,length(sMsg)))<NetStartTime then begin
HeadMaster := sFrom;
meChat.Lines.Add(TimeToStr(Time) + ': ' + sFrom + 'Priority have '+sFrom
)
end
else
meChat.Lines.Add(TimeToStr(Time) + ': ' + sFrom + 'Priority have '+
NetSelfName);
end
{incoming from US}
else begin
HeadMaster := NetSelfName;
btRunGame.Caption := _M_sGPlay;
// lvNetRes.Items[IndexByName(sFrom)].ImageIndex := 2;
end
{we are not master => joining}
else begin
btRunGame.Caption := _M_cNetJoin;
StatusBar1.Panels[2].Text := 'Waiting for master ('+HeadMaster+') ...';
end;
{ if (sFrom=HeadMaster) then
lvNetRes.Items[IndexByName(sFrom)].ImageIndex:=2
else
lvNetRes.Items[IndexByName(sFrom)].ImageIndex:=1;
lvNetRes.Items[IndexByName(sFrom)].SubItems[3]:=Copy(sMsg,2,length(sMsg));
}
end;
{Game Started}
'S': begin
end;
{User (not Master) Ready to Play}
'W': begin
// lvNetRes.Items[IndexByName(sFrom)].ImageIndex := 1;
// lvNetRes.Items[IndexByName(sFrom)].SubItems[3] := Copy(sMsg,2,
length(sMsg));
end;
{Game Stopped}
{User Turn}
end
{Form is not active}
else
case sMsg[1] of
{reQuest for joining}
'Q': begin
// HeadMaster := sFrom;
// meChat.Lines.Add(TimeToStr(Time) + ': ' + sFrom + ' - MASTER');
end;
end;
{Counting NetPlayers
NetPlayers:=0;
for i:=0 to fm_Net.lvNetRes.Items.Count-1 do
if fm_Net.lvNetRes.Items[i].ImageIndex>0 then
inc(NetPlayers);
}
// if (NetPlayers>1) then
showmessage('>1')
else
showmessage('<2');
StatusBar1.Refresh;
if (NetPlayers>1) and (HeadMaster=NetSelfName) then begin
btRunGame.Enabled := (NetPlayers in [2..5]);
end;
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.tmNetTimer(Sender: TObject);
begin
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.btRunGameClick(Sender: TObject);
var
i,p,cbNo : integer;
Order : real;
begin
{
tmNet.Enabled:=false;
cbNo:=-1;
for p:=1 to NetPlayers do begin
Order:=400000;
for i:=0 to fm_Net.lvNetRes.Items.Count-1 do
if fm_Net.lvNetRes.Items[i].ImageIndex>0 then
if Frac(strtofloat(lvNetRes.Items[i].SubItems[3]))>0 then
if strtofloat(lvNetRes.Items[i].SubItems[3])<Order then begin
cbNo:=i;
Order:=strtofloat(lvNetRes.Items[i].SubItems[3]);
end;
lvNetRes.Items[cbNo].SubItems[3]:=inttostr(p);
end;
}
end;
{------------------------------------------------------------------------------}
procedure Tfm_Net.tmDebugTimer(Sender: TObject);
begin
Caption := Copy(Caption, 2, length(Caption)) + Caption[1];
end;
procedure Tfm_Net.FormClose(Sender: TObject; var Action: TCloseAction);
begin
tmDebug.Enabled := false;
end;
procedure Tfm_Net.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#27 then
Close
end;
procedure Tfm_Net.nmClientInvalidHost(var Handled: Boolean);
begin
{
If InputQuery('Invalid Host!', 'Specify a new host:', TmpStr) then
Begin
nmClient.Host := TmpStr;
Handled := TRUE;
End;}
end;
end.