Changeset 285 for trunk/UItemList.pas

Timestamp:

Mar 10, 2019, 11:57:03 PM (6 years ago)

Author:

chronos

Message:

• Modified: More work on item class with defined form fields.

File:

• trunk/UItemList.pas (modified) (11 diffs)

trunk/UItemList.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, fgl, DOM, UXMLUtils, UCommon;
+  Classes, SysUtils, fgl, DOM, UXMLUtils, UCommon, Graphics;
 
 type
+  TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
+    dtTime, dtDate, dtDateTime);
 
   TItemField = class
+    SysName: string;
     Name: string;
     Index: Integer;
+    DataType: TDataType;
+    Position: TPoint;
+    Size: TPoint;
   end;
 
@@ -18 +24 @@
 
   TItemFields = class(TFPGObjectList<TItemField>)
-    function AddField(Name: string): TItemField;
+    function AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
   end;
 
@@ -24 +30 @@
 
   TItem = class
+  private
+    procedure AssignValue(Source: TItem; Field: TItemField);
+    procedure LoadValueFromNode(Node: TDOMNode; Field: TItemField); virtual;
+    procedure SaveValueToNode(Node: TDOMNode; Field: TItemField); virtual;
+  public
     Id: Integer;
     Name: string;
@@ -32 +43 @@
     procedure LoadFromNode(Node: TDOMNode); virtual;
     procedure SaveToNode(Node: TDOMNode); virtual;
+    class function GetClassSysName: string; virtual;
   end;
 
@@ -40 +52 @@
   TItemList = class(TFPGObjectList<TItem>)
     NewId: Integer;
-    function GetItemClass: TItemClass; virtual;
+    class function GetItemClass: TItemClass; virtual;
     function IncrementName(Name: string): string;
     function GetNextAvailableName(Name: string): string;
@@ -48 +60 @@
     procedure Assign(Source: TItemList); virtual;
     function AddItem(Name: string): TItem; virtual;
+    procedure LoadFromNode(Node: TDOMNode); virtual;
+    procedure SaveToNode(Node: TDOMNode); virtual;
     constructor Create(FreeObjects: Boolean = True);
   end;
@@ -74 +88 @@
 end;
 
+procedure TItemList.LoadFromNode(Node: TDOMNode);
+var
+  Node2: TDOMNode;
+  NewItem: TItem;
+begin
+  Count := 0;
+  Node2 := Node.FirstChild;
+  while Assigned(Node2) and (Node2.NodeName = UnicodeString(GetItemClass.GetClassSysName)) do begin
+    NewItem := GetItemClass.Create;
+    NewItem.LoadFromNode(Node2);
+    Add(NewItem);
+    Node2 := Node2.NextSibling;
+  end;
+end;
+
+procedure TItemList.SaveToNode(Node: TDOMNode);
+var
+  I: Integer;
+  NewNode2: TDOMNode;
+begin
+  for I := 0 to Count - 1 do
+  with TItem(Items[I]) do begin
+    NewNode2 := Node.OwnerDocument.CreateElement(UnicodeString(GetItemClass.GetClassSysName));
+    Node.AppendChild(NewNode2);
+    SaveToNode(NewNode2);
+  end;
+end;
+
 constructor TItemList.Create(FreeObjects: Boolean);
 begin
@@ -80 +122 @@
 end;
 
-function TItemList.GetItemClass: TItemClass;
+class function TItemList.GetItemClass: TItemClass;
 begin
   Result := TItem;
@@ -133 +175 @@
 { TItemFields }
 
-function TItemFields.AddField(Name: string): TItemField;
+function TItemFields.AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
 begin
   Result := TItemField.Create;
+  Result.Index := Index;
   Result.Name := Name;
+  Result.SysName := SysName;
+  Result.DataType := DataType;
   Add(Result);
 end;
@@ -142 +187 @@
 { TItem }
 
+procedure TItem.AssignValue(Source: TItem; Field: TItemField);
+var
+  ValueString: string;
+  ValueColor: TColor;
+  ValueInteger: Integer;
+begin
+  if Field.DataType = dtString then begin
+    Source.GetValue(Field.Index, ValueString);
+    SetValue(Field.Index, ValueString);
+  end else
+  if Field.DataType = dtColor then begin
+    Source.GetValue(Field.Index, ValueColor);
+    SetValue(Field.Index, ValueColor);
+  end else
+  if Field.DataType = dtInteger then begin
+    Source.GetValue(Field.Index, ValueInteger);
+    SetValue(Field.Index, ValueInteger);
+  end else
+  raise Exception.Create('Unsupported field value data type');
+end;
+
+procedure TItem.LoadValueFromNode(Node: TDOMNode; Field: TItemField);
+var
+  ValueString: string;
+  ValueColor: TColor;
+  ValueInteger: Integer;
+begin
+  if Field.DataType = dtString then begin
+    ValueString := ReadString(Node, Field.SysName, '');
+    SetValue(Field.Index, ValueString);
+  end else
+  if Field.DataType = dtColor then begin
+    ValueColor := ReadInteger(Node, Field.SysName, 0);
+    SetValue(Field.Index, ValueColor);
+  end else
+  if Field.DataType = dtInteger then begin
+    ValueInteger := ReadInteger(Node, Field.SysName, 0);
+    SetValue(Field.Index, ValueInteger);
+  end else
+  raise Exception.Create('Unsupported field value data type');
+end;
+
+procedure TItem.SaveValueToNode(Node: TDOMNode; Field: TItemField);
+var
+  ValueString: string;
+  ValueColor: TColor;
+  ValueInteger: Integer;
+begin
+  if Field.DataType = dtString then begin
+    GetValue(Field.Index, ValueString);
+    WriteString(Node, Field.SysName, ValueString);
+  end else
+  if Field.DataType = dtColor then begin
+    GetValue(Field.Index, ValueColor);
+    WriteInteger(Node, Field.SysName, ValueColor);
+  end else
+  if Field.DataType = dtInteger then begin
+    GetValue(Field.Index, ValueInteger);
+    WriteInteger(Node, Field.SysName, ValueInteger);
+  end else
+  raise Exception.Create('Unsupported field value data type');
+end;
+
 function TItem.GetFields: TItemFields;
 begin
   Result := TItemFields.Create;
+  Result.AddField(1, 'Name', 'Name', dtString);
 end;
 
@@ -156 +265 @@
 
 procedure TItem.Assign(Source: TItem);
+var
+  I: Integer;
+  Fields: TItemFields;
 begin
   Id := Source.Id;
-  Name := Source.Name;
+  if Source is ClassType then begin
+    Fields := GetFields;
+    try
+      for I := 0 to Fields.Count - 1 do
+        AssignValue(Source, Fields[I]);
+    finally
+      Fields.Free;
+    end;
+  end;
 end;
 
 procedure TItem.LoadFromNode(Node: TDOMNode);
+var
+  Fields: TItemFields;
+  I: Integer;
 begin
   Id := ReadInteger(Node, 'Id', 0);
-  Name := ReadString(Node, 'Name', '');
+  Fields := GetFields;
+  try
+    for I := 0 to Fields.Count - 1 do begin
+      LoadValueFromNode(Node, Fields[I]);
+    end;
+  finally
+    Fields.Free;
+  end;
 end;
 
 procedure TItem.SaveToNode(Node: TDOMNode);
+var
+  Fields: TItemFields;
+  I: Integer;
 begin
   WriteInteger(Node, 'Id', Id);
-  WriteString(Node, 'Name', Name);
+  Fields := GetFields;
+  try
+    for I := 0 to Fields.Count - 1 do begin
+      SaveValueToNode(Node, Fields[I]);
+    end;
+  finally
+    Fields.Free;
+  end;
+end;
+
+class function TItem.GetClassSysName: string;
+begin
+  Result := 'Item';
 end;