diff --git a/applications/fpchess/chesstcputils.pas b/applications/fpchess/chesstcputils.pas new file mode 100644 index 000000000..2fe767f33 --- /dev/null +++ b/applications/fpchess/chesstcputils.pas @@ -0,0 +1,66 @@ +unit chesstcputils; + +{$mode objfpc}{$H+} + +interface + +uses + {$IFDEF MSWINDOWS} + Winsock, + {$ENDIF} + Classes, SysUtils; + +function ChessGetLocalIP(): string; + +implementation + +const + CFormatIPMask = '%d.%d.%d.%d'; + +function ChessGetLocalIP(): string; +var + I, VAttempt: Integer; + VStrTemp, VSitesToTry: TStringList; +{$IFDEF UNIX} + VProcess: TProcess; +{$ENDIF} +{$IFDEF MSWINDOWS} +var + VWSAData: TWSAData; + VHostEnt: PHostEnt; + VName: string; +{$ENDIF} +begin + Result := ''; +{$IFDEF UNIX} + VStrTemp := TStringList.Create; + VProcess := TProcess.Create(nil); + try + VProcess.CommandLine := + 'sh -c "ifconfig eth0 | awk ''/inet end/ {print $3}''"'; + VProcess.Options := [poWaitOnExit, poUsePipes]; + VProcess.Execute; + VStrTemp.LoadFromStream(VProcess.Output); + Result := Trim(VStrTemp.Text); + finally + VStrTemp.Free; + VProcess.Free; + end; +{$ENDIF} +{$IFDEF MSWINDOWS} +{$HINTS OFF} + WSAStartup(2, VWSAData); +{$HINTS ON} + SetLength(VName, 255); + GetHostName(PChar(VName), 255); + SetLength(VName, StrLen(PChar(VName))); + VHostEnt := GetHostByName(PChar(VName)); + with VHostEnt^ do + Result := Format(CFormatIPMask, [Byte(h_addr^[0]), Byte(h_addr^[1]), + Byte(h_addr^[2]), Byte(h_addr^[3])]); + WSACleanup; +{$ENDIF} +end; + +end. + diff --git a/applications/fpchess/fpchess.lpi b/applications/fpchess/fpchess.lpi index f2261a5e6..f748eb224 100644 --- a/applications/fpchess/fpchess.lpi +++ b/applications/fpchess/fpchess.lpi @@ -4,11 +4,11 @@ + - @@ -34,17 +34,11 @@ - + - - - - - - @@ -52,381 +46,33 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + - - - - - - - - + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - @@ -446,6 +92,9 @@ + + + diff --git a/applications/fpchess/fpchess.lpr b/applications/fpchess/fpchess.lpr index f82952d76..06674600b 100644 --- a/applications/fpchess/fpchess.lpr +++ b/applications/fpchess/fpchess.lpr @@ -7,7 +7,8 @@ uses cthreads, {$ENDIF}{$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, lnetvisual, mainform, chessdrawer, chessgame, chessconfig, tcpcomm; + Forms, lnetvisual, mainform, chessdrawer, chessgame, chessconfig, tcpcomm, + chesstcputils; {$R *.res} diff --git a/applications/fpchess/mainform.lfm b/applications/fpchess/mainform.lfm index 8350c4fa5..8d03c1e40 100644 --- a/applications/fpchess/mainform.lfm +++ b/applications/fpchess/mainform.lfm @@ -13,12 +13,12 @@ object formChess: TformChess Height = 433 Top = 0 Width = 360 - PageIndex = 1 + PageIndex = 0 Align = alClient TabOrder = 0 TabStop = True object pageStart: TUNBPage - OnBeforeShow = pageStartBeforeShow + OnBeforeShow = pageBeforeShow ClientWidth = 360 ClientHeight = 433 object Label1: TLabel @@ -72,7 +72,7 @@ object formChess: TformChess end object editPlayerName: TLabeledEdit Left = 88 - Height = 22 + Height = 21 Top = 72 Width = 120 EditLabel.AnchorSideLeft.Control = editPlayerName @@ -80,10 +80,10 @@ object formChess: TformChess EditLabel.AnchorSideTop.Side = asrCenter EditLabel.AnchorSideRight.Control = editPlayerName EditLabel.AnchorSideBottom.Control = editPlayerName - EditLabel.Left = 6 - EditLabel.Height = 17 + EditLabel.Left = 24 + EditLabel.Height = 14 EditLabel.Top = 75 - EditLabel.Width = 79 + EditLabel.Width = 61 EditLabel.Caption = 'Player Name' EditLabel.ParentColor = False LabelPosition = lpLeft @@ -91,9 +91,9 @@ object formChess: TformChess end object Label6: TLabel Left = 28 - Height = 17 + Height = 14 Top = 104 - Width = 52 + Width = 43 Caption = 'Start as:' ParentColor = False end @@ -102,7 +102,7 @@ object formChess: TformChess Height = 21 Top = 104 Width = 120 - ItemHeight = 0 + ItemHeight = 13 ItemIndex = 0 Items.Strings = ( 'White' @@ -113,9 +113,9 @@ object formChess: TformChess end object checkTimer: TCheckBox Left = 24 - Height = 18 + Height = 17 Top = 136 - Width = 212 + Width = 163 Caption = 'Set a time limit for each Player' Checked = True State = cbChecked @@ -123,7 +123,7 @@ object formChess: TformChess end object spinPlayerTime: TSpinEdit Left = 21 - Height = 16 + Height = 21 Top = 160 Width = 50 TabOrder = 6 @@ -131,9 +131,9 @@ object formChess: TformChess end object Label7: TLabel Left = 80 - Height = 17 + Height = 14 Top = 163 - Width = 150 + Width = 114 Caption = 'minutes for each player' ParentColor = False end @@ -148,8 +148,9 @@ object formChess: TformChess end end object pageConfigConnection: TUNBPage - ClientWidth = 360 - ClientHeight = 433 + OnBeforeShow = pageBeforeShow + ClientWidth = 2880 + ClientHeight = 3464 object Label3: TLabel Left = 0 Height = 32 @@ -211,8 +212,9 @@ object formChess: TformChess end end object pageConnecting: TUNBPage - ClientWidth = 1920 - ClientHeight = 2400 + OnBeforeShow = pageBeforeShow + ClientWidth = 15360 + ClientHeight = 19200 object Label4: TLabel Left = 0 Height = 32 @@ -234,8 +236,9 @@ object formChess: TformChess end end object pageGame: TUNBPage - ClientWidth = 960 - ClientHeight = 1732 + OnBeforeShow = pageBeforeShow + ClientWidth = 7680 + ClientHeight = 13856 object Label5: TLabel Left = 0 Height = 32 diff --git a/applications/fpchess/mainform.pas b/applications/fpchess/mainform.pas index d840f0886..5e7df80c7 100644 --- a/applications/fpchess/mainform.pas +++ b/applications/fpchess/mainform.pas @@ -8,7 +8,7 @@ uses Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls, StdCtrls, Buttons, Spin, // - chessdrawer, chessgame, chessconfig; + chessdrawer, chessgame, chessconfig, chesstcputils; type @@ -54,7 +54,7 @@ type timerChessTimer: TTimer; procedure FormCreate(Sender: TObject); procedure HandleMainScreenButton(Sender: TObject); - procedure pageStartBeforeShow(Sender: TObject); + procedure pageBeforeShow(Sender: TObject; ANewPage: TUNBPage; ANewIndex: Integer); procedure timerChessTimerTimer(Sender: TObject); private { private declarations } @@ -71,28 +71,34 @@ implementation {$R *.lfm} +const + INT_PAGE_START = 0; + INT_PAGE_CONFIGCONNECTION = 1; + INT_PAGE_CONNECTING = 2; + INT_PAGE_GAME = 3; + { TformChess } procedure TformChess.HandleMainScreenButton(Sender: TObject); begin if Sender = btnSinglePlayer then begin - notebookMain.PageIndex := 3; + notebookMain.PageIndex := INT_PAGE_GAME; vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value); end else if Sender = btnHotSeat then begin - notebookMain.PageIndex := 3; + notebookMain.PageIndex := INT_PAGE_GAME; vChessGame.StartNewGame(comboStartColor.ItemIndex, checkTimer.Checked, spinPlayerTime.Value); end - else if Sender = btnDirectComm then notebookMain.PageIndex := 1; + else if Sender = btnDirectComm then notebookMain.PageIndex := INT_PAGE_CONFIGCONNECTION; end; -procedure TformChess.pageStartBeforeShow(Sender: TObject); +procedure TformChess.pageBeforeShow(Sender: TObject; ANewPage: TUNBPage; ANewIndex: Integer); begin - if notebookMain.PageIndex = 1 then + if ANewIndex = INT_PAGE_CONFIGCONNECTION then begin - editLocalIP.Text := ''; + editLocalIP.Text := ChessGetLocalIP(); end; end;