Changeset 285


Ignore:
Timestamp:
Mar 10, 2019, 11:57:03 PM (6 years ago)
Author:
chronos
Message:
  • Modified: More work on item class with defined form fields.
Location:
trunk
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/UItemList.pas

    r284 r285  
    66
    77uses
    8   Classes, SysUtils, fgl, DOM, UXMLUtils, UCommon;
     8  Classes, SysUtils, fgl, DOM, UXMLUtils, UCommon, Graphics;
    99
    1010type
     11  TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
     12    dtTime, dtDate, dtDateTime);
    1113
    1214  TItemField = class
     15    SysName: string;
    1316    Name: string;
    1417    Index: Integer;
     18    DataType: TDataType;
     19    Position: TPoint;
     20    Size: TPoint;
    1521  end;
    1622
     
    1824
    1925  TItemFields = class(TFPGObjectList<TItemField>)
    20     function AddField(Name: string): TItemField;
     26    function AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
    2127  end;
    2228
     
    2430
    2531  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
    2637    Id: Integer;
    2738    Name: string;
     
    3243    procedure LoadFromNode(Node: TDOMNode); virtual;
    3344    procedure SaveToNode(Node: TDOMNode); virtual;
     45    class function GetClassSysName: string; virtual;
    3446  end;
    3547
     
    4052  TItemList = class(TFPGObjectList<TItem>)
    4153    NewId: Integer;
    42     function GetItemClass: TItemClass; virtual;
     54    class function GetItemClass: TItemClass; virtual;
    4355    function IncrementName(Name: string): string;
    4456    function GetNextAvailableName(Name: string): string;
     
    4860    procedure Assign(Source: TItemList); virtual;
    4961    function AddItem(Name: string): TItem; virtual;
     62    procedure LoadFromNode(Node: TDOMNode); virtual;
     63    procedure SaveToNode(Node: TDOMNode); virtual;
    5064    constructor Create(FreeObjects: Boolean = True);
    5165  end;
     
    7488end;
    7589
     90procedure TItemList.LoadFromNode(Node: TDOMNode);
     91var
     92  Node2: TDOMNode;
     93  NewItem: TItem;
     94begin
     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;
     103end;
     104
     105procedure TItemList.SaveToNode(Node: TDOMNode);
     106var
     107  I: Integer;
     108  NewNode2: TDOMNode;
     109begin
     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;
     116end;
     117
    76118constructor TItemList.Create(FreeObjects: Boolean);
    77119begin
     
    80122end;
    81123
    82 function TItemList.GetItemClass: TItemClass;
     124class function TItemList.GetItemClass: TItemClass;
    83125begin
    84126  Result := TItem;
     
    133175{ TItemFields }
    134176
    135 function TItemFields.AddField(Name: string): TItemField;
     177function TItemFields.AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
    136178begin
    137179  Result := TItemField.Create;
     180  Result.Index := Index;
    138181  Result.Name := Name;
     182  Result.SysName := SysName;
     183  Result.DataType := DataType;
    139184  Add(Result);
    140185end;
     
    142187{ TItem }
    143188
     189procedure TItem.AssignValue(Source: TItem; Field: TItemField);
     190var
     191  ValueString: string;
     192  ValueColor: TColor;
     193  ValueInteger: Integer;
     194begin
     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');
     208end;
     209
     210procedure TItem.LoadValueFromNode(Node: TDOMNode; Field: TItemField);
     211var
     212  ValueString: string;
     213  ValueColor: TColor;
     214  ValueInteger: Integer;
     215begin
     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');
     229end;
     230
     231procedure TItem.SaveValueToNode(Node: TDOMNode; Field: TItemField);
     232var
     233  ValueString: string;
     234  ValueColor: TColor;
     235  ValueInteger: Integer;
     236begin
     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');
     250end;
     251
    144252function TItem.GetFields: TItemFields;
    145253begin
    146254  Result := TItemFields.Create;
     255  Result.AddField(1, 'Name', 'Name', dtString);
    147256end;
    148257
     
    156265
    157266procedure TItem.Assign(Source: TItem);
     267var
     268  I: Integer;
     269  Fields: TItemFields;
    158270begin
    159271  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;
    161281end;
    162282
    163283procedure TItem.LoadFromNode(Node: TDOMNode);
     284var
     285  Fields: TItemFields;
     286  I: Integer;
    164287begin
    165288  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;
    167297end;
    168298
    169299procedure TItem.SaveToNode(Node: TDOMNode);
     300var
     301  Fields: TItemFields;
     302  I: Integer;
    170303begin
    171304  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;
     313end;
     314
     315class function TItem.GetClassSysName: string;
     316begin
     317  Result := 'Item';
    173318end;
    174319
  • trunk/UNation.pas

    r284 r285  
    66
    77uses
    8   Classes, SysUtils, fgl, DOM, UXMLUtils, Graphics, UItemList;
     8  Classes, SysUtils, DOM, UXMLUtils, Graphics, UItemList;
    99
    1010type
     
    1717    procedure GetValue(Index: Integer; out Value); override;
    1818    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;
    2220  end;
    2321
     
    2523
    2624  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;
    3126  end;
    3227
     
    4439function TNation.GetFields: TItemFields;
    4540begin
    46   inherited;
    47   Result.AddField('Name');
    48   Result.AddField('Color');
     41  Result := inherited;
     42  Result.AddField(2, 'Color', 'Color', dtColor);
    4943end;
    5044
    5145procedure TNation.GetValue(Index: Integer; out Value);
    5246begin
    53   if Index = 0 then string(Value) := Name
    54   else if Index = 1 then TColor(Value) := Color
     47  if Index = 1 then string(Value) := Name
     48  else if Index = 2 then TColor(Value) := Color
    5549  else raise Exception.Create('Unsupported value index ' + IntToStr(Index));
    5650end;
     
    5852procedure TNation.SetValue(Index: Integer; var Value);
    5953begin
    60   if Index = 0 then Name := string(Value)
    61   else if Index = 1 then Color := TColor(Value)
     54  if Index = 1 then Name := string(Value)
     55  else if Index = 2 then Color := TColor(Value)
    6256  else raise Exception.Create('Unsupported value index ' + IntToStr(Index));
    6357end;
    6458
    65 procedure TNation.Assign(Source: TItem);
     59class function TNation.GetClassSysName: string;
    6660begin
    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';
    8162end;
    8263
    8364{ TNations }
    8465
    85 function TNations.GetItemClass: TItemClass;
     66class function TNations.GetItemClass: TItemClass;
    8667begin
    8768  Result := TNation;
    8869end;
    8970
    90 procedure TNations.LoadFromNode(Node: TDOMNode);
    91 var
    92   Node2: TDOMNode;
    93   NewItem: TNation;
    94 begin
    95   Count := 0;
    96   Node2 := Node.FirstChild;
    97   while Assigned(Node2) and (Node2.NodeName = 'Nation') do begin
    98     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 var
    107   I: Integer;
    108   NewNode2: TDOMNode;
    109 begin
    110   for I := 0 to Count - 1 do
    111   with Items[I] do begin
    112     NewNode2 := Node.OwnerDocument.CreateElement('Nation');
    113     Node.AppendChild(NewNode2);
    114     SaveToNode(NewNode2);
    115   end;
    116 end;
    117 
    118 constructor TNations.Create(FreeObjects: Boolean);
    119 begin
    120   inherited;
    121 end;
    122 
    12371end.
    12472
  • trunk/UPlayer.pas

    r284 r285  
    77uses
    88  Classes, SysUtils, Graphics, UMap, DOM, fgl, XMLConf, UXMLUtils, Math,
    9   UGeometry, UUnit, UNation;
     9  UGeometry, UUnit, UNation, UItemList;
    1010
    1111type
     
    9292  { TPlayer }
    9393
    94   TPlayer = class
     94  TPlayer = class(TItem)
    9595  private
    9696    FGame: TObject; //TGame;
     
    104104    procedure SetMode(AValue: TPlayerMode);
    105105  public
    106     Id: Integer;
    107     Name: string;
    108106    Color: TColor;
    109107    TotalUnits: Integer;
     
    121119    Units: TUnits;
    122120    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;
    123125    function IsAllowedMoveTarget(CellFrom, CellTo: TPlayerCell): Boolean;
    124126    procedure ReduceMovesPower;
     
    135137    function IsAlive: Boolean;
    136138    procedure Clear;
    137     procedure LoadFromNode(Node: TDOMNode);
    138     procedure SaveToNode(Node: TDOMNode);
     139    procedure LoadFromNode(Node: TDOMNode); override;
     140    procedure SaveToNode(Node: TDOMNode); override;
    139141    constructor Create;
    140142    destructor Destroy; override;
    141     procedure Assign(Source: TPlayer);
     143    procedure Assign(Source: TItem); override;
    142144    procedure LoadConfig(Config: TXmlConfig; Path: string);
    143145    procedure SaveConfig(Config: TXmlConfig; Path: string);
     
    880882end;
    881883
    882 procedure TPlayer.Assign(Source: TPlayer);
     884procedure TPlayer.Assign(Source: TItem);
    883885begin
    884886  Id := Source.Id;
    885887  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;
    899901end;
    900902
     
    12611263  if FMode = AValue then Exit;
    12621264  FMode := AValue;
     1265end;
     1266
     1267function TPlayer.GetFields: TItemFields;
     1268begin
     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);
     1275end;
     1276
     1277procedure TPlayer.GetValue(Index: Integer; out Value);
     1278begin
     1279  inherited GetValue(Index, Value);
     1280end;
     1281
     1282procedure TPlayer.SetValue(Index: Integer; var Value);
     1283begin
     1284  inherited SetValue(Index, Value);
     1285end;
     1286
     1287class function TPlayer.GetClassSysName: string;
     1288begin
     1289  Result := 'Player';
    12631290end;
    12641291
Note: See TracChangeset for help on using the changeset viewer.