Changeset 285
- Timestamp:
- Mar 10, 2019, 11:57:03 PM (6 years ago)
- Location:
- trunk
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/UItemList.pas
r284 r285 6 6 7 7 uses 8 Classes, SysUtils, fgl, DOM, UXMLUtils, UCommon ;8 Classes, SysUtils, fgl, DOM, UXMLUtils, UCommon, Graphics; 9 9 10 10 type 11 TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor, 12 dtTime, dtDate, dtDateTime); 11 13 12 14 TItemField = class 15 SysName: string; 13 16 Name: string; 14 17 Index: Integer; 18 DataType: TDataType; 19 Position: TPoint; 20 Size: TPoint; 15 21 end; 16 22 … … 18 24 19 25 TItemFields = class(TFPGObjectList<TItemField>) 20 function AddField( Name: string): TItemField;26 function AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField; 21 27 end; 22 28 … … 24 30 25 31 TItem = class 32 private 33 procedure AssignValue(Source: TItem; Field: TItemField); 34 procedure LoadValueFromNode(Node: TDOMNode; Field: TItemField); virtual; 35 procedure SaveValueToNode(Node: TDOMNode; Field: TItemField); virtual; 36 public 26 37 Id: Integer; 27 38 Name: string; … … 32 43 procedure LoadFromNode(Node: TDOMNode); virtual; 33 44 procedure SaveToNode(Node: TDOMNode); virtual; 45 class function GetClassSysName: string; virtual; 34 46 end; 35 47 … … 40 52 TItemList = class(TFPGObjectList<TItem>) 41 53 NewId: Integer; 42 function GetItemClass: TItemClass; virtual;54 class function GetItemClass: TItemClass; virtual; 43 55 function IncrementName(Name: string): string; 44 56 function GetNextAvailableName(Name: string): string; … … 48 60 procedure Assign(Source: TItemList); virtual; 49 61 function AddItem(Name: string): TItem; virtual; 62 procedure LoadFromNode(Node: TDOMNode); virtual; 63 procedure SaveToNode(Node: TDOMNode); virtual; 50 64 constructor Create(FreeObjects: Boolean = True); 51 65 end; … … 74 88 end; 75 89 90 procedure TItemList.LoadFromNode(Node: TDOMNode); 91 var 92 Node2: TDOMNode; 93 NewItem: TItem; 94 begin 95 Count := 0; 96 Node2 := Node.FirstChild; 97 while Assigned(Node2) and (Node2.NodeName = UnicodeString(GetItemClass.GetClassSysName)) do begin 98 NewItem := GetItemClass.Create; 99 NewItem.LoadFromNode(Node2); 100 Add(NewItem); 101 Node2 := Node2.NextSibling; 102 end; 103 end; 104 105 procedure TItemList.SaveToNode(Node: TDOMNode); 106 var 107 I: Integer; 108 NewNode2: TDOMNode; 109 begin 110 for I := 0 to Count - 1 do 111 with TItem(Items[I]) do begin 112 NewNode2 := Node.OwnerDocument.CreateElement(UnicodeString(GetItemClass.GetClassSysName)); 113 Node.AppendChild(NewNode2); 114 SaveToNode(NewNode2); 115 end; 116 end; 117 76 118 constructor TItemList.Create(FreeObjects: Boolean); 77 119 begin … … 80 122 end; 81 123 82 function TItemList.GetItemClass: TItemClass;124 class function TItemList.GetItemClass: TItemClass; 83 125 begin 84 126 Result := TItem; … … 133 175 { TItemFields } 134 176 135 function TItemFields.AddField( Name: string): TItemField;177 function TItemFields.AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField; 136 178 begin 137 179 Result := TItemField.Create; 180 Result.Index := Index; 138 181 Result.Name := Name; 182 Result.SysName := SysName; 183 Result.DataType := DataType; 139 184 Add(Result); 140 185 end; … … 142 187 { TItem } 143 188 189 procedure TItem.AssignValue(Source: TItem; Field: TItemField); 190 var 191 ValueString: string; 192 ValueColor: TColor; 193 ValueInteger: Integer; 194 begin 195 if Field.DataType = dtString then begin 196 Source.GetValue(Field.Index, ValueString); 197 SetValue(Field.Index, ValueString); 198 end else 199 if Field.DataType = dtColor then begin 200 Source.GetValue(Field.Index, ValueColor); 201 SetValue(Field.Index, ValueColor); 202 end else 203 if Field.DataType = dtInteger then begin 204 Source.GetValue(Field.Index, ValueInteger); 205 SetValue(Field.Index, ValueInteger); 206 end else 207 raise Exception.Create('Unsupported field value data type'); 208 end; 209 210 procedure TItem.LoadValueFromNode(Node: TDOMNode; Field: TItemField); 211 var 212 ValueString: string; 213 ValueColor: TColor; 214 ValueInteger: Integer; 215 begin 216 if Field.DataType = dtString then begin 217 ValueString := ReadString(Node, Field.SysName, ''); 218 SetValue(Field.Index, ValueString); 219 end else 220 if Field.DataType = dtColor then begin 221 ValueColor := ReadInteger(Node, Field.SysName, 0); 222 SetValue(Field.Index, ValueColor); 223 end else 224 if Field.DataType = dtInteger then begin 225 ValueInteger := ReadInteger(Node, Field.SysName, 0); 226 SetValue(Field.Index, ValueInteger); 227 end else 228 raise Exception.Create('Unsupported field value data type'); 229 end; 230 231 procedure TItem.SaveValueToNode(Node: TDOMNode; Field: TItemField); 232 var 233 ValueString: string; 234 ValueColor: TColor; 235 ValueInteger: Integer; 236 begin 237 if Field.DataType = dtString then begin 238 GetValue(Field.Index, ValueString); 239 WriteString(Node, Field.SysName, ValueString); 240 end else 241 if Field.DataType = dtColor then begin 242 GetValue(Field.Index, ValueColor); 243 WriteInteger(Node, Field.SysName, ValueColor); 244 end else 245 if Field.DataType = dtInteger then begin 246 GetValue(Field.Index, ValueInteger); 247 WriteInteger(Node, Field.SysName, ValueInteger); 248 end else 249 raise Exception.Create('Unsupported field value data type'); 250 end; 251 144 252 function TItem.GetFields: TItemFields; 145 253 begin 146 254 Result := TItemFields.Create; 255 Result.AddField(1, 'Name', 'Name', dtString); 147 256 end; 148 257 … … 156 265 157 266 procedure TItem.Assign(Source: TItem); 267 var 268 I: Integer; 269 Fields: TItemFields; 158 270 begin 159 271 Id := Source.Id; 160 Name := Source.Name; 272 if Source is ClassType then begin 273 Fields := GetFields; 274 try 275 for I := 0 to Fields.Count - 1 do 276 AssignValue(Source, Fields[I]); 277 finally 278 Fields.Free; 279 end; 280 end; 161 281 end; 162 282 163 283 procedure TItem.LoadFromNode(Node: TDOMNode); 284 var 285 Fields: TItemFields; 286 I: Integer; 164 287 begin 165 288 Id := ReadInteger(Node, 'Id', 0); 166 Name := ReadString(Node, 'Name', ''); 289 Fields := GetFields; 290 try 291 for I := 0 to Fields.Count - 1 do begin 292 LoadValueFromNode(Node, Fields[I]); 293 end; 294 finally 295 Fields.Free; 296 end; 167 297 end; 168 298 169 299 procedure TItem.SaveToNode(Node: TDOMNode); 300 var 301 Fields: TItemFields; 302 I: Integer; 170 303 begin 171 304 WriteInteger(Node, 'Id', Id); 172 WriteString(Node, 'Name', Name); 305 Fields := GetFields; 306 try 307 for I := 0 to Fields.Count - 1 do begin 308 SaveValueToNode(Node, Fields[I]); 309 end; 310 finally 311 Fields.Free; 312 end; 313 end; 314 315 class function TItem.GetClassSysName: string; 316 begin 317 Result := 'Item'; 173 318 end; 174 319 -
trunk/UNation.pas
r284 r285 6 6 7 7 uses 8 Classes, SysUtils, fgl,DOM, UXMLUtils, Graphics, UItemList;8 Classes, SysUtils, DOM, UXMLUtils, Graphics, UItemList; 9 9 10 10 type … … 17 17 procedure GetValue(Index: Integer; out Value); override; 18 18 procedure SetValue(Index: Integer; var Value); override; 19 procedure Assign(Source: TItem); override; 20 procedure LoadFromNode(Node: TDOMNode); override; 21 procedure SaveToNode(Node: TDOMNode); override; 19 class function GetClassSysName: string; override; 22 20 end; 23 21 … … 25 23 26 24 TNations = class(TItemList) 27 function GetItemClass: TItemClass; override; 28 procedure LoadFromNode(Node: TDOMNode); 29 procedure SaveToNode(Node: TDOMNode); 30 constructor Create(FreeObjects: Boolean = True); 25 class function GetItemClass: TItemClass; override; 31 26 end; 32 27 … … 44 39 function TNation.GetFields: TItemFields; 45 40 begin 46 inherited; 47 Result.AddField('Name'); 48 Result.AddField('Color'); 41 Result := inherited; 42 Result.AddField(2, 'Color', 'Color', dtColor); 49 43 end; 50 44 51 45 procedure TNation.GetValue(Index: Integer; out Value); 52 46 begin 53 if Index = 0then string(Value) := Name54 else if Index = 1then TColor(Value) := Color47 if Index = 1 then string(Value) := Name 48 else if Index = 2 then TColor(Value) := Color 55 49 else raise Exception.Create('Unsupported value index ' + IntToStr(Index)); 56 50 end; … … 58 52 procedure TNation.SetValue(Index: Integer; var Value); 59 53 begin 60 if Index = 0then Name := string(Value)61 else if Index = 1then Color := TColor(Value)54 if Index = 1 then Name := string(Value) 55 else if Index = 2 then Color := TColor(Value) 62 56 else raise Exception.Create('Unsupported value index ' + IntToStr(Index)); 63 57 end; 64 58 65 procedure TNation.Assign(Source: TItem);59 class function TNation.GetClassSysName: string; 66 60 begin 67 inherited; 68 Color := TNation(Source).Color; 69 end; 70 71 procedure TNation.LoadFromNode(Node: TDOMNode); 72 begin 73 inherited; 74 Color := ReadInteger(Node, 'Color', 0); 75 end; 76 77 procedure TNation.SaveToNode(Node: TDOMNode); 78 begin 79 inherited; 80 WriteInteger(Node, 'Color', Color); 61 Result := 'Nation'; 81 62 end; 82 63 83 64 { TNations } 84 65 85 function TNations.GetItemClass: TItemClass;66 class function TNations.GetItemClass: TItemClass; 86 67 begin 87 68 Result := TNation; 88 69 end; 89 70 90 procedure TNations.LoadFromNode(Node: TDOMNode);91 var92 Node2: TDOMNode;93 NewItem: TNation;94 begin95 Count := 0;96 Node2 := Node.FirstChild;97 while Assigned(Node2) and (Node2.NodeName = 'Nation') do begin98 NewItem := TNation.Create;99 NewItem.LoadFromNode(Node2);100 Add(NewItem);101 Node2 := Node2.NextSibling;102 end;103 end;104 105 procedure TNations.SaveToNode(Node: TDOMNode);106 var107 I: Integer;108 NewNode2: TDOMNode;109 begin110 for I := 0 to Count - 1 do111 with Items[I] do begin112 NewNode2 := Node.OwnerDocument.CreateElement('Nation');113 Node.AppendChild(NewNode2);114 SaveToNode(NewNode2);115 end;116 end;117 118 constructor TNations.Create(FreeObjects: Boolean);119 begin120 inherited;121 end;122 123 71 end. 124 72 -
trunk/UPlayer.pas
r284 r285 7 7 uses 8 8 Classes, SysUtils, Graphics, UMap, DOM, fgl, XMLConf, UXMLUtils, Math, 9 UGeometry, UUnit, UNation ;9 UGeometry, UUnit, UNation, UItemList; 10 10 11 11 type … … 92 92 { TPlayer } 93 93 94 TPlayer = class 94 TPlayer = class(TItem) 95 95 private 96 96 FGame: TObject; //TGame; … … 104 104 procedure SetMode(AValue: TPlayerMode); 105 105 public 106 Id: Integer;107 Name: string;108 106 Color: TColor; 109 107 TotalUnits: Integer; … … 121 119 Units: TUnits; 122 120 Nation: TNation; 121 function GetFields: TItemFields; override; 122 procedure GetValue(Index: Integer; out Value); override; 123 procedure SetValue(Index: Integer; var Value); override; 124 class function GetClassSysName: string; override; 123 125 function IsAllowedMoveTarget(CellFrom, CellTo: TPlayerCell): Boolean; 124 126 procedure ReduceMovesPower; … … 135 137 function IsAlive: Boolean; 136 138 procedure Clear; 137 procedure LoadFromNode(Node: TDOMNode); 138 procedure SaveToNode(Node: TDOMNode); 139 procedure LoadFromNode(Node: TDOMNode); override; 140 procedure SaveToNode(Node: TDOMNode); override; 139 141 constructor Create; 140 142 destructor Destroy; override; 141 procedure Assign(Source: T Player);143 procedure Assign(Source: TItem); override; 142 144 procedure LoadConfig(Config: TXmlConfig; Path: string); 143 145 procedure SaveConfig(Config: TXmlConfig; Path: string); … … 880 882 end; 881 883 882 procedure TPlayer.Assign(Source: T Player);884 procedure TPlayer.Assign(Source: TItem); 883 885 begin 884 886 Id := Source.Id; 885 887 Name := Source.Name; 886 Color := Source.Color;887 Mode := Source.Mode;888 Game := Source.Game;889 TotalCells := Source.TotalCells;890 TotalUnits := Source.TotalUnits;891 TotalCities := Source.TotalCities;892 TotalDiscovered := Source.TotalDiscovered;893 TotalWinObjectiveCells := Source.TotalWinObjectiveCells;894 StartUnits := Source.StartUnits;895 StartCell := Source.StartCell;896 Agressivity := Source.Agressivity;897 Defensive := Source.Defensive;898 Nation := Source.Nation;888 Color := TPlayer(Source).Color; 889 Mode := TPlayer(Source).Mode; 890 Game := TPlayer(Source).Game; 891 TotalCells := TPlayer(Source).TotalCells; 892 TotalUnits := TPlayer(Source).TotalUnits; 893 TotalCities := TPlayer(Source).TotalCities; 894 TotalDiscovered := TPlayer(Source).TotalDiscovered; 895 TotalWinObjectiveCells := TPlayer(Source).TotalWinObjectiveCells; 896 StartUnits := TPlayer(Source).StartUnits; 897 StartCell := TPlayer(Source).StartCell; 898 Agressivity := TPlayer(Source).Agressivity; 899 Defensive := TPlayer(Source).Defensive; 900 Nation := TPlayer(Source).Nation; 899 901 end; 900 902 … … 1261 1263 if FMode = AValue then Exit; 1262 1264 FMode := AValue; 1265 end; 1266 1267 function TPlayer.GetFields: TItemFields; 1268 begin 1269 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); 1275 end; 1276 1277 procedure TPlayer.GetValue(Index: Integer; out Value); 1278 begin 1279 inherited GetValue(Index, Value); 1280 end; 1281 1282 procedure TPlayer.SetValue(Index: Integer; var Value); 1283 begin 1284 inherited SetValue(Index, Value); 1285 end; 1286 1287 class function TPlayer.GetClassSysName: string; 1288 begin 1289 Result := 'Player'; 1263 1290 end; 1264 1291
Note:
See TracChangeset
for help on using the changeset viewer.