Changeset 196
- Timestamp:
- May 16, 2018, 9:56:24 AM (7 years ago)
- Location:
- trunk
- Files:
-
- 2 added
- 10 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormMain.pas
r192 r196 168 168 Core.PersistentForm.Save(Self); 169 169 SaveConfig(Core.XMLConfig1, 'FormMain'); 170 Core. XMLConfig1.Flush;170 Core.Done; 171 171 end; 172 172 -
trunk/Forms/UFormNew.lfm
r194 r196 21 21 Top = 4 22 22 Width = 1061 23 ActivePage = TabSheet 223 ActivePage = TabSheetMode 24 24 Align = alClient 25 25 BorderSpacing.Around = 4 26 TabIndex = 226 TabIndex = 0 27 27 TabOrder = 0 28 28 object TabSheetMode: TTabSheet 29 29 Caption = 'Mode' 30 ClientHeight = 29731 ClientWidth = 75930 ClientHeight = 523 31 ClientWidth = 1053 32 32 object RadioButtonModeLocal: TRadioButton 33 33 Left = 10 … … 90 90 object ListViewServers: TListView 91 91 Left = 26 92 Height = 9792 Height = 291 93 93 Top = 181 94 Width = 3 2694 Width = 334 95 95 Anchors = [akTop, akLeft, akBottom] 96 96 Columns = < … … 103 103 Width = 200 104 104 end> 105 MultiSelect = True 106 OwnerData = True 107 PopupMenu = PopupMenuServers 108 ReadOnly = True 109 RowSelect = True 105 110 TabOrder = 5 106 111 ViewStyle = vsReport 112 OnData = ListViewServersData 113 OnDblClick = AServerModifyExecute 114 OnKeyPress = ListViewServersKeyPress 115 OnSelectItem = ListViewServersSelectItem 116 end 117 object Button1: TButton 118 Left = 27 119 Height = 31 120 Top = 484 121 Width = 94 122 Action = AServerAdd 123 Anchors = [akLeft, akBottom] 124 TabOrder = 6 125 end 126 object Button2: TButton 127 Left = 240 128 Height = 31 129 Top = 484 130 Width = 94 131 Action = AServerRemove 132 Anchors = [akLeft, akBottom] 133 TabOrder = 7 134 end 135 object Button3: TButton 136 Left = 136 137 Height = 30 138 Top = 484 139 Width = 94 140 Action = AServerModify 141 Anchors = [akLeft, akBottom] 142 TabOrder = 8 107 143 end 108 144 end … … 137 173 end> 138 174 OwnerData = True 139 PopupMenu = PopupMenu 1175 PopupMenu = PopupMenuPlayers 140 176 ReadOnly = True 141 177 RowSelect = True … … 557 593 object ActionList1: TActionList 558 594 Images = Core.ImageListSmall 559 left = 256560 top = 440595 left = 568 596 top = 296 561 597 object APlayerModify: TAction 562 598 Caption = 'Modify player' … … 571 607 OnExecute = APlayerRemoveExecute 572 608 end 609 object AServerAdd: TAction 610 Caption = 'Add' 611 OnExecute = AServerAddExecute 612 end 613 object AServerRemove: TAction 614 Caption = 'Remove' 615 OnExecute = AServerRemoveExecute 616 end 617 object AServerModify: TAction 618 Caption = 'Modify' 619 OnExecute = AServerModifyExecute 620 end 573 621 end 574 622 object OpenPictureDialog1: TOpenPictureDialog 575 left = 424576 top = 440577 end 578 object PopupMenu 1: TPopupMenu579 left = 128580 top = 440623 left = 568 624 top = 360 625 end 626 object PopupMenuPlayers: TPopupMenu 627 left = 568 628 top = 232 581 629 object MenuItem1: TMenuItem 582 630 Action = APlayerAdd … … 590 638 end 591 639 end 640 object PopupMenuServers: TPopupMenu 641 left = 121 642 top = 317 643 object MenuItem4: TMenuItem 644 Action = AServerAdd 645 end 646 object MenuItem6: TMenuItem 647 Action = AServerModify 648 end 649 object MenuItem5: TMenuItem 650 Action = AServerRemove 651 end 652 end 592 653 end -
trunk/Forms/UFormNew.pas
r194 r196 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 9 ComCtrls, Spin, ExtCtrls, ActnList, ExtDlgs, Menus, UGame, UGeometry, 10 UGameServer ;10 UGameServer, UServerList; 11 11 12 12 type … … 15 15 16 16 TFormNew = class(TForm) 17 AServerModify: TAction; 18 AServerAdd: TAction; 19 AServerRemove: TAction; 17 20 APlayerAdd: TAction; 18 21 APlayerRemove: TAction; 19 22 APlayerModify: TAction; 20 23 ActionList1: TActionList; 24 Button1: TButton; 25 Button2: TButton; 26 Button3: TButton; 21 27 ButtonCancel: TButton; 22 28 ButtonImageBrowse: TButton; … … 52 58 MenuItem2: TMenuItem; 53 59 MenuItem3: TMenuItem; 60 MenuItem4: TMenuItem; 61 MenuItem5: TMenuItem; 62 MenuItem6: TMenuItem; 54 63 OpenPictureDialog1: TOpenPictureDialog; 55 64 PageControl1: TPageControl; 56 65 PanelButtons: TPanel; 57 66 PanelChat: TPanel; 58 PopupMenu1: TPopupMenu; 67 PopupMenuPlayers: TPopupMenu; 68 PopupMenuServers: TPopupMenu; 59 69 RadioButtonModeNetworkServer: TRadioButton; 60 70 RadioButtonModeNetworkClient: TRadioButton; … … 79 89 procedure APlayerModifyExecute(Sender: TObject); 80 90 procedure APlayerRemoveExecute(Sender: TObject); 91 procedure AServerAddExecute(Sender: TObject); 92 procedure AServerModifyExecute(Sender: TObject); 93 procedure AServerRemoveExecute(Sender: TObject); 81 94 procedure ButtonImageBrowseClick(Sender: TObject); 82 95 procedure CheckBoxCityChange(Sender: TObject); … … 97 110 procedure ListViewPlayersSelectItem(Sender: TObject; Item: TListItem; 98 111 Selected: Boolean); 112 procedure ListViewServersData(Sender: TObject; Item: TListItem); 113 procedure ListViewServersKeyPress(Sender: TObject; var Key: char); 114 procedure ListViewServersSelectItem(Sender: TObject; Item: TListItem; 115 Selected: Boolean); 99 116 procedure RadioButtonModeLocalChange(Sender: TObject); 100 117 procedure SpinEditMapSizeXChange(Sender: TObject); … … 106 123 Players: TPlayers; 107 124 public 125 ServerList: TServerList; 108 126 procedure Translate; 109 127 procedure ReloadView; … … 121 139 122 140 uses 123 UFormPlayer, UFormChat, UCore ;141 UFormPlayer, UFormChat, UCore, UFormServer; 124 142 125 143 resourcestring … … 141 159 SRounded = 'Rounded'; 142 160 SFromImageFile = 'From image file'; 161 SRemoveServer = 'Remove server'; 162 SRemoveServerQuery = 'Do you want to remove server?'; 143 163 144 164 { TFormNew } … … 177 197 begin 178 198 ReloadView; 199 end; 200 201 procedure TFormNew.ListViewServersData(Sender: TObject; Item: TListItem); 202 begin 203 if Item.Index < ServerList.Items.Count then 204 with TServerInfo(ServerList.Items[Item.Index]) do begin 205 Item.Caption := Name; 206 Item.Data := ServerList.Items[Item.Index]; 207 Item.SubItems.Add(Address + ':' + IntToStr(Port)); 208 end; 209 end; 210 211 procedure TFormNew.ListViewServersKeyPress(Sender: TObject; var Key: char); 212 begin 213 if Key = #13 then AServerModify.Execute; 214 end; 215 216 procedure TFormNew.ListViewServersSelectItem(Sender: TObject; Item: TListItem; 217 Selected: Boolean); 218 begin 219 UpdateInterface; 179 220 end; 180 221 … … 262 303 ListViewPlayers.Items.Count := Players.Count; 263 304 ListViewPlayers.Refresh; 305 ListViewServers.Items.Count := ServerList.Items.Count; 306 ListViewServers.Refresh; 264 307 Translate; 265 308 UpdateInterface; … … 278 321 PanelChat.Visible := RadioButtonModeNetworkClient.Checked or RadioButtonModeNetworkServer.Checked; 279 322 SpinEditNeutralUnits.MaxValue := SpinEditMaxPower.Value; 323 AServerRemove.Enabled := RadioButtonModeNetworkClient.Checked and Assigned(ListViewServers.Selected); 324 AServerAdd.Enabled := RadioButtonModeNetworkClient.Checked; 325 AServerModify.Enabled := RadioButtonModeNetworkClient.Checked; 280 326 end; 281 327 … … 350 396 if Assigned(ListViewPlayers.Selected) then begin 351 397 Players.Remove(ListViewPlayers.Selected.Data); 398 ReloadView; 399 end; 400 end; 401 402 procedure TFormNew.AServerAddExecute(Sender: TObject); 403 var 404 NewServer: TServerInfo; 405 begin 406 FormServer := TFormServer.Create(nil); 407 NewServer := TServerInfo.Create; 408 FormServer.Load(NewServer); 409 if FormServer.ShowModal = mrOK then begin 410 FormServer.Save(NewServer); 411 ServerList.Items.Add(NewServer); 412 ReloadView; 413 end else NewServer.Free; 414 FormServer.Free; 415 end; 416 417 procedure TFormNew.AServerModifyExecute(Sender: TObject); 418 var 419 Server: TServerInfo; 420 begin 421 FormServer := TFormServer.Create(nil); 422 Server := TServerInfo(ListViewServers.Selected.Data); 423 FormServer.Load(Server); 424 if FormServer.ShowModal = mrOK then begin 425 FormServer.Save(Server); 426 ReloadView; 427 end; 428 FormServer.Free; 429 end; 430 431 procedure TFormNew.AServerRemoveExecute(Sender: TObject); 432 var 433 I: Integer; 434 begin 435 if MessageDlg(SRemoveServer, SRemoveServerQuery, 436 TMsgDlgType.mtConfirmation, [mbCancel, mbOk], 0) = mrOk then begin 437 for I := ListViewServers.Items.Count - 1 downto 0 do 438 if ListViewServers.Items[I].Selected then 439 ServerList.Items.Delete(I); 352 440 ReloadView; 353 441 end; … … 424 512 LocalNetworkAddress := EditServerAddress.Text; 425 513 LocalNetworkPort := SpinEditServerPort.Value; 514 if Assigned(ListViewServers.Selected) then begin 515 RemoteNetworkAddress := TServerInfo(ListViewServers.Selected.Data).Address; 516 RemoteNetworkPort := TServerInfo(ListViewServers.Selected.Data).Port; 517 end else begin 518 RemoteNetworkAddress := ''; 519 RemoteNetworkPort := 0; 520 end; 426 521 Game.PlayersSetting.Assign(Players); 427 522 Game.SymetricMap := CheckBoxSymetricMap.Checked; -
trunk/Languages/xtactics.cs.po
r195 r196 305 305 #: tformnew.aplayeradd.caption 306 306 #| msgid "Add player" 307 msgctxt "tformnew.aplayeradd.caption" 307 308 msgid "Add" 308 309 msgstr "Přidat" … … 314 315 #: tformnew.aplayerremove.caption 315 316 #| msgid "Remove player" 317 msgctxt "tformnew.aplayerremove.caption" 318 msgid "Remove" 319 msgstr "Odstranit" 320 321 #: tformnew.aserveradd.caption 322 msgctxt "tformnew.aserveradd.caption" 323 msgid "Add" 324 msgstr "Přidat" 325 326 #: tformnew.aservermodify.caption 327 msgctxt "tformnew.aservermodify.caption" 328 msgid "Modify" 329 msgstr "Upravit" 330 331 #: tformnew.aserverremove.caption 332 msgctxt "tformnew.aserverremove.caption" 316 333 msgid "Remove" 317 334 msgstr "Odstranit" … … 333 350 334 351 #: tformnew.buttonplayermodify.caption 352 msgctxt "tformnew.buttonplayermodify.caption" 335 353 msgid "Modify" 336 354 msgstr "Upravit" … … 372 390 373 391 #: tformnew.label11.caption 392 msgctxt "tformnew.label11.caption" 374 393 msgid "Port:" 375 394 msgstr "Port:" 376 395 377 396 #: tformnew.label12.caption 397 msgctxt "tformnew.label12.caption" 378 398 msgid "Address:" 379 399 msgstr "Adresa:" … … 508 528 509 529 #: tformplayer.label1.caption 530 msgctxt "tformplayer.label1.caption" 510 531 msgid "Name:" 511 532 msgstr "Jméno:" … … 563 584 msgid "Units" 564 585 msgstr "Jednotky" 586 587 #: tformserver.buttoncancel.caption 588 msgctxt "tformserver.buttoncancel.caption" 589 msgid "Cancel" 590 msgstr "Zrušit" 591 592 #: tformserver.buttonok.caption 593 msgid "OK" 594 msgstr "OK" 595 596 #: tformserver.caption 597 msgid "Server" 598 msgstr "Server" 599 600 #: tformserver.label1.caption 601 msgctxt "tformserver.label1.caption" 602 msgid "Name:" 603 msgstr "Jméno:" 604 605 #: tformserver.label2.caption 606 msgctxt "tformserver.label2.caption" 607 msgid "Address:" 608 msgstr "Adresa:" 609 610 #: tformserver.label3.caption 611 msgctxt "tformserver.label3.caption" 612 msgid "Port:" 613 msgstr "Port:" 565 614 566 615 #: tformsettings.buttoncancel.caption … … 778 827 msgstr "Obdelníkový" 779 828 829 #: uformnew.sremoveserver 830 msgid "Remove server" 831 msgstr "Odstranit server" 832 833 #: uformnew.sremoveserverquery 834 msgid "Do you want to remove server?" 835 msgstr "Chcete odstranit server?" 836 780 837 #: uformnew.srounded 781 838 msgid "Rounded" -
trunk/Languages/xtactics.po
r195 r196 293 293 294 294 #: tformnew.aplayeradd.caption 295 msgctxt "tformnew.aplayeradd.caption" 295 296 msgid "Add" 296 297 msgstr "" … … 301 302 302 303 #: tformnew.aplayerremove.caption 304 msgctxt "tformnew.aplayerremove.caption" 305 msgid "Remove" 306 msgstr "" 307 308 #: tformnew.aserveradd.caption 309 msgctxt "tformnew.aserveradd.caption" 310 msgid "Add" 311 msgstr "" 312 313 #: tformnew.aservermodify.caption 314 msgctxt "tformnew.aservermodify.caption" 315 msgid "Modify" 316 msgstr "" 317 318 #: tformnew.aserverremove.caption 319 msgctxt "tformnew.aserverremove.caption" 303 320 msgid "Remove" 304 321 msgstr "" … … 320 337 321 338 #: tformnew.buttonplayermodify.caption 339 msgctxt "tformnew.buttonplayermodify.caption" 322 340 msgid "Modify" 323 341 msgstr "" … … 358 376 359 377 #: tformnew.label11.caption 378 msgctxt "tformnew.label11.caption" 360 379 msgid "Port:" 361 380 msgstr "" 362 381 363 382 #: tformnew.label12.caption 383 msgctxt "tformnew.label12.caption" 364 384 msgid "Address:" 365 385 msgstr "" … … 493 513 494 514 #: tformplayer.label1.caption 515 msgctxt "tformplayer.label1.caption" 495 516 msgid "Name:" 496 517 msgstr "" … … 547 568 msgctxt "tformplayersstats.listview1.columns[5].caption" 548 569 msgid "Units" 570 msgstr "" 571 572 #: tformserver.buttoncancel.caption 573 msgctxt "tformserver.buttoncancel.caption" 574 msgid "Cancel" 575 msgstr "" 576 577 #: tformserver.buttonok.caption 578 msgid "OK" 579 msgstr "" 580 581 #: tformserver.caption 582 msgid "Server" 583 msgstr "" 584 585 #: tformserver.label1.caption 586 msgctxt "tformserver.label1.caption" 587 msgid "Name:" 588 msgstr "" 589 590 #: tformserver.label2.caption 591 msgctxt "tformserver.label2.caption" 592 msgid "Address:" 593 msgstr "" 594 595 #: tformserver.label3.caption 596 msgctxt "tformserver.label3.caption" 597 msgid "Port:" 549 598 msgstr "" 550 599 … … 757 806 msgstr "" 758 807 808 #: uformnew.sremoveserver 809 msgid "Remove server" 810 msgstr "" 811 812 #: uformnew.sremoveserverquery 813 msgid "Do you want to remove server?" 814 msgstr "" 815 759 816 #: uformnew.srounded 760 817 msgid "Rounded" -
trunk/UCore.pas
r195 r196 9 9 UGame, UApplicationInfo, UPersistentForm, UScaleDPI, UCoolTranslator, 10 10 URegistry, ULastOpenedList, Registry, Menus, UGeometry, UFormClient, 11 UGameServer, UGameClient, fgl ;11 UGameServer, UGameClient, fgl, UServerList; 12 12 13 13 type … … 91 91 FormClients: TFPGObjectList<TFormClient>; 92 92 Clients: TClients; 93 ServerList: TServerList; 93 94 procedure Spectate(Player: TPlayer); 94 95 procedure UpdateActions; 95 96 procedure Init; 97 procedure Done; 96 98 property Initialized: Boolean read FInitialized; 97 99 end; … … 295 297 try 296 298 FormNew.Load(Server); 299 FormNew.ServerList := ServerList; 297 300 if FormNew.ShowModal = mrOk then begin 298 301 FormNew.Save(Server); … … 392 395 ForceDirectories(GetAppConfigDir(False)); 393 396 FormClients := TFPGObjectList<TFormClient>.Create; 397 ServerList := TServerList.Create; 394 398 end; 395 399 396 400 procedure TCore.DataModuleDestroy(Sender: TObject); 397 401 begin 402 FreeAndNil(ServerList); 398 403 if Assigned(FormPlayersStats) then FreeAndNil(FormPlayersStats); 399 404 if Assigned(FormUnitMoves) then FreeAndNil(FormUnitMoves); … … 401 406 FreeAndNil(FormClients); 402 407 FreeAndNil(StoredDimension); 403 Game.SaveConfig(XMLConfig1, 'Game');404 Server.SaveConfig(XMLConfig1, 'Server');405 SaveConfig;406 408 FreeAndNil(Server); 407 409 FreeAndNil(Game); … … 546 548 Game.LoadConfig(XMLConfig1, 'Game'); 547 549 Server.LoadConfig(XMLConfig1, 'Server'); 550 ServerList.LoadConfig(XmlConfig1, 'ServerList'); 548 551 549 552 CommandLineParams; … … 556 559 end; 557 560 561 procedure TCore.Done; 562 begin 563 Game.SaveConfig(XMLConfig1, 'Game'); 564 Server.SaveConfig(XMLConfig1, 'Server'); 565 ServerList.SaveConfig(XmlConfig1, 'ServerList'); 566 SaveConfig; 567 XMLConfig1.Flush; 568 end; 569 558 570 end. 559 571 -
trunk/UGameServer.pas
r191 r196 62 62 end; 63 63 64 const 65 DefaultServerPort = 40009; 64 66 65 67 implementation … … 173 175 with Config do begin 174 176 LocalNetworkAddress := string(GetValue(DOMString(Path + '/LocalNetworkAddress'), 'localhost')); 175 LocalNetworkPort := GetValue(DOMString(Path + '/LocalNetworkPort'), 40009);177 LocalNetworkPort := GetValue(DOMString(Path + '/LocalNetworkPort'), DefaultServerPort); 176 178 RemoteNetworkAddress := string(GetValue(DOMString(Path + '/RemoteNetworkAddress'), 'localhost')); 177 RemoteNetworkPort := GetValue(DOMString(Path + '/RemoteNetworkPort'), 40009);179 RemoteNetworkPort := GetValue(DOMString(Path + '/RemoteNetworkPort'), DefaultServerPort); 178 180 Mode := TServerMode(GetValue(DOMString(Path + '/Mode'), Integer(smLocal))); 179 181 end; -
trunk/UServerList.pas
r180 r196 6 6 7 7 uses 8 Classes, SysUtils, contnrs;8 Classes, SysUtils, fgl, XMLConf; 9 9 10 10 type 11 12 { TServerInfo } 13 11 14 TServerInfo = class 12 15 Name: string; … … 18 21 MapName: string; 19 22 Latency: TTime; 23 constructor Create; 20 24 end; 21 25 22 TServerInfos = class(T ObjectList)26 TServerInfos = class(TFPGObjectList<TServerInfo>) 23 27 end; 24 28 … … 31 35 constructor Create; 32 36 destructor Destroy; override; 37 procedure LoadConfig(Config: TXmlConfig; Path: string); 38 procedure SaveConfig(Config: TXmlConfig; Path: string); 33 39 end; 34 40 41 35 42 implementation 43 44 uses 45 UGameServer; 46 47 { TServerInfo } 48 49 constructor TServerInfo.Create; 50 begin 51 Port := DefaultServerPort; 52 end; 36 53 37 54 { TServerList } … … 48 65 end; 49 66 67 procedure TServerList.LoadConfig(Config: TXmlConfig; Path: string); 68 var 69 I: Integer; 70 Server: TServerInfo; 71 begin 72 Items.Clear; 73 Items.Count := Config.GetValue(UnicodeString(Path + '/Count'), 0); 74 for I := 0 to Items.Count - 1 do begin 75 Server := TServerInfo.Create; 76 Server.Name := string(Config.GetValue(UnicodeString(Path + '/Item' + IntToStr(I) + '/Name'), '')); 77 Server.Address := string(Config.GetValue(UnicodeString(Path + '/Item' + IntToStr(I) + '/Address'), '')); 78 Server.Port := Config.GetValue(UnicodeString(Path + '/Item' + IntToStr(I) + '/Port'), 0); 79 Items[I] := Server; 80 end; 81 end; 82 83 procedure TServerList.SaveConfig(Config: TXmlConfig; Path: string); 84 var 85 I: Integer; 86 Server: TServerInfo; 87 begin 88 Config.SetValue(UnicodeString(Path + '/Count'), Items.Count); 89 for I := 0 to Items.Count - 1 do begin 90 Server := Items[I]; 91 Config.SetValue(UnicodeString(Path + '/Item' + IntToStr(I) + '/Name'), UnicodeString(Server.Name)); 92 Config.SetValue(UnicodeString(Path + '/Item' + IntToStr(I) + '/Address'), UnicodeString(Server.Address)); 93 Config.SetValue(UnicodeString(Path + '/Item' + IntToStr(I) + '/Port'), Server.Port); 94 end; 95 end; 96 50 97 end. 51 98 -
trunk/xtactics.lpi
r192 r196 104 104 </Item7> 105 105 </RequiredPackages> 106 <Units Count="2 4">106 <Units Count="25"> 107 107 <Unit0> 108 108 <Filename Value="xtactics.lpr"/> … … 240 240 <IsPartOfProject Value="True"/> 241 241 </Unit23> 242 <Unit24> 243 <Filename Value="Forms/UFormServer.pas"/> 244 <IsPartOfProject Value="True"/> 245 <ComponentName Value="FormServer"/> 246 <ResourceBaseClass Value="Form"/> 247 </Unit24> 242 248 </Units> 243 249 </ProjectOptions> -
trunk/xtactics.lpr
r192 r196 11 11 CoolTranslator, TemplateGenerics 12 12 { you can add units after this }, 13 SysUtils, UFormMain, CoolStreaming ;13 SysUtils, UFormMain, CoolStreaming, UFormServer; 14 14 15 15 {$R *.res} … … 32 32 Application.CreateForm(TCore, Core); 33 33 Application.CreateForm(TFormMain, FormMain); 34 Application.CreateForm(TFormServer, FormServer); 34 35 Application.Run; 35 36 end.
Note:
See TracChangeset
for help on using the changeset viewer.