Changeset 298
- Timestamp:
- Jul 10, 2019, 5:35:15 PM (5 years ago)
- Location:
- trunk
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormItem.pas
r296 r298 91 91 J: Integer; 92 92 Control: TControl; 93 ReferenceList: TItemList; 94 ReferenceItem: TItem; 93 95 begin 94 96 Fields := Item.GetFields; … … 111 113 end; 112 114 end 115 else if DataType = dtReference then begin 116 TComboBox(Control).Items.BeginUpdate; 117 try 118 TComboBox(Control).Items.Clear; 119 ReferenceList := Item.GetReferenceList(Index); 120 if Assigned(ReferenceList) then 121 for J := 0 to ReferenceList.Count - 1 do 122 TComboBox(Control).Items.AddObject(TItem(ReferenceList[J]).Name, ReferenceList[J]); 123 ReferenceItem := TItem(Item.GetValueReference(Index)); 124 TComboBox(Control).ItemIndex := TComboBox(Control).Items.IndexOfObject(ReferenceItem); 125 finally 126 TComboBox(Control).Items.EndUpdate; 127 end; 128 end 113 129 else raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[DataType]])); 114 130 end; … … 131 147 else if DataType = dtBoolean then Item.SetValueBoolean(Index, TCheckBox(Control).Checked) 132 148 else if DataType = dtEnumeration then Item.SetValueEnumeration(Index, TUndefinedEnum(TComboBox(Control).ItemIndex)) 149 else if DataType = dtReference then begin 150 if TComboBox(Control).ItemIndex <> -1 then 151 Item.SetValueReference(Index, TItem(TComboBox(Control).Items.Objects[TComboBox(Control).ItemIndex])) 152 else Item.SetValueReference(Index, nil); 153 end 133 154 else raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[DataType]])); 134 155 end; … … 173 194 TComboBox(NewControl).Style := csDropDownList; 174 195 end else 196 if DataType = dtReference then begin 197 NewControl := TComboBox.Create(nil); 198 NewControl.Width := 200; 199 TComboBox(NewControl).Style := csDropDownList; 200 end else 175 201 if DataType = dtBoolean then begin 176 202 NewControl := TCheckBox.Create(nil); -
trunk/Forms/UFormList.lfm
r295 r298 11 11 OnCreate = FormCreate 12 12 OnShow = FormShow 13 LCLVersion = '2.0. 0.4'13 LCLVersion = '2.0.2.0' 14 14 object ListView1: TListView 15 15 Left = 0 -
trunk/Forms/UFormList.pas
r290 r298 51 51 procedure UpdateListViewColumns; 52 52 public 53 MinItemCount: Integer; 54 MaxItemCount: Integer; 53 55 procedure UpdateInterface; 54 56 procedure UpdateList; … … 70 72 SRemoveItems = 'Remove items'; 71 73 SRemoveItemsQuery = 'Do you want to remove selected items?'; 72 SNew Item = 'New item';74 SNew = 'New'; 73 75 74 76 { TFormList } … … 83 85 for I := ListView1.Items.Count - 1 downto 0 do 84 86 if ListView1.Items[I].Selected then begin 87 if List.Count <= MinItemCount then Break; 85 88 ListView1.Items[I].Selected := False; 86 89 List.Remove(TItem(ListView1.Items[I].Data)); … … 99 102 if Assigned(ListView1.Selected) then 100 103 with TItem(ListView1.Selected.Data) do begin 101 TempEntry := List. GetItemClass.Create;104 TempEntry := List.CreateItem; 102 105 TempEntry.Assign(TItem(ListView1.Selected.Data)); 103 106 FormItem := TFormItem.Create(Self); … … 121 124 FormItem: TFormItem; 122 125 begin 123 TempEntry := List.GetItemClass.Create; 126 if (MaxItemCount <> -1) and (List.Count >= MaxItemCount) then Exit; 127 128 TempEntry := List.CreateItem; 124 129 FormItem := TFormItem.Create(Self); 125 130 try 126 TempEntry.Name := SNew Item;131 TempEntry.Name := SNew + ' ' + LowerCase(List.GetItemClass.GetClassName); 127 132 FormItem.Item := TempEntry; 128 133 if FormItem.ShowModal = mrOk then begin … … 143 148 FormItem: TFormItem; 144 149 begin 145 TempEntry := List.GetItemClass.Create; 150 if (MaxItemCount <> -1) and (List.Count >= MaxItemCount) then Exit; 151 152 TempEntry := List.CreateItem; 146 153 TempEntry.Assign(TItem(ListView1.Selected.Data)); 147 154 FormItem := TFormItem.Create(Self); … … 183 190 for I := 0 to ToolBar1.ButtonCount - 1 do 184 191 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption; 192 MinItemCount := 0; 193 MaxItemCount := -1; 185 194 end; 186 195 … … 197 206 var DefaultDraw: Boolean); 198 207 var 208 ItemFields: TItemFields; 199 209 ItemField: TItemField; 200 210 begin 201 ItemField := TItem(Item.Data).GetField(SubItem); 202 if ItemField.DataType = dtColor then 203 with ListView1.Canvas do begin 204 Brush.Color := TItem(Item.Data).GetValueColor(ItemField.Index); 205 Brush.Style := bsSolid; 206 FillRect(Item.DisplayRectSubItem(1, drBounds)); 207 end; 208 ItemField.Free; 211 ItemFields := TItem(Item.Data).GetFields; 212 try 213 ItemField := ItemFields[SubItem]; 214 if ItemField.DataType = dtColor then 215 with ListView1.Canvas do begin 216 Brush.Color := TItem(Item.Data).GetValueColor(ItemField.Index); 217 Brush.Style := bsSolid; 218 FillRect(Item.DisplayRectSubItem(SubItem, drBounds)); 219 end; 220 finally 221 ItemFields.Free; 222 end; 209 223 end; 210 224 … … 272 286 procedure TFormList.UpdateInterface; 273 287 begin 274 ARemove.Enabled := Assigned(FList) and Assigned(ListView1.Selected) ;288 ARemove.Enabled := Assigned(FList) and Assigned(ListView1.Selected) and (List.Count > MinItemCount); 275 289 AModify.Enabled := Assigned(FList) and Assigned(ListView1.Selected); 276 AAdd.Enabled := Assigned(FList); 290 AAdd.Enabled := Assigned(FList) and ((MaxItemCount = -1) or ((MaxItemCount <> -1) and (List.Count < MaxItemCount))); 291 AClone.Enabled := Assigned(FList) and ((MaxItemCount = -1) or ((MaxItemCount <> -1) and (List.Count < MaxItemCount))); 277 292 ASelectAll.Enabled := ListView1.Items.Count > 0; 278 293 end; -
trunk/Forms/UFormNew.pas
r288 r298 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 9 ComCtrls, Spin, ExtCtrls, ActnList, ExtDlgs, Menus, UGame, UGeometry, UPlayer, 10 UGameServer, UServerList, UMap, U FormPlayers, UGameSystem;10 UGameServer, UServerList, UMap, UGameSystem, UFormList; 11 11 12 12 type … … 144 144 MapPreviewRedrawPending: Boolean; 145 145 NewRandSeed: Cardinal; 146 FormPlayers: TForm Players;146 FormPlayers: TFormList; 147 147 procedure LoadGame(Game: TGame); 148 148 procedure SaveGame(Game: TGame); … … 385 385 if Assigned(FServer) then begin 386 386 Load(FServer); 387 FormPlayers. Players:= FServer.Game.Players;387 FormPlayers.List := FServer.Game.Players; 388 388 end else begin 389 FormPlayers. Players:= nil;389 FormPlayers.List := nil; 390 390 end; 391 391 end; … … 402 402 GamePreview.GeneratePlayers := False; 403 403 GamePreview.New; 404 GamePreview.CurrentPlayer := GamePreview.Players.First;404 GamePreview.CurrentPlayer := TPlayer(GamePreview.Players.First); 405 405 Bitmap := Image1.Picture.Bitmap; 406 406 Bitmap.SetSize(Image1.Width, Image1.Height); … … 534 534 FormChat.Align := alClient; 535 535 FormChat.Show; 536 FormPlayers := TForm Players.Create(nil);536 FormPlayers := TFormList.Create(nil); 537 537 FormPlayers.MinItemCount := MinPlayerCount; 538 538 FormPlayers.MaxItemCount := MaxPlayerCount; -
trunk/Forms/UFormPlayer.lfm
r295 r298 1 1 object FormPlayer: TFormPlayer 2 Left = 4702 Left = 1304 3 3 Height = 338 4 Top = 1574 Top = 318 5 5 Width = 543 6 6 Caption = 'Player' … … 14 14 OnShow = FormShow 15 15 Position = poMainFormCenter 16 LCLVersion = '2.0. 0.4'16 LCLVersion = '2.0.2.0' 17 17 object Label1: TLabel 18 18 Left = 20 -
trunk/Languages/xtactics.cs.po
r297 r298 132 132 133 133 #: tformabout.labelcontent.caption 134 #, fuzzy135 134 msgctxt "tformabout.labelcontent.caption" 136 135 msgid " " … … 709 708 710 709 #: tformplayer.checkboxdefensive.caption 710 msgctxt "tformplayer.checkboxdefensive.caption" 711 711 msgid "Defensive" 712 712 msgstr "Obranný" … … 1136 1136 msgstr "Hlavní okno" 1137 1137 1138 #: uformlist.snewitem 1139 msgid "New item" 1140 msgstr "Nová položka" 1138 #: uformlist.snew 1139 msgctxt "uformlist.snew" 1140 msgid "New" 1141 msgstr "Nová" 1141 1142 1142 1143 #: uformlist.sremoveitems … … 1221 1222 msgstr "Zůstat naživu určený počet tahů" 1222 1223 1223 #: uformplayer.sagrohigh1224 msgid "High"1225 msgstr "Vysoká"1226 1227 #: uformplayer.sagrolow1228 msgid "Low"1229 msgstr "Nízká"1230 1231 #: uformplayer.sagromedium1232 msgid "Medium"1233 msgstr "Střední"1234 1235 #: uformplayer.scomputer1236 msgctxt "uformplayer.scomputer"1237 msgid "Computer"1238 msgstr "Počítač"1239 1240 #: uformplayer.shuman1241 msgctxt "uformplayer.shuman"1242 msgid "Human"1243 msgstr "Člověk"1244 1245 #: uformplayers.sremoveitems1246 msgctxt "uformplayers.sremoveitems"1247 msgid "Remove items"1248 msgstr "Odstranit položky"1249 1250 #: uformplayers.sremoveitemsquery1251 msgctxt "uformplayers.sremoveitemsquery"1252 msgid "Do you want to remove selected items?"1253 msgstr "Opravdu chcete odstranit vybrané položky?"1254 1255 1224 #: ugame.scomputer 1256 1225 msgctxt "ugame.scomputer" … … 1369 1338 msgstr "Národ" 1370 1339 1340 #: uplayer.sagressivity 1341 msgid "Agressivity" 1342 msgstr "Agresivita" 1343 1371 1344 #: uplayer.sattackerpowerpositive 1372 1345 msgctxt "uplayer.sattackerpowerpositive" … … 1374 1347 msgstr "Síla útočníka musí být větší než 0." 1375 1348 1349 #: uplayer.scolor 1350 msgctxt "uplayer.scolor" 1351 msgid "Color" 1352 msgstr "Barva" 1353 1354 #: uplayer.scomputer 1355 msgctxt "uplayer.scomputer" 1356 msgid "Computer" 1357 msgstr "Počítač" 1358 1376 1359 #: uplayer.sdefenderpowerpositive 1377 1360 msgctxt "uplayer.sdefenderpowerpositive" … … 1379 1362 msgstr "Síla obránce musí být vyšší než nebo rovna nule." 1380 1363 1364 #: uplayer.sdefensive 1365 msgctxt "uplayer.sdefensive" 1366 msgid "Defensive" 1367 msgstr "Obranný" 1368 1369 #: uplayer.shigh 1370 msgctxt "uplayer.shigh" 1371 msgid "High" 1372 msgstr "Vysoká" 1373 1374 #: uplayer.shuman 1375 msgctxt "uplayer.shuman" 1376 msgid "Human" 1377 msgstr "Člověk" 1378 1379 #: uplayer.slow 1380 msgctxt "uplayer.slow" 1381 msgid "Low" 1382 msgstr "Nízká" 1383 1384 #: uplayer.smedium 1385 msgctxt "uplayer.smedium" 1386 msgid "Medium" 1387 msgstr "Střední" 1388 1389 #: uplayer.smode 1390 msgctxt "uplayer.smode" 1391 msgid "Mode" 1392 msgstr "Režim" 1393 1394 #: uplayer.snation 1395 msgctxt "uplayer.snation" 1396 msgid "Nation" 1397 msgstr "Národ" 1398 1399 #: uplayer.sstartunits 1400 msgctxt "uplayer.sstartunits" 1401 msgid "Start units" 1402 msgstr "Počátečních jednotek" 1403 1381 1404 #: uplayer.sunfinishedbattle 1382 1405 msgctxt "uplayer.sunfinishedbattle" … … 1413 1436 msgid "View range" 1414 1437 msgstr "Dohled" 1438 -
trunk/Languages/xtactics.po
r297 r298 695 695 696 696 #: tformplayer.checkboxdefensive.caption 697 msgctxt "tformplayer.checkboxdefensive.caption" 697 698 msgid "Defensive" 698 699 msgstr "" … … 1113 1114 msgstr "" 1114 1115 1115 #: uformlist.snewitem 1116 msgid "New item" 1116 #: uformlist.snew 1117 msgctxt "uformlist.snew" 1118 msgid "New" 1117 1119 msgstr "" 1118 1120 … … 1198 1200 msgstr "" 1199 1201 1200 #: uformplayer.sagrohigh1201 msgid "High"1202 msgstr ""1203 1204 #: uformplayer.sagrolow1205 msgid "Low"1206 msgstr ""1207 1208 #: uformplayer.sagromedium1209 msgid "Medium"1210 msgstr ""1211 1212 #: uformplayer.scomputer1213 msgctxt "uformplayer.scomputer"1214 msgid "Computer"1215 msgstr ""1216 1217 #: uformplayer.shuman1218 msgctxt "uformplayer.shuman"1219 msgid "Human"1220 msgstr ""1221 1222 #: uformplayers.sremoveitems1223 msgctxt "uformplayers.sremoveitems"1224 msgid "Remove items"1225 msgstr ""1226 1227 #: uformplayers.sremoveitemsquery1228 msgctxt "uformplayers.sremoveitemsquery"1229 msgid "Do you want to remove selected items?"1230 msgstr ""1231 1232 1202 #: ugame.scomputer 1233 1203 msgctxt "ugame.scomputer" … … 1340 1310 msgstr "" 1341 1311 1312 #: uplayer.sagressivity 1313 msgid "Agressivity" 1314 msgstr "" 1315 1342 1316 #: uplayer.sattackerpowerpositive 1343 1317 msgid "Attacker power have to be higher then 0." 1344 1318 msgstr "" 1345 1319 1320 #: uplayer.scolor 1321 msgctxt "uplayer.scolor" 1322 msgid "Color" 1323 msgstr "" 1324 1325 #: uplayer.scomputer 1326 msgctxt "uplayer.scomputer" 1327 msgid "Computer" 1328 msgstr "" 1329 1346 1330 #: uplayer.sdefenderpowerpositive 1347 1331 msgid "Defender power have to be higher then or equal to 0." 1332 msgstr "" 1333 1334 #: uplayer.sdefensive 1335 msgctxt "uplayer.sdefensive" 1336 msgid "Defensive" 1337 msgstr "" 1338 1339 #: uplayer.shigh 1340 msgctxt "uplayer.shigh" 1341 msgid "High" 1342 msgstr "" 1343 1344 #: uplayer.shuman 1345 msgctxt "uplayer.shuman" 1346 msgid "Human" 1347 msgstr "" 1348 1349 #: uplayer.slow 1350 msgctxt "uplayer.slow" 1351 msgid "Low" 1352 msgstr "" 1353 1354 #: uplayer.smedium 1355 msgctxt "uplayer.smedium" 1356 msgid "Medium" 1357 msgstr "" 1358 1359 #: uplayer.smode 1360 msgctxt "uplayer.smode" 1361 msgid "Mode" 1362 msgstr "" 1363 1364 #: uplayer.snation 1365 msgctxt "uplayer.snation" 1366 msgid "Nation" 1367 msgstr "" 1368 1369 #: uplayer.sstartunits 1370 msgctxt "uplayer.sstartunits" 1371 msgid "Start units" 1348 1372 msgstr "" 1349 1373 -
trunk/UCore.pas
r292 r298 531 531 procedure TCore.LoadGame(FileName: string); 532 532 var 533 Player: TPlayer;533 I: Integer; 534 534 NewClient: TClient; 535 535 ServerClient: TServerClient; 536 Player: TPlayer; 536 537 begin 537 538 GameLoaded := True; … … 544 545 LocalClients.Clear; 545 546 FormClient.Client := nil; 546 for Player in Game.Players do 547 with Player do 548 if Mode = pmHuman then begin 549 NewClient := LocalClients.New(Name); 550 NewClient.ControlPlayer := Player; 551 TClientGUI(NewClient).View.Clear; 552 TClientGUI(NewClient).View.Zoom := 1; 553 NewClient.LocalServer := Server; 554 NewClient.ConnectType := ctLocal; 555 NewClient.Active := True; 556 if Assigned(NewClient.ControlPlayer.StartCell) then 557 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer) 558 else TClientGUI(NewClient).View.CenterMap; 559 end else 560 if Mode = pmComputer then begin 561 NewClient := TComputer.Create; 562 NewClient.Game := TGame(Game); 563 NewClient.Name := Name; 564 LocalClients.Add(NewClient); 565 NewClient.ControlPlayer := Player; 566 NewClient.LocalServer := Server; 567 NewClient.ConnectType := ctLocal; 568 NewClient.Active := True; 547 for I := 0 to Game.Players.Count - 1 do begin 548 Player := TPlayer(Game.Players[I]); 549 with Player do 550 if Mode = pmHuman then begin 551 NewClient := LocalClients.New(Name); 552 NewClient.ControlPlayer := Player; 553 TClientGUI(NewClient).View.Clear; 554 TClientGUI(NewClient).View.Zoom := 1; 555 NewClient.LocalServer := Server; 556 NewClient.ConnectType := ctLocal; 557 NewClient.Active := True; 558 if Assigned(NewClient.ControlPlayer.StartCell) then 559 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer) 560 else TClientGUI(NewClient).View.CenterMap; 561 end else 562 if Mode = pmComputer then begin 563 NewClient := TComputer.Create; 564 NewClient.Game := TGame(Game); 565 NewClient.Name := Name; 566 LocalClients.Add(NewClient); 567 NewClient.ControlPlayer := Player; 568 NewClient.LocalServer := Server; 569 NewClient.ConnectType := ctLocal; 570 NewClient.Active := True; 571 end; 569 572 end; 570 573 … … 650 653 NewClient: TClient; 651 654 Player: TPlayer; 655 I: Integer; 652 656 ServerClient: TServerClient; 653 657 begin … … 659 663 LocalClients.Clear; 660 664 FormClient.Client := nil; 661 for Player in Game.Players do 662 with Player do 663 if Mode = pmHuman then begin 664 NewClient := LocalClients.New(Name); 665 NewClient.ControlPlayer := Player; 666 TClientGUI(NewClient).View.Clear; 667 TClientGUI(NewClient).View.Zoom := 1; 668 NewClient.LocalServer := Server; 669 NewClient.ConnectType := ctLocal; 670 NewClient.Active := True; 671 if Assigned(NewClient.ControlPlayer.StartCell) then 672 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer) 673 else TClientGUI(NewClient).View.CenterMap; 674 end else 675 if Mode = pmComputer then begin 676 NewClient := TComputer.Create; 677 NewClient.Game := TGame(Game); 678 NewClient.Name := Name; 679 LocalClients.Add(NewClient); 680 NewClient.ControlPlayer := Player; 681 NewClient.LocalServer := Server; 682 NewClient.ConnectType := ctLocal; 683 NewClient.Active := True; 665 for I := 0 to Game.Players.Count - 1 do begin 666 Player := TPlayer(Game.Players[I]); 667 with Player do 668 if Mode = pmHuman then begin 669 NewClient := LocalClients.New(Name); 670 NewClient.ControlPlayer := Player; 671 TClientGUI(NewClient).View.Clear; 672 TClientGUI(NewClient).View.Zoom := 1; 673 NewClient.LocalServer := Server; 674 NewClient.ConnectType := ctLocal; 675 NewClient.Active := True; 676 if Assigned(NewClient.ControlPlayer.StartCell) then 677 TClientGUI(NewClient).View.CenterPlayerCity(NewClient.ControlPlayer) 678 else TClientGUI(NewClient).View.CenterMap; 679 end else 680 if Mode = pmComputer then begin 681 NewClient := TComputer.Create; 682 NewClient.Game := TGame(Game); 683 NewClient.Name := Name; 684 LocalClients.Add(NewClient); 685 NewClient.ControlPlayer := Player; 686 NewClient.LocalServer := Server; 687 NewClient.ConnectType := ctLocal; 688 NewClient.Active := True; 689 end; 684 690 end; 685 691 -
trunk/UGame.pas
r294 r298 330 330 if not GeneratePlayers then Exit; 331 331 332 for Player in Playersdo begin333 Player.Reset;334 Player.StartCell := nil;335 end; 336 I := 0;337 for Player in Players do338 with Player do begin332 for I := 0 to Players.Count - 1 do begin 333 TPlayer(Players[I]).Reset; 334 TPlayer(Players[I]).StartCell := nil; 335 end; 336 for I := 0 to Players.Count - 1 do 337 with TPlayer(Players[I]) do begin 338 Player := TPlayer(Players[I]); 339 339 PlayerMap.Update; 340 340 if (Map.Size.X > 0) and (Map.Size.Y > 0) then begin … … 342 342 if Assigned(Player.StartCell) then begin 343 343 if SymetricMap and (I = 1) then 344 StartCell := Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf( Players[0].StartCell)];344 StartCell := Map.Cells[Map.Cells.Count - 1 - Map.Cells.IndexOf(TPlayer(Players[0]).StartCell)]; 345 345 346 346 if CityEnabled then begin … … 358 358 InitUnitMoves; 359 359 PlayerMap.CheckVisibility; 360 Inc(I);361 360 end; 362 361 end; … … 411 410 Player: TPlayer; 412 411 List: TCells; 413 begin 414 for Player in Players do 415 if Assigned(Player.StartCell) then begin 416 Player.StartCell.Weight := 1; 417 Player.StartCell.Mark := True; 418 List := TCells.Create; 419 List.FreeObjects := False; 420 List.Add(Player.StartCell); 421 PropagatePlayerDistance(List); 422 FreeAndNil(List); 412 I: Integer; 413 begin 414 for I := 0 to Players.Count - 1 do begin 415 Player := TPlayer(Players[I]); 416 if Assigned(Player.StartCell) then begin 417 Player.StartCell.Weight := 1; 418 Player.StartCell.Mark := True; 419 List := TCells.Create; 420 List.FreeObjects := False; 421 List.Add(Player.StartCell); 422 PropagatePlayerDistance(List); 423 FreeAndNil(List); 424 end; 423 425 end; 424 426 end; … … 568 570 MaxNeutralUnits := GetValue(DOMString(Path + '/MaxNeutralUnits'), 5); 569 571 MaxPower := GetValue(DOMString(Path + '/MaxPower'), 99); 572 GameSystemName := string(GetValue(DOMString(Path + '/GameSystemName'), DOMString(''))); 570 573 Players.LoadConfig(Config, Path + '/Players'); 571 GameSystemName := string(GetValue(DOMString(Path + '/GameSystemName'), DOMString('')));572 574 end; 573 575 end; … … 617 619 if Assigned(NewNode) then 618 620 Players.LoadFromNode(NewNode); 619 if Players.Count > 0 then CurrentPlayer := Players[0]621 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0]) 620 622 else CurrentPlayer := nil; 621 623 … … 628 630 629 631 for I := 0 to Players.Count - 1 do begin 630 Players[I].PlayerMap.Update;631 Players[I].PlayerMap.CheckVisibility;632 TPlayer(Players[I]).PlayerMap.Update; 633 TPlayer(Players[I]).PlayerMap.CheckVisibility; 632 634 end; 633 635 ComputePlayerStats; … … 700 702 begin 701 703 for I := 0 to Players.Count - 1 do 702 with Players[I]do begin704 with TPlayer(Players[I]) do begin 703 705 TotalUnits := 0; 704 706 TotalCells := 0; … … 721 723 begin 722 724 for I := 0 to Players.Count - 1 do 723 with Players[I]do begin725 with TPlayer(Players[I]) do begin 724 726 NewStat := TGameTurnStat.Create; 725 727 NewStat.DiscoveredCells := TotalDiscovered; … … 770 772 NewPlayerIndex := NewPlayerIndex mod AlivePlayers.Count; 771 773 end; 772 CurrentPlayer := AlivePlayers[NewPlayerIndex];774 CurrentPlayer := TPlayer(AlivePlayers[NewPlayerIndex]); 773 775 finally 774 776 AlivePlayers.Free; … … 895 897 I: Integer; 896 898 begin 897 for I := 0 to Players.Count - 1 do Players[I].Clear;899 for I := 0 to Players.Count - 1 do TPlayer(Players[I]).Clear; 898 900 Map.Clear; 899 901 end; … … 922 924 923 925 InitPlayers; 924 if Players.Count > 0 then CurrentPlayer := Players[0]926 if Players.Count > 0 then CurrentPlayer := TPlayer(Players[0]) 925 927 else CurrentPlayer := nil; 926 928 -
trunk/UItemList.pas
r296 r298 9 9 10 10 type 11 TItemList = class; 11 12 TUndefinedEnum = (eeNone); 12 13 13 14 TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor, 14 dtTime, dtDate, dtDateTime, dtEnumeration );15 dtTime, dtDate, dtDateTime, dtEnumeration, dtReference); 15 16 16 17 { TItemField } … … 54 55 function GetValueBoolean(Index: Integer): Boolean; 55 56 function GetValueEnumeration(Index: Integer): TUndefinedEnum; 57 function GetValueReference(Index: Integer): TItem; 56 58 function GetValueAsText(Index: Integer): string; 57 59 procedure SetValue(Index: Integer; var Value); virtual; … … 61 63 procedure SetValueBoolean(Index: Integer; Value: Boolean); 62 64 procedure SetValueEnumeration(Index: Integer; Value: TUndefinedEnum); 65 procedure SetValueReference(Index: Integer; Value: TItem); 63 66 procedure Assign(Source: TItem); virtual; 64 67 procedure LoadFromNode(Node: TDOMNode); virtual; … … 66 69 class function GetClassSysName: string; virtual; 67 70 class function GetClassName: string; virtual; 71 function GetReferenceList(Index: Integer): TItemList; virtual; 72 constructor Create; virtual; 68 73 end; 69 74 … … 81 86 function GetNewId: Integer; 82 87 procedure Assign(Source: TItemList); virtual; 83 function AddItem(Name: string): TItem; virtual; 88 function AddItem(Name: string = ''): TItem; virtual; 89 function CreateItem(Name: string = ''): TItem; virtual; 84 90 procedure LoadFromNode(Node: TDOMNode); virtual; 85 91 procedure SaveToNode(Node: TDOMNode); virtual; … … 89 95 const 90 96 DataTypeStr: array[TDataType] of string = ('None', 'String', 'Boolean', 91 'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration'); 97 'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration', 98 'Reference'); 92 99 93 100 resourcestring … … 136 143 while Count < Source.Count do AddItem(''); 137 144 for I := 0 to Count - 1 do 138 Items[I].Assign(Source.Items[I]);145 TItem(Items[I]).Assign(Source.Items[I]); 139 146 end; 140 147 141 148 function TItemList.AddItem(Name: string): TItem; 149 begin 150 Result := CreateItem(Name); 151 Result.Id := GetNewId; 152 Add(Result); 153 end; 154 155 function TItemList.CreateItem(Name: string): TItem; 142 156 begin 143 157 Result := GetItemClass.Create; 144 158 Result.Name := Name; 145 Result.Id := GetNewId;146 Add(Result);147 159 end; 148 160 … … 155 167 Node2 := Node.FirstChild; 156 168 while Assigned(Node2) and (Node2.NodeName = UnicodeString(GetItemClass.GetClassSysName)) do begin 157 NewItem := GetItemClass.Create;169 NewItem := CreateItem; 158 170 NewItem.LoadFromNode(Node2); 159 171 Add(NewItem); … … 177 189 constructor TItemList.Create(FreeObjects: Boolean); 178 190 begin 179 inherited Create(FreeObjects);191 inherited; 180 192 NewId := 1; 181 193 end; … … 273 285 SetValueEnumeration(Field.Index, Source.GetValueEnumeration(Field.Index)); 274 286 end else 287 if Field.DataType = dtReference then begin 288 SetValueReference(Field.Index, Source.GetValueReference(Field.Index)); 289 end else 275 290 raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]])); 276 291 end; 277 292 278 293 procedure TItem.LoadValueFromNode(Node: TDOMNode; Field: TItemField); 294 var 295 ReadId: Integer; 296 ReferenceList: TItemList; 279 297 begin 280 298 if Field.DataType = dtString then begin … … 293 311 SetValueEnumeration(Field.Index, TUndefinedEnum(ReadInteger(Node, Field.SysName, 0))); 294 312 end else 313 if Field.DataType = dtReference then begin 314 ReadId := ReadInteger(Node, Field.SysName, 0); 315 ReferenceList := GetReferenceList(Field.Index); 316 if (ReadId > 0) and Assigned(ReferenceList) then 317 SetValueReference(Field.Index, TItem(ReferenceList.List[ReadId])); 318 end else 295 319 raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]])); 296 320 end; 297 321 298 322 procedure TItem.SaveValueToNode(Node: TDOMNode; Field: TItemField); 323 var 324 Item: TItem; 299 325 begin 300 326 if Field.DataType = dtString then begin … … 312 338 if Field.DataType = dtEnumeration then begin 313 339 WriteInteger(Node, Field.SysName, Integer(GetValueEnumeration(Field.Index))); 340 end else 341 if Field.DataType = dtReference then begin 342 Item := TItem(GetValueReference(Field.Index)); 343 if Assigned(Item) then WriteInteger(Node, Field.SysName, Item.Id) 344 else WriteInteger(Node, Field.SysName, 0); 314 345 end else 315 346 raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]])); … … 329 360 Fields := GetFields; 330 361 try 331 Result.Assign(Fields [Index]);362 Result.Assign(Fields.SearchByIndex(Index)); 332 363 finally 333 364 Fields.Free; … … 365 396 end; 366 397 398 function TItem.GetValueReference(Index: Integer): TItem; 399 begin 400 GetValue(Index, Result); 401 end; 402 367 403 function TItem.GetValueAsText(Index: Integer): string; 368 404 var 369 Fields: TItemFields;370 405 Field: TItemField; 371 begin 372 Fields := GetFields; 373 Field := GetField(Fields.IndexOf(Fields.SearchByIndex(Index))); 374 if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index)) 375 else if Field.DataType = dtString then Result := GetValueString(Index) 376 else if Field.DataType = dtColor then Result := '' 377 else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))] 378 else if Field.DataType = dtBoolean then begin 379 if GetValueBoolean(Index) then Result := SYes else Result := SNo; 380 end else 381 raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]])); 382 Field.Free; 383 Fields.Free; 406 Item: TItem; 407 begin 408 Field := GetField(Index); 409 try 410 if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index)) 411 else if Field.DataType = dtString then Result := GetValueString(Index) 412 else if Field.DataType = dtColor then Result := '' 413 else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))] 414 else if Field.DataType = dtReference then begin 415 Item := TItem(GetValueReference(Index)); 416 if Assigned(Item) then Result := Item.Name 417 else Result := ''; 418 end else if Field.DataType = dtBoolean then begin 419 if GetValueBoolean(Index) then Result := SYes else Result := SNo; 420 end else 421 raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]])); 422 finally 423 Field.Free; 424 end; 384 425 end; 385 426 … … 411 452 procedure TItem.SetValueEnumeration(Index: Integer; 412 453 Value: TUndefinedEnum); 454 begin 455 SetValue(Index, Value); 456 end; 457 458 procedure TItem.SetValueReference(Index: Integer; Value: TItem); 413 459 begin 414 460 SetValue(Index, Value); … … 474 520 end; 475 521 522 function TItem.GetReferenceList(Index: Integer): TItemList; 523 begin 524 Result := nil; 525 end; 526 527 constructor TItem.Create; 528 begin 529 end; 530 476 531 end. 477 532 -
trunk/UPlayer.pas
r297 r298 122 122 procedure GetValue(Index: Integer; out Value); override; 123 123 procedure SetValue(Index: Integer; var Value); override; 124 function GetReferenceList(Index: Integer): TItemList; override; 124 125 class function GetClassSysName: string; override; 126 class function GetClassName: string; override; 125 127 function IsAllowedMoveTarget(CellFrom, CellTo: TPlayerCell): Boolean; 126 128 procedure ReduceMovesPower; … … 139 141 procedure LoadFromNode(Node: TDOMNode); override; 140 142 procedure SaveToNode(Node: TDOMNode); override; 141 constructor Create; 143 constructor Create; override; 142 144 destructor Destroy; override; 143 145 procedure Assign(Source: TItem); override; … … 153 155 { TPlayers } 154 156 155 TPlayers = class(T FPGObjectList<TPlayer>)157 TPlayers = class(TItemList) 156 158 public 157 159 Game: TObject; //TGame; 158 NewId: Integer; 159 function FindById(Id: Integer): TPlayer; 160 class function GetItemClass: TItemClass; override; 160 161 procedure New(Name: string; Color: TColor; Mode: TPlayerMode); 161 function GetNewId: Integer; 162 procedure LoadFromNode(Node: TDOMNode); 163 procedure SaveToNode(Node: TDOMNode); 164 constructor Create(FreeObjects: Boolean = True); 162 function CreateItem(Name: string = ''): TItem; override; 165 163 function GetFirstHuman: TPlayer; 166 procedure Assign(Source: TPlayers);167 164 procedure LoadConfig(Config: TXmlConfig; Path: string); 168 165 procedure SaveConfig(Config: TXmlConfig; Path: string); … … 216 213 SDefenderPowerPositive = 'Defender power have to be higher then or equal to 0.'; 217 214 SUnfinishedBattle = 'Unfinished battle'; 215 SLow = 'Low'; 216 SMedium = 'Medium'; 217 SHigh = 'High'; 218 SHuman = 'Human'; 219 SComputer = 'Computer'; 220 SNation = 'Nation'; 221 SMode = 'Mode'; 222 SColor = 'Color'; 223 SAgressivity = 'Agressivity'; 224 SStartUnits = 'Start units'; 225 SDefensive = 'Defensive'; 218 226 219 227 function ComparePointer(const Item1, Item2: Integer): Integer; … … 497 505 function TPlayers.GetAliveCount: Integer; 498 506 var 499 Player: TPlayer;507 I: Integer; 500 508 begin 501 509 Result := 0; 502 for Player in Selfdo503 if Player.IsAlive then Inc(Result);510 for I := 0 to Count - 1 do 511 if TPlayer(Items[I]).IsAlive then Inc(Result); 504 512 end; 505 513 506 514 procedure TPlayers.GetAlivePlayers(Players: TPlayers); 507 515 var 508 Player: TPlayer;516 I: Integer; 509 517 begin 510 518 Players.Clear; 511 for Player in Self do 512 if Player.IsAlive then Players.Add(Player); 513 end; 514 515 function TPlayers.FindById(Id: Integer): TPlayer; 519 for I := 0 to Count - 1 do 520 if TPlayer(Items[I]).IsAlive then Players.Add(TPlayer(Items[I])); 521 end; 522 523 class function TPlayers.GetItemClass: TItemClass; 524 begin 525 Result := TPlayer; 526 end; 527 528 procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode); 529 begin 530 AddItem(Name); 531 TPlayer(Last).Color := Color; 532 TPlayer(Last).Mode := Mode; 533 if Mode = pmComputer then 534 TPlayer(Last).Agressivity := caMedium; 535 end; 536 537 function TPlayers.CreateItem(Name: string): TItem; 538 begin 539 Result := inherited; 540 TPlayer(Result).Game := Game; 541 end; 542 543 function TPlayers.GetFirstHuman: TPlayer; 516 544 var 517 545 I: Integer; 518 546 begin 519 547 I := 0; 520 while (I < Count) and ( Items[I].Id <> Id) do Inc(I);521 if I < Count then Result := Items[I]548 while (I < Count) and (TPlayer(Items[I]).Mode <> pmHuman) do Inc(I); 549 if I < Count then Result := TPlayer(Items[I]) 522 550 else Result := nil; 523 end;524 525 procedure TPlayers.New(Name: string; Color: TColor; Mode: TPlayerMode);526 var527 NewPlayer: TPlayer;528 begin529 NewPlayer := TPlayer.Create;530 NewPlayer.Game := Game;531 NewPlayer.Name := Name;532 NewPlayer.Color := Color;533 NewPlayer.Mode := Mode;534 NewPlayer.Id := GetNewId;535 if Mode = pmComputer then536 NewPlayer.Agressivity := caMedium;537 Add(NewPlayer);538 end;539 540 function TPlayers.GetNewId: Integer;541 begin542 Result := NewId;543 Inc(NewId);544 end;545 546 procedure TPlayers.LoadFromNode(Node: TDOMNode);547 var548 Node2: TDOMNode;549 NewPlayer: TPlayer;550 begin551 Count := 0;552 Node2 := Node.FirstChild;553 while Assigned(Node2) and (Node2.NodeName = 'Player') do begin554 NewPlayer := TPlayer.Create;555 NewPlayer.Game := Game;556 NewPlayer.LoadFromNode(Node2);557 Add(NewPlayer);558 Node2 := Node2.NextSibling;559 end;560 end;561 562 procedure TPlayers.SaveToNode(Node: TDOMNode);563 var564 I: Integer;565 NewNode: TDOMNode;566 begin567 for I := 0 to Count - 1 do begin;568 NewNode := Node.OwnerDocument.CreateElement('Player');569 Node.AppendChild(NewNode);570 Items[I].SaveToNode(NewNode);571 end;572 end;573 574 constructor TPlayers.Create(FreeObjects: Boolean = True);575 begin576 inherited;577 NewId := 1;578 end;579 580 function TPlayers.GetFirstHuman: TPlayer;581 var582 I: Integer;583 begin584 I := 0;585 while (I < Count) and (Items[I].Mode <> pmHuman) do Inc(I);586 if I < Count then Result := Items[I]587 else Result := nil;588 end;589 590 procedure TPlayers.Assign(Source: TPlayers);591 var592 I: Integer;593 begin594 while Count > Source.Count do595 Delete(Count - 1);596 while Count < Source.Count do597 Add(TPlayer.Create);598 for I := 0 to Count - 1 do begin599 Items[I].Assign(Source[I]);600 Items[I].Game := Game;601 end;602 NewId := Source.NewId;603 551 end; 604 552 … … 615 563 Count := NewCount; 616 564 for I := 0 to Count - 1 do begin 617 Items[I] := TPlayer.Create; 618 Items[I].Id := GetNewId; 619 Items[I].Game := Game; 620 Items[I].LoadConfig(Config, Path + '/Player' + IntToStr(I)); 565 Items[I] := CreateItem; 566 TPlayer(Items[I]).LoadConfig(Config, Path + '/Player' + IntToStr(I)); 621 567 end; 622 568 end; … … 629 575 begin 630 576 for I := 0 to Count - 1 do 631 Items[I].SaveConfig(Config, Path + '/Player' + IntToStr(I));577 TPlayer(Items[I]).SaveConfig(Config, Path + '/Player' + IntToStr(I)); 632 578 with Config do begin 633 579 SetValue(DOMString(Path + '/Count'), Count); … … 637 583 function TPlayers.GetAlivePlayers: TPlayerArray; 638 584 var 639 Player: TPlayer;585 I: Integer; 640 586 begin 641 587 SetLength(Result, 0); 642 for Player in Selfdo643 if Player.IsAlive then begin588 for I := 0 to Count - 1 do 589 if TPlayer(Items[I]).IsAlive then begin 644 590 SetLength(Result, Length(Result) + 1); 645 Result[Length(Result) - 1] := Player;591 Result[Length(Result) - 1] := TPlayer(Items[I]); 646 592 end; 647 593 end; … … 649 595 function TPlayers.GetAlivePlayersWithCities: TPlayerArray; 650 596 var 651 Player: TPlayer;597 I: Integer; 652 598 begin 653 599 SetLength(Result, 0); 654 for Player in Selfdo655 if Player.TotalCities > 0 then begin600 for I := 0 to Count - 1 do 601 if TPlayer(Items[I]).TotalCities > 0 then begin 656 602 SetLength(Result, Length(Result) + 1); 657 Result[Length(Result) - 1] := Player;603 Result[Length(Result) - 1] := TPlayer(Items[I]); 658 604 end; 659 605 end; … … 803 749 NewNode: TDOMNode; 804 750 begin 805 Id := ReadInteger(Node, 'Id', 0); 806 Name := ReadString(Node, 'Name', ''); 807 Color := ReadInteger(Node, 'Color', clSilver); 808 Mode := TPlayerMode(ReadInteger(Node, 'Mode', Integer(pmHuman))); 751 inherited; 809 752 StartCell := TGame(FGame).Map.Cells.FindById(ReadInteger(Node, 'StartCell', 0)); 810 StartUnits := ReadInteger(Node, 'StartUnits', 0);811 Agressivity := TComputerAgressivity(ReadInteger(Node, 'Agressivity', Integer(caMedium)));812 Defensive := ReadBoolean(Node, 'Defensive', False);813 753 814 754 with Node do begin … … 834 774 NewNode: TDOMNode; 835 775 begin 836 WriteInteger(Node, 'Id', Id); 837 WriteString(Node, 'Name', Name); 838 WriteInteger(Node, 'Color', Color); 839 WriteInteger(Node, 'Mode', Integer(Mode)); 776 inherited; 840 777 WriteInteger(Node, 'StartCell', StartCell.Id); 841 WriteInteger(Node, 'StartUnits', StartUnits);842 WriteInteger(Node, 'Agressivity', Integer(Agressivity));843 WriteBoolean(Node, 'Defensive', Defensive);844 778 845 779 with Node do begin … … 862 796 constructor TPlayer.Create; 863 797 begin 798 inherited; 864 799 Units := TUnits.Create(False); 865 800 Moves := TUnitMoves.Create; … … 879 814 FreeAndNil(Moves); 880 815 FreeAndNil(Units); 881 inherited Destroy;816 inherited; 882 817 end; 883 818 884 819 procedure TPlayer.Assign(Source: TItem); 885 820 begin 886 Id := Source.Id; 887 Name := Source.Name; 888 Color := TPlayer(Source).Color; 889 Mode := TPlayer(Source).Mode; 890 Game := TPlayer(Source).Game; 821 inherited; 822 //Game := TPlayer(Source).Game; 891 823 TotalCells := TPlayer(Source).TotalCells; 892 824 TotalUnits := TPlayer(Source).TotalUnits; … … 894 826 TotalDiscovered := TPlayer(Source).TotalDiscovered; 895 827 TotalWinObjectiveCells := TPlayer(Source).TotalWinObjectiveCells; 896 StartUnits := TPlayer(Source).StartUnits;897 828 StartCell := TPlayer(Source).StartCell; 898 Agressivity := TPlayer(Source).Agressivity;899 Defensive := TPlayer(Source).Defensive;900 Nation := TPlayer(Source).Nation;901 829 end; 902 830 … … 1266 1194 1267 1195 class function TPlayer.GetFields: TItemFields; 1196 var 1197 Field: TItemField; 1268 1198 begin 1269 1199 Result := inherited; 1270 Result.AddField(2, 'Color', 'Color', dtColor); 1271 Result.AddField(3, 'Mode', 'Mode', dtInteger); 1272 Result.AddField(4, 'StartUnits', 'StartUnits', dtInteger); 1273 Result.AddField(5, 'Agressivity', 'Agressivity', dtInteger); 1274 Result.AddField(6, 'Defensive', 'Defensive', dtBoolean); 1200 Field := Result.AddField(2, 'Nation', SNation, dtReference); 1201 Field := Result.AddField(3, 'Mode', SMode, dtEnumeration); 1202 Field.EnumStates.Add(SHuman); 1203 Field.EnumStates.Add(SComputer); 1204 Result.AddField(4, 'Color', SColor, dtColor); 1205 Field := Result.AddField(5, 'Agressivity', SAgressivity, dtEnumeration); 1206 Field.EnumStates.Add(SLow); 1207 Field.EnumStates.Add(SMedium); 1208 Field.EnumStates.Add(SHigh); 1209 Result.AddField(6, 'Defensive', SDefensive, dtBoolean); 1210 Result.AddField(7, 'StartUnits', SStartUnits, dtInteger); 1275 1211 end; 1276 1212 1277 1213 procedure TPlayer.GetValue(Index: Integer; out Value); 1278 1214 begin 1279 inherited GetValue(Index, Value); 1215 if Index = 1 then string(Value) := Name 1216 else if Index = 2 then TNation(Value) := Nation 1217 else if Index = 3 then TPlayerMode(Value) := Mode 1218 else if Index = 4 then TColor(Value) := Color 1219 else if Index = 5 then TComputerAgressivity(Value) := Agressivity 1220 else if Index = 6 then Boolean(Value) := Defensive 1221 else if Index = 7 then Integer(Value) := StartUnits 1222 else inherited; 1280 1223 end; 1281 1224 1282 1225 procedure TPlayer.SetValue(Index: Integer; var Value); 1283 1226 begin 1284 inherited SetValue(Index, Value); 1227 if Index = 1 then Name := string(Value) 1228 else if Index = 2 then Nation := TNation(Value) 1229 else if Index = 3 then Mode := TPlayerMode(Value) 1230 else if Index = 4 then Color := TColor(Value) 1231 else if Index = 5 then Agressivity := TComputerAgressivity(Value) 1232 else if Index = 6 then Defensive := Boolean(Value) 1233 else if Index = 7 then StartUnits := Integer(Value) 1234 else inherited; 1235 end; 1236 1237 function TPlayer.GetReferenceList(Index: Integer): TItemList; 1238 begin 1239 if Index = 2 then Result := TGame(Game).GameSystem.Nations 1240 else Result := nil; 1285 1241 end; 1286 1242 … … 1288 1244 begin 1289 1245 Result := 'Player'; 1246 end; 1247 1248 class function TPlayer.GetClassName: string; 1249 begin 1250 Result := SPlayer; 1290 1251 end; 1291 1252
Note:
See TracChangeset
for help on using the changeset viewer.