Changeset 290 for trunk/UItemList.pas

Timestamp:

Mar 25, 2019, 12:51:41 AM (6 years ago)

Author:

chronos

Message:

• Modified: List and item forms for BuildingKind and Nation converted to generic forms.

File:

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

trunk/UItemList.pas

@@ -11 +11 @@
   TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
     dtTime, dtDate, dtDateTime);
+
+  { TItemField }
 
   TItemField = class
@@ -19 +21 @@
     Position: TPoint;
     Size: TPoint;
+    procedure Assign(Source: TItemField);
   end;
 
@@ -25 +28 @@
   TItemFields = class(TFPGObjectList<TItemField>)
     function AddField(Index: Integer; SysName, Name: string; DataType: TDataType): TItemField;
+    function SearchByIndex(Index: Integer): TItemField;
   end;
 
@@ -37 +41 @@
     Id: Integer;
     Name: string;
-    function GetFields: TItemFields; virtual;
+    class function GetFields: TItemFields; virtual;
+    function GetField(Index: Integer): TItemField;
     procedure GetValue(Index: Integer; out Value); virtual;
+    function GetValueInteger(Index: Integer): Integer;
+    function GetValueString(Index: Integer): string;
+    function GetValueColor(Index: Integer): TColor;
+    function GetValueBoolean(Index: Integer): Boolean;
+    function GetValueAsText(Index: Integer): string;
     procedure SetValue(Index: Integer; var Value); virtual;
+    procedure SetValueInteger(Index: Integer; Value: Integer);
+    procedure SetValueString(Index: Integer; Value: string);
+    procedure SetValueColor(Index: Integer; Value: TColor);
+    procedure SetValueBoolean(Index: Integer; Value: Boolean);
     procedure Assign(Source: TItem); virtual;
     procedure LoadFromNode(Node: TDOMNode); virtual;
     procedure SaveToNode(Node: TDOMNode); virtual;
     class function GetClassSysName: string; virtual;
+    class function GetClassName: string; virtual;
   end;
 
@@ -68 +83 @@
 implementation
 
+resourcestring
+  SYes = 'Yes';
+  SNo = 'No';
+  SItem = 'Item';
+  SName = 'Name';
+
+{ TItemField }
+
+procedure TItemField.Assign(Source: TItemField);
+begin
+  SysName := Source.SysName;
+  Name := Source.Name;
+  Index := Source.Index;
+  DataType := Source.DataType;
+  Position := Source.Position;
+  Size := Source.Size;
+end;
+
 { TItemList }
 
@@ -185 +218 @@
 end;
 
+function TItemFields.SearchByIndex(Index: Integer): TItemField;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (Items[I].Index <> Index) do Inc(I);
+  if I < Count then Result := Items[I]
+    else Result := nil;
+end;
+
 { TItem }
 
@@ -192 +235 @@
   ValueColor: TColor;
   ValueInteger: Integer;
+  ValueBoolean: Boolean;
 begin
   if Field.DataType = dtString then begin
@@ -205 +249 @@
     SetValue(Field.Index, ValueInteger);
   end else
+  if Field.DataType = dtBoolean then begin
+    Source.GetValue(Field.Index, ValueBoolean);
+    SetValue(Field.Index, ValueBoolean);
+  end else
   raise Exception.Create('Unsupported field value data type');
 end;
@@ -250 +298 @@
 end;
 
-function TItem.GetFields: TItemFields;
+class function TItem.GetFields: TItemFields;
 begin
   Result := TItemFields.Create;
-  Result.AddField(1, 'Name', 'Name', dtString);
+  Result.AddField(1, 'Name', SName, dtString);
+end;
+
+function TItem.GetField(Index: Integer): TItemField;
+var
+  Fields: TItemFields;
+begin
+  Result := TItemField.Create;
+  Fields := GetFields;
+  try
+    Result.Assign(Fields[Index]);
+  finally
+    Fields.Free;
+  end;
 end;
 
@@ -260 +321 @@
 end;
 
+function TItem.GetValueString(Index: Integer): string;
+begin
+  GetValue(Index, Result);
+end;
+
+function TItem.GetValueInteger(Index: Integer): Integer;
+begin
+  GetValue(Index, Result);
+end;
+
+function TItem.GetValueColor(Index: Integer): TColor;
+begin
+  GetValue(Index, Result);
+end;
+
+function TItem.GetValueBoolean(Index: Integer): Boolean;
+begin
+  GetValue(Index, Result);
+end;
+
+function TItem.GetValueAsText(Index: Integer): string;
+var
+  Fields: TItemFields;
+  ItemField: TItemField;
+begin
+  Fields := GetFields;
+  ItemField := GetField(Fields.IndexOf(Fields.SearchByIndex(Index)));
+  if ItemField.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index))
+  else if ItemField.DataType = dtString then Result := GetValueString(Index)
+  else if ItemField.DataType = dtColor then Result := ''
+  else if ItemField.DataType = dtBoolean then begin
+    if GetValueBoolean(Index) then Result := SYes else Result := SNo;
+  end;
+  ItemField.Free;
+  Fields.Free;
+end;
+
 procedure TItem.SetValue(Index: Integer; var Value);
 begin
+end;
+
+procedure TItem.SetValueInteger(Index: Integer; Value: Integer);
+begin
+  SetValue(Index, Value);
+end;
+
+procedure TItem.SetValueString(Index: Integer; Value: string);
+begin
+  SetValue(Index, Value);
+end;
+
+procedure TItem.SetValueColor(Index: Integer; Value: TColor);
+begin
+  SetValue(Index, Value);
+end;
+
+procedure TItem.SetValueBoolean(Index: Integer; Value: Boolean);
+begin
+  SetValue(Index, Value);
 end;
 
@@ -318 +436 @@
 end;
 
+class function TItem.GetClassName: string;
+begin
+  Result := SItem;
+end;
+
 end.