(* 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.