Changeset 290
- Timestamp:
- Mar 25, 2019, 12:51:41 AM (6 years ago)
- Location:
- trunk
- Files:
-
- 4 added
- 8 deleted
- 8 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Forms/UFormGameSystem.pas
r289 r290 7 7 uses 8 8 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls, 9 ComCtrls, UGameSystem, UFormUnitKinds, UFormNations, UFormBuildingKinds; 9 ComCtrls, UGameSystem, UFormUnitKinds, 10 UFormList; 10 11 11 12 type … … 37 38 FGameSystem: TGameSystem; 38 39 FormUnitKinds: TFormUnitKinds; 39 FormNations: TForm Nations;40 FormBuildingKinds: TForm BuildingKinds;40 FormNations: TFormList; 41 FormBuildingKinds: TFormList; 41 42 procedure SetGameSystem(AValue: TGameSystem); 42 43 public … … 98 99 FormUnitKinds.Align := alClient; 99 100 FormUnitKinds.Visible := True; 100 FormNations := TForm Nations.Create(nil);101 FormNations := TFormList.Create(nil); 101 102 FormNations.ManualDock(TabSheetNations, nil, alClient); 102 103 FormNations.Align := alClient; 103 104 FormNations.Visible := True; 104 FormBuildingKinds := TForm BuildingKinds.Create(nil);105 FormBuildingKinds := TFormList.Create(nil); 105 106 FormBuildingKinds.ManualDock(TabSheetBuildings, nil, alClient); 106 107 FormBuildingKinds.Align := alClient; … … 126 127 if Assigned(FGameSystem) then begin 127 128 FormUnitKinds.UnitKinds := nil; 128 FormNations. Nations:= nil;129 FormBuildingKinds. BuildingKinds:= nil;129 FormNations.List := nil; 130 FormBuildingKinds.List := nil; 130 131 end; 131 132 FGameSystem := AValue; 132 133 if Assigned(FGameSystem) then begin 133 134 FormUnitKinds.UnitKinds := GameSystem.UnitKinds; 134 FormNations. Nations:= GameSystem.Nations;135 FormBuildingKinds. BuildingKinds:= GameSystem.BuildingKinds;135 FormNations.List := GameSystem.Nations; 136 FormBuildingKinds.List := GameSystem.BuildingKinds; 136 137 end; 137 138 end; -
trunk/Languages/xtactics.cs.po
r289 r290 113 113 msgstr "Přepnout Skrytou mapu" 114 114 115 #: tformbuildingkind.buttoncancel.caption116 #, fuzzy117 msgctxt "tformbuildingkind.buttoncancel.caption"118 msgid "Cancel"119 msgstr "Zrušit"120 121 #: tformbuildingkind.buttonok.caption122 #, fuzzy123 msgctxt "tformbuildingkind.buttonok.caption"124 msgid "OK"125 msgstr "OK"126 127 #: tformbuildingkind.caption128 msgid "Building kind"129 msgstr ""130 131 #: tformbuildingkind.labelname.caption132 #, fuzzy133 msgctxt "tformbuildingkind.labelname.caption"134 msgid "Name:"135 msgstr "Jméno:"136 137 #: tformbuildingkinds.aadd.caption138 #, fuzzy139 msgctxt "tformbuildingkinds.aadd.caption"140 msgid "Add"141 msgstr "Přidat"142 143 #: tformbuildingkinds.aclone.caption144 #, fuzzy145 msgctxt "tformbuildingkinds.aclone.caption"146 msgid "Clone"147 msgstr "Klonovat"148 149 #: tformbuildingkinds.amodify.caption150 #, fuzzy151 msgctxt "tformbuildingkinds.amodify.caption"152 msgid "Modify"153 msgstr "Upravit"154 155 #: tformbuildingkinds.aremove.caption156 #, fuzzy157 msgctxt "tformbuildingkinds.aremove.caption"158 msgid "Remove"159 msgstr "Odstranit"160 161 #: tformbuildingkinds.aselectall.caption162 #, fuzzy163 msgctxt "tformbuildingkinds.aselectall.caption"164 msgid "Select all"165 msgstr "Vybrat vše"166 167 #: tformbuildingkinds.caption168 msgid "Building kinds"169 msgstr ""170 171 #: tformbuildingkinds.listview1.columns[0].caption172 #, fuzzy173 msgctxt "tformbuildingkinds.listview1.columns[0].caption"174 msgid "Name"175 msgstr "Jméno"176 177 115 #: tformcharts.caption 178 116 msgctxt "tformcharts.caption" … … 283 221 #: tformgamesystem.tabsheetbuildings.caption 284 222 msgid "Buildings" 285 msgstr " "223 msgstr "Budovy" 286 224 287 225 #: tformgamesystem.tabsheetgeneral.caption … … 331 269 #: tformgamesystems.listview1.columns[0].caption 332 270 msgctxt "tformgamesystems.listview1.columns[0].caption" 271 msgid "Name" 272 msgstr "Jméno" 273 274 #: tformitem.buttoncancel.caption 275 msgctxt "tformitem.buttoncancel.caption" 276 msgid "Cancel" 277 msgstr "Zrušit" 278 279 #: tformitem.buttonok.caption 280 msgctxt "tformitem.buttonok.caption" 281 msgid "OK" 282 msgstr "OK" 283 284 #: tformitem.caption 285 msgctxt "tformitem.caption" 286 msgid "Item" 287 msgstr "Položka" 288 289 #: tformlist.aadd.caption 290 msgctxt "tformlist.aadd.caption" 291 msgid "Add" 292 msgstr "Přidat" 293 294 #: tformlist.aclone.caption 295 msgctxt "tformlist.aclone.caption" 296 msgid "Clone" 297 msgstr "Klonovat" 298 299 #: tformlist.amodify.caption 300 msgctxt "tformlist.amodify.caption" 301 msgid "Modify" 302 msgstr "Upravit" 303 304 #: tformlist.aremove.caption 305 msgctxt "tformlist.aremove.caption" 306 msgid "Remove" 307 msgstr "Odstranit" 308 309 #: tformlist.aselectall.caption 310 msgctxt "tformlist.aselectall.caption" 311 msgid "Select all" 312 msgstr "Vybrat vše" 313 314 #: tformlist.caption 315 msgid "List" 316 msgstr "Seznam" 317 318 #: tformlist.listview1.columns[0].caption 319 msgctxt "tformlist.listview1.columns[0].caption" 333 320 msgid "Name" 334 321 msgstr "Jméno" … … 462 449 msgstr " " 463 450 464 #: tformnation.buttoncancel.caption465 msgctxt "tformnation.buttoncancel.caption"466 msgid "Cancel"467 msgstr "Zrušit"468 469 #: tformnation.buttonok.caption470 msgctxt "tformnation.buttonok.caption"471 msgid "OK"472 msgstr "OK"473 474 #: tformnation.caption475 msgctxt "tformnation.caption"476 msgid "Nation"477 msgstr "Národ"478 479 #: tformnation.labelhealth.caption480 msgctxt "tformnation.labelhealth.caption"481 msgid "Color:"482 msgstr "Barva:"483 484 #: tformnation.labelname.caption485 msgctxt "tformnation.labelname.caption"486 msgid "Name:"487 msgstr "Jméno:"488 489 #: tformnations.aadd.caption490 msgctxt "tformnations.aadd.caption"491 msgid "Add"492 msgstr "Přidat"493 494 #: tformnations.aclone.caption495 msgctxt "tformnations.aclone.caption"496 msgid "Clone"497 msgstr "Klonovat"498 499 #: tformnations.amodify.caption500 msgctxt "tformnations.amodify.caption"501 msgid "Modify"502 msgstr "Upravit"503 504 #: tformnations.aremove.caption505 msgctxt "tformnations.aremove.caption"506 msgid "Remove"507 msgstr "Odstranit"508 509 #: tformnations.aselectall.caption510 msgctxt "tformnations.aselectall.caption"511 msgid "Select all"512 msgstr "Vybrat vše"513 514 #: tformnations.caption515 msgctxt "tformnations.caption"516 msgid "Nations"517 msgstr "Národy"518 519 #: tformnations.listview1.columns[0].caption520 msgctxt "tformnations.listview1.columns[0].caption"521 msgid "Name"522 msgstr "Jméno"523 524 #: tformnations.listview1.columns[1].caption525 msgctxt "tformnations.listview1.columns[1].caption"526 msgid "Color"527 msgstr "Barva"528 529 #: tformnations.listview1.columns[2].caption530 msgid "Bonuses"531 msgstr "Bonusy"532 533 451 #: tformnew.aserveradd.caption 534 452 msgctxt "tformnew.aserveradd.caption" … … 1016 934 msgstr "Jméno" 1017 935 1018 #: ubuilding.sbuilding 936 #: ubuilding.sbuildingkind 937 msgctxt "ubuilding.sbuildingkind" 1019 938 msgid "Building" 1020 msgstr "" 939 msgstr "Budovy" 940 941 #: ubuilding.scost 942 msgid "Cost" 943 msgstr "Cena" 1021 944 1022 945 #: uclientgui.swrongarrowangle … … 1077 1000 msgid "Version" 1078 1001 msgstr "Verze" 1079 1080 #: uformbuildingkinds.snewbuildingkind1081 msgid "New building kind"1082 msgstr ""1083 1084 #: uformbuildingkinds.sremoveitems1085 #, fuzzy1086 msgctxt "uformbuildingkinds.sremoveitems"1087 msgid "Remove items"1088 msgstr "Odstranit položky"1089 1090 #: uformbuildingkinds.sremoveitemsquery1091 #, fuzzy1092 msgctxt "uformbuildingkinds.sremoveitemsquery"1093 msgid "Do you want to remove selected items?"1094 msgstr "Opravdu chcete odstranit vybrané položky?"1095 1002 1096 1003 #: uformcharts.scitiescount … … 1176 1083 msgstr "Hlavní okno" 1177 1084 1085 #: uformlist.snewitem 1086 msgid "New item" 1087 msgstr "Nová položka" 1088 1089 #: uformlist.sremoveitems 1090 msgctxt "uformlist.sremoveitems" 1091 msgid "Remove items" 1092 msgstr "Odstranit položky" 1093 1094 #: uformlist.sremoveitemsquery 1095 msgctxt "uformlist.sremoveitemsquery" 1096 msgid "Do you want to remove selected items?" 1097 msgstr "Opravdu chcete odstranit vybrané položky?" 1098 1178 1099 #: uformmain.sturn 1179 1100 msgctxt "uformmain.sturn" … … 1181 1102 msgstr "tah" 1182 1103 1183 #: uformnations.snewunitkind1184 msgid "New nation"1185 msgstr "Nový národ"1186 1187 #: uformnations.sremoveitems1188 msgctxt "uformnations.sremoveitems"1189 msgid "Remove items"1190 msgstr "Odstranit položky"1191 1192 #: uformnations.sremoveitemsquery1193 msgctxt "uformnations.sremoveitemsquery"1194 msgid "Do you want to remove selected items?"1195 msgstr "Opravdu chcete odstranit vybrané položky?"1196 1197 1104 #: uformnew.sfromimagefile 1198 1105 msgid "From image file" … … 1353 1260 msgstr "Chybný formát souboru" 1354 1261 1262 #: uitemlist.sitem 1263 msgctxt "uitemlist.sitem" 1264 msgid "Item" 1265 msgstr "Položka" 1266 1267 #: uitemlist.sname 1268 msgctxt "uitemlist.sname" 1269 msgid "Name" 1270 msgstr "Jméno" 1271 1272 #: uitemlist.sno 1273 msgid "No" 1274 msgstr "Ne" 1275 1276 #: uitemlist.syes 1277 msgid "Yes" 1278 msgstr "Ano" 1279 1355 1280 #: umap.scellremoveneighborerror 1356 1281 msgctxt "umap.scellremoveneighborerror" … … 1391 1316 msgstr "Trojúhelníková" 1392 1317 1318 #: unation.scolor 1319 msgctxt "unation.scolor" 1320 msgid "Color" 1321 msgstr "Barva" 1322 1393 1323 #: unation.snation 1394 1324 msgctxt "unation.snation" -
trunk/Languages/xtactics.po
r289 r290 103 103 msgstr "" 104 104 105 #: tformbuildingkind.buttoncancel.caption106 msgctxt "tformbuildingkind.buttoncancel.caption"107 msgid "Cancel"108 msgstr ""109 110 #: tformbuildingkind.buttonok.caption111 msgctxt "tformbuildingkind.buttonok.caption"112 msgid "OK"113 msgstr ""114 115 #: tformbuildingkind.caption116 msgid "Building kind"117 msgstr ""118 119 #: tformbuildingkind.labelname.caption120 msgctxt "tformbuildingkind.labelname.caption"121 msgid "Name:"122 msgstr ""123 124 #: tformbuildingkinds.aadd.caption125 msgctxt "tformbuildingkinds.aadd.caption"126 msgid "Add"127 msgstr ""128 129 #: tformbuildingkinds.aclone.caption130 msgctxt "tformbuildingkinds.aclone.caption"131 msgid "Clone"132 msgstr ""133 134 #: tformbuildingkinds.amodify.caption135 msgctxt "tformbuildingkinds.amodify.caption"136 msgid "Modify"137 msgstr ""138 139 #: tformbuildingkinds.aremove.caption140 msgctxt "tformbuildingkinds.aremove.caption"141 msgid "Remove"142 msgstr ""143 144 #: tformbuildingkinds.aselectall.caption145 msgctxt "tformbuildingkinds.aselectall.caption"146 msgid "Select all"147 msgstr ""148 149 #: tformbuildingkinds.caption150 msgid "Building kinds"151 msgstr ""152 153 #: tformbuildingkinds.listview1.columns[0].caption154 msgctxt "tformbuildingkinds.listview1.columns[0].caption"155 msgid "Name"156 msgstr ""157 158 105 #: tformcharts.caption 159 106 msgctxt "tformcharts.caption" … … 315 262 msgstr "" 316 263 264 #: tformitem.buttoncancel.caption 265 msgctxt "tformitem.buttoncancel.caption" 266 msgid "Cancel" 267 msgstr "" 268 269 #: tformitem.buttonok.caption 270 msgctxt "tformitem.buttonok.caption" 271 msgid "OK" 272 msgstr "" 273 274 #: tformitem.caption 275 msgctxt "tformitem.caption" 276 msgid "Item" 277 msgstr "" 278 279 #: tformlist.aadd.caption 280 msgctxt "tformlist.aadd.caption" 281 msgid "Add" 282 msgstr "" 283 284 #: tformlist.aclone.caption 285 msgctxt "tformlist.aclone.caption" 286 msgid "Clone" 287 msgstr "" 288 289 #: tformlist.amodify.caption 290 msgctxt "tformlist.amodify.caption" 291 msgid "Modify" 292 msgstr "" 293 294 #: tformlist.aremove.caption 295 msgctxt "tformlist.aremove.caption" 296 msgid "Remove" 297 msgstr "" 298 299 #: tformlist.aselectall.caption 300 msgctxt "tformlist.aselectall.caption" 301 msgid "Select all" 302 msgstr "" 303 304 #: tformlist.caption 305 msgid "List" 306 msgstr "" 307 308 #: tformlist.listview1.columns[0].caption 309 msgctxt "tformlist.listview1.columns[0].caption" 310 msgid "Name" 311 msgstr "" 312 317 313 #: tformmain.amapgridvisible.caption 318 314 msgid "Map grid visible" … … 442 438 msgstr "" 443 439 444 #: tformnation.buttoncancel.caption445 msgctxt "tformnation.buttoncancel.caption"446 msgid "Cancel"447 msgstr ""448 449 #: tformnation.buttonok.caption450 msgctxt "tformnation.buttonok.caption"451 msgid "OK"452 msgstr ""453 454 #: tformnation.caption455 msgctxt "tformnation.caption"456 msgid "Nation"457 msgstr ""458 459 #: tformnation.labelhealth.caption460 msgctxt "tformnation.labelhealth.caption"461 msgid "Color:"462 msgstr ""463 464 #: tformnation.labelname.caption465 msgctxt "tformnation.labelname.caption"466 msgid "Name:"467 msgstr ""468 469 #: tformnations.aadd.caption470 msgctxt "tformnations.aadd.caption"471 msgid "Add"472 msgstr ""473 474 #: tformnations.aclone.caption475 msgctxt "tformnations.aclone.caption"476 msgid "Clone"477 msgstr ""478 479 #: tformnations.amodify.caption480 msgctxt "tformnations.amodify.caption"481 msgid "Modify"482 msgstr ""483 484 #: tformnations.aremove.caption485 msgctxt "tformnations.aremove.caption"486 msgid "Remove"487 msgstr ""488 489 #: tformnations.aselectall.caption490 msgctxt "tformnations.aselectall.caption"491 msgid "Select all"492 msgstr ""493 494 #: tformnations.caption495 msgctxt "tformnations.caption"496 msgid "Nations"497 msgstr ""498 499 #: tformnations.listview1.columns[0].caption500 msgctxt "tformnations.listview1.columns[0].caption"501 msgid "Name"502 msgstr ""503 504 #: tformnations.listview1.columns[1].caption505 msgctxt "tformnations.listview1.columns[1].caption"506 msgid "Color"507 msgstr ""508 509 #: tformnations.listview1.columns[2].caption510 msgid "Bonuses"511 msgstr ""512 513 440 #: tformnew.aserveradd.caption 514 441 msgctxt "tformnew.aserveradd.caption" … … 993 920 msgstr "" 994 921 995 #: ubuilding.sbuilding 922 #: ubuilding.sbuildingkind 923 msgctxt "ubuilding.sbuildingkind" 996 924 msgid "Building" 925 msgstr "" 926 927 #: ubuilding.scost 928 msgid "Cost" 997 929 msgstr "" 998 930 … … 1053 985 #: uformabout.sversion 1054 986 msgid "Version" 1055 msgstr ""1056 1057 #: uformbuildingkinds.snewbuildingkind1058 msgid "New building kind"1059 msgstr ""1060 1061 #: uformbuildingkinds.sremoveitems1062 msgctxt "uformbuildingkinds.sremoveitems"1063 msgid "Remove items"1064 msgstr ""1065 1066 #: uformbuildingkinds.sremoveitemsquery1067 msgctxt "uformbuildingkinds.sremoveitemsquery"1068 msgid "Do you want to remove selected items?"1069 987 msgstr "" 1070 988 … … 1143 1061 msgstr "" 1144 1062 1063 #: uformlist.snewitem 1064 msgid "New item" 1065 msgstr "" 1066 1067 #: uformlist.sremoveitems 1068 msgctxt "uformlist.sremoveitems" 1069 msgid "Remove items" 1070 msgstr "" 1071 1072 #: uformlist.sremoveitemsquery 1073 msgctxt "uformlist.sremoveitemsquery" 1074 msgid "Do you want to remove selected items?" 1075 msgstr "" 1076 1145 1077 #: uformmain.sturn 1146 1078 msgctxt "uformmain.sturn" … … 1148 1080 msgstr "" 1149 1081 1150 #: uformnations.snewunitkind1151 msgid "New nation"1152 msgstr ""1153 1154 #: uformnations.sremoveitems1155 msgctxt "uformnations.sremoveitems"1156 msgid "Remove items"1157 msgstr ""1158 1159 #: uformnations.sremoveitemsquery1160 msgctxt "uformnations.sremoveitemsquery"1161 msgid "Do you want to remove selected items?"1162 msgstr ""1163 1164 1082 #: uformnew.sfromimagefile 1165 1083 msgid "From image file" … … 1320 1238 msgstr "" 1321 1239 1240 #: uitemlist.sitem 1241 msgctxt "uitemlist.sitem" 1242 msgid "Item" 1243 msgstr "" 1244 1245 #: uitemlist.sname 1246 msgctxt "uitemlist.sname" 1247 msgid "Name" 1248 msgstr "" 1249 1250 #: uitemlist.sno 1251 msgid "No" 1252 msgstr "" 1253 1254 #: uitemlist.syes 1255 msgid "Yes" 1256 msgstr "" 1257 1322 1258 #: umap.scellremoveneighborerror 1323 1259 msgid "Can't remove cell from neighbour cell" … … 1350 1286 #: umaptype.sgridtypetriangle 1351 1287 msgid "Triangural" 1288 msgstr "" 1289 1290 #: unation.scolor 1291 msgctxt "unation.scolor" 1292 msgid "Color" 1352 1293 msgstr "" 1353 1294 -
trunk/UBuilding.pas
r289 r290 6 6 7 7 uses 8 Classes, SysUtils, fgl, UGeometry, DOM, UXMLUtils;8 Classes, SysUtils, UItemList; 9 9 10 10 type … … 12 12 { TBuildingKind } 13 13 14 TBuildingKind = class 15 Id: Integer; 16 Name: string; 14 TBuildingKind = class(TItem) 17 15 Cost: Integer; 18 procedure Assign(Source: TBuildingKind); 19 procedure LoadFromNode(Node: TDOMNode); 20 procedure SaveToNode(Node: TDOMNode); 16 class function GetFields: TItemFields; override; 17 procedure GetValue(Index: Integer; out Value); override; 18 procedure SetValue(Index: Integer; var Value); override; 19 class function GetClassSysName: string; override; 20 class function GetClassName: string; override; 21 21 end; 22 22 23 23 { TBuildingKinds } 24 24 25 TBuildingKinds = class(TFPGObjectList<TBuildingKind>) 26 function AddNew(Name: string): TBuildingKind; 27 procedure LoadFromNode(Node: TDOMNode); 28 procedure SaveToNode(Node: TDOMNode); 29 procedure Assign(Source: TBuildingKinds); 25 TBuildingKinds = class(TItemList) 26 class function GetItemClass: TItemClass; override; 30 27 end; 31 28 … … 35 32 36 33 resourcestring 37 SBuilding = 'Building'; 34 SBuildingKind = 'Building'; 35 SCost = 'Cost'; 38 36 39 37 … … 42 40 { TBuildingKind } 43 41 44 procedure TBuildingKind.Assign(Source: TBuildingKind);42 class function TBuildingKind.GetFields: TItemFields; 45 43 begin 46 Name := Source.Name;47 Cost := Source.Cost;44 Result := inherited; 45 Result.AddField(2, 'Cost', SCost, dtInteger); 48 46 end; 49 47 50 procedure TBuildingKind. LoadFromNode(Node: TDOMNode);48 procedure TBuildingKind.GetValue(Index: Integer; out Value); 51 49 begin 52 Id := ReadInteger(Node, 'Id', 0);53 Name := ReadString(Node, 'Name', '');54 Cost := ReadInteger(Node, 'Cost', 0);50 if Index = 1 then string(Value) := Name 51 else if Index = 2 then Integer(Value) := Cost 52 else raise Exception.Create('Unsupported value index ' + IntToStr(Index)); 55 53 end; 56 54 57 procedure TBuildingKind.S aveToNode(Node: TDOMNode);55 procedure TBuildingKind.SetValue(Index: Integer; var Value); 58 56 begin 59 WriteInteger(Node, 'Id', Id); 60 WriteString(Node, 'Name', Name); 61 WriteInteger(Node, 'Cost', Cost); 57 if Index = 1 then Name := string(Value) 58 else if Index = 2 then Cost := Integer(Value) 59 else raise Exception.Create('Unsupported value index ' + IntToStr(Index)); 60 end; 61 62 class function TBuildingKind.GetClassSysName: string; 63 begin 64 Result := 'BuildingKind'; 65 end; 66 67 class function TBuildingKind.GetClassName: string; 68 begin 69 Result := SBuildingKind; 62 70 end; 63 71 64 72 { TBuildingKinds } 65 73 66 function TBuildingKinds.AddNew(Name: string): TBuildingKind;74 class function TBuildingKinds.GetItemClass: TItemClass; 67 75 begin 68 Result := TBuildingKind.Create; 69 Result.Name := Name; 70 Add(Result); 71 end; 72 73 procedure TBuildingKinds.LoadFromNode(Node: TDOMNode); 74 var 75 Node2: TDOMNode; 76 NewItem: TBuildingKind; 77 begin 78 Count := 0; 79 Node2 := Node.FirstChild; 80 while Assigned(Node2) and (Node2.NodeName = 'BuildingKind') do begin 81 NewItem := TBuildingKind.Create; 82 NewItem.LoadFromNode(Node2); 83 Add(NewItem); 84 Node2 := Node2.NextSibling; 85 end; 86 end; 87 88 procedure TBuildingKinds.SaveToNode(Node: TDOMNode); 89 var 90 I: Integer; 91 NewNode2: TDOMNode; 92 begin 93 for I := 0 to Count - 1 do 94 with Items[I] do begin 95 NewNode2 := Node.OwnerDocument.CreateElement('BuildingKind'); 96 Node.AppendChild(NewNode2); 97 SaveToNode(NewNode2); 98 end; 99 end; 100 101 procedure TBuildingKinds.Assign(Source: TBuildingKinds); 102 var 103 I: Integer; 104 begin 105 while Count > Source.Count do Delete(Count - 1); 106 while Count < Source.Count do AddNew(''); 107 for I := 0 to Count - 1 do 108 Items[I].Assign(Source.Items[I]); 76 Result := TBuildingKind; 109 77 end; 110 78 -
trunk/UItemList.pas
r285 r290 11 11 TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor, 12 12 dtTime, dtDate, dtDateTime); 13 14 { TItemField } 13 15 14 16 TItemField = class … … 19 21 Position: TPoint; 20 22 Size: TPoint; 23 procedure Assign(Source: TItemField); 21 24 end; 22 25 … … 25 28 TItemFields = class(TFPGObjectList<TItemField>) 26 29 function AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField; 30 function SearchByIndex(Index: Integer): TItemField; 27 31 end; 28 32 … … 37 41 Id: Integer; 38 42 Name: string; 39 function GetFields: TItemFields; virtual; 43 class function GetFields: TItemFields; virtual; 44 function GetField(Index: Integer): TItemField; 40 45 procedure GetValue(Index: Integer; out Value); virtual; 46 function GetValueInteger(Index: Integer): Integer; 47 function GetValueString(Index: Integer): string; 48 function GetValueColor(Index: Integer): TColor; 49 function GetValueBoolean(Index: Integer): Boolean; 50 function GetValueAsText(Index: Integer): string; 41 51 procedure SetValue(Index: Integer; var Value); virtual; 52 procedure SetValueInteger(Index: Integer; Value: Integer); 53 procedure SetValueString(Index: Integer; Value: string); 54 procedure SetValueColor(Index: Integer; Value: TColor); 55 procedure SetValueBoolean(Index: Integer; Value: Boolean); 42 56 procedure Assign(Source: TItem); virtual; 43 57 procedure LoadFromNode(Node: TDOMNode); virtual; 44 58 procedure SaveToNode(Node: TDOMNode); virtual; 45 59 class function GetClassSysName: string; virtual; 60 class function GetClassName: string; virtual; 46 61 end; 47 62 … … 68 83 implementation 69 84 85 resourcestring 86 SYes = 'Yes'; 87 SNo = 'No'; 88 SItem = 'Item'; 89 SName = 'Name'; 90 91 { TItemField } 92 93 procedure TItemField.Assign(Source: TItemField); 94 begin 95 SysName := Source.SysName; 96 Name := Source.Name; 97 Index := Source.Index; 98 DataType := Source.DataType; 99 Position := Source.Position; 100 Size := Source.Size; 101 end; 102 70 103 { TItemList } 71 104 … … 185 218 end; 186 219 220 function TItemFields.SearchByIndex(Index: Integer): TItemField; 221 var 222 I: Integer; 223 begin 224 I := 0; 225 while (I < Count) and (Items[I].Index <> Index) do Inc(I); 226 if I < Count then Result := Items[I] 227 else Result := nil; 228 end; 229 187 230 { TItem } 188 231 … … 192 235 ValueColor: TColor; 193 236 ValueInteger: Integer; 237 ValueBoolean: Boolean; 194 238 begin 195 239 if Field.DataType = dtString then begin … … 205 249 SetValue(Field.Index, ValueInteger); 206 250 end else 251 if Field.DataType = dtBoolean then begin 252 Source.GetValue(Field.Index, ValueBoolean); 253 SetValue(Field.Index, ValueBoolean); 254 end else 207 255 raise Exception.Create('Unsupported field value data type'); 208 256 end; … … 250 298 end; 251 299 252 function TItem.GetFields: TItemFields;300 class function TItem.GetFields: TItemFields; 253 301 begin 254 302 Result := TItemFields.Create; 255 Result.AddField(1, 'Name', 'Name', dtString); 303 Result.AddField(1, 'Name', SName, dtString); 304 end; 305 306 function TItem.GetField(Index: Integer): TItemField; 307 var 308 Fields: TItemFields; 309 begin 310 Result := TItemField.Create; 311 Fields := GetFields; 312 try 313 Result.Assign(Fields[Index]); 314 finally 315 Fields.Free; 316 end; 256 317 end; 257 318 … … 260 321 end; 261 322 323 function TItem.GetValueString(Index: Integer): string; 324 begin 325 GetValue(Index, Result); 326 end; 327 328 function TItem.GetValueInteger(Index: Integer): Integer; 329 begin 330 GetValue(Index, Result); 331 end; 332 333 function TItem.GetValueColor(Index: Integer): TColor; 334 begin 335 GetValue(Index, Result); 336 end; 337 338 function TItem.GetValueBoolean(Index: Integer): Boolean; 339 begin 340 GetValue(Index, Result); 341 end; 342 343 function TItem.GetValueAsText(Index: Integer): string; 344 var 345 Fields: TItemFields; 346 ItemField: TItemField; 347 begin 348 Fields := GetFields; 349 ItemField := GetField(Fields.IndexOf(Fields.SearchByIndex(Index))); 350 if ItemField.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index)) 351 else if ItemField.DataType = dtString then Result := GetValueString(Index) 352 else if ItemField.DataType = dtColor then Result := '' 353 else if ItemField.DataType = dtBoolean then begin 354 if GetValueBoolean(Index) then Result := SYes else Result := SNo; 355 end; 356 ItemField.Free; 357 Fields.Free; 358 end; 359 262 360 procedure TItem.SetValue(Index: Integer; var Value); 263 361 begin 362 end; 363 364 procedure TItem.SetValueInteger(Index: Integer; Value: Integer); 365 begin 366 SetValue(Index, Value); 367 end; 368 369 procedure TItem.SetValueString(Index: Integer; Value: string); 370 begin 371 SetValue(Index, Value); 372 end; 373 374 procedure TItem.SetValueColor(Index: Integer; Value: TColor); 375 begin 376 SetValue(Index, Value); 377 end; 378 379 procedure TItem.SetValueBoolean(Index: Integer; Value: Boolean); 380 begin 381 SetValue(Index, Value); 264 382 end; 265 383 … … 318 436 end; 319 437 438 class function TItem.GetClassName: string; 439 begin 440 Result := SItem; 441 end; 442 320 443 end. 321 444 -
trunk/UNation.pas
r285 r290 14 14 TNation = class(TItem) 15 15 Color: TColor; 16 function GetFields: TItemFields; override;16 class function GetFields: TItemFields; override; 17 17 procedure GetValue(Index: Integer; out Value); override; 18 18 procedure SetValue(Index: Integer; var Value); override; 19 19 class function GetClassSysName: string; override; 20 class function GetClassName: string; override; 20 21 end; 21 22 … … 28 29 resourcestring 29 30 SNation = 'Nation'; 31 SColor = 'Color'; 30 32 31 33 … … 37 39 { TNation } 38 40 39 function TNation.GetFields: TItemFields;41 class function TNation.GetFields: TItemFields; 40 42 begin 41 43 Result := inherited; 42 Result.AddField(2, 'Color', 'Color', dtColor);44 Result.AddField(2, 'Color', SColor, dtColor); 43 45 end; 44 46 … … 62 64 end; 63 65 66 class function TNation.GetClassName: string; 67 begin 68 Result := SNation; 69 end; 70 64 71 { TNations } 65 72 -
trunk/UPlayer.pas
r285 r290 119 119 Units: TUnits; 120 120 Nation: TNation; 121 function GetFields: TItemFields; override;121 class function GetFields: TItemFields; override; 122 122 procedure GetValue(Index: Integer; out Value); override; 123 123 procedure SetValue(Index: Integer; var Value); override; … … 1265 1265 end; 1266 1266 1267 function TPlayer.GetFields: TItemFields;1267 class function TPlayer.GetFields: TItemFields; 1268 1268 begin 1269 1269 Result := inherited; -
trunk/xtactics.lpi
r289 r290 110 110 </Item7> 111 111 </RequiredPackages> 112 <Units Count="4 8">112 <Units Count="46"> 113 113 <Unit0> 114 114 <Filename Value="xtactics.lpr"/> … … 348 348 </Unit43> 349 349 <Unit44> 350 <Filename Value="Forms/UForm Nation.pas"/>351 <IsPartOfProject Value="True"/> 352 <ComponentName Value="Form Nation"/>350 <Filename Value="Forms/UFormList.pas"/> 351 <IsPartOfProject Value="True"/> 352 <ComponentName Value="FormList"/> 353 353 <HasResources Value="True"/> 354 354 <ResourceBaseClass Value="Form"/> 355 355 </Unit44> 356 356 <Unit45> 357 <Filename Value="Forms/UForm Nations.pas"/>358 <IsPartOfProject Value="True"/> 359 <ComponentName Value="Form Nations"/>357 <Filename Value="Forms/UFormItem.pas"/> 358 <IsPartOfProject Value="True"/> 359 <ComponentName Value="FormItem"/> 360 360 <HasResources Value="True"/> 361 361 <ResourceBaseClass Value="Form"/> 362 362 </Unit45> 363 <Unit46>364 <Filename Value="Forms/UFormBuildingKind.pas"/>365 <IsPartOfProject Value="True"/>366 <ComponentName Value="FormBuildingKind"/>367 <HasResources Value="True"/>368 <ResourceBaseClass Value="Form"/>369 </Unit46>370 <Unit47>371 <Filename Value="Forms/UFormBuildingKinds.pas"/>372 <IsPartOfProject Value="True"/>373 <ComponentName Value="FormBuildingKinds"/>374 <HasResources Value="True"/>375 <ResourceBaseClass Value="Form"/>376 </Unit47>377 363 </Units> 378 364 </ProjectOptions>
Note:
See TracChangeset
for help on using the changeset viewer.