Changeset 290 for trunk/UBuilding.pas
- Timestamp:
- Mar 25, 2019, 12:51:41 AM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note:
See TracChangeset
for help on using the changeset viewer.