source: branches/xpascal/SourceNode.pas

unit SourceNode;

interface

uses
  Classes, SysUtils, Generics.Collections;

type
  TDataType = (dtNone, dtString, dtBoolean, dtInteger, dtFloat, dtColor,
    dtTime, dtDate, dtDateTime, dtEnumeration, dtObject, dtList);

  { TField }

  TField = class
    Index: Integer;
    DataType: TDataType;
    Name: string;
    constructor Create(ADataType: TDataType; AName: string);
  end;

  TFields = class(TObjectList<TField>)
  end;

  { TSourceNode }

  TSourceNode = class
  protected
    function GetFieldsCount: Integer; virtual;
  public
    Parent: TSourceNode;
    function GetField(Index: Integer): TField; virtual;
    procedure GetValue(Index: Integer; out Value); virtual;
    function GetValueInteger(Index: Integer): Integer;
    function GetValueString(Index: Integer): string;
    function GetValueBoolean(Index: Integer): Boolean;
    function GetValueObject(Index: Integer): TObject;
    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 SetValueBoolean(Index: Integer; Value: Boolean);
    procedure SetValueObject(Index: Integer; Value: TObject);
    function GetFields: TFields;
    property FieldsCount: Integer read GetFieldsCount;
  end;

  { TSourceNodeList }

  TSourceNodeList<T: TSourceNode> = class(TObjectList<T>)
  private
    Parent: TSourceNode;
  end;


implementation

resourcestring
  SUnsupportedValueIndex = 'Unsupported value index %d';
  SUnsupportedDataType = 'Unsupported field value data type %s';
  SYes = 'Yes';
  SNo = 'No';

const
  DataTypeStr: array[TDataType] of string = ('None', 'String', 'Boolean',
    'Integer', 'Float', 'Color', 'Time', 'Date', 'DateTime', 'Enumeration',
    'Reference', 'List');

{ TField }

constructor TField.Create(ADataType: TDataType; AName: string);
begin
  DataType := ADataType;
  Name := AName;
end;

{ TSourceNode }

procedure TSourceNode.GetValue(Index: Integer; out Value);
begin
  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
end;

function TSourceNode.GetFieldsCount: Integer;
begin
  Result := 0;
end;

function TSourceNode.GetField(Index: Integer): TField;
begin
  Result := nil;
  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
end;

procedure TSourceNode.SetValue(Index: Integer; var Value);
begin
  raise Exception.Create(Format(SUnsupportedValueIndex, [Index]));
end;

function TSourceNode.GetValueInteger(Index: Integer): Integer;
begin
  GetValue(Index, Result);
end;

function TSourceNode.GetValueString(Index: Integer): string;
begin
  GetValue(Index, Result);
end;

function TSourceNode.GetValueBoolean(Index: Integer): Boolean;
begin
  GetValue(Index, Result);
end;

function TSourceNode.GetValueObject(Index: Integer): TObject;
begin
  GetValue(Index, Result);
end;

function TSourceNode.GetValueAsText(Index: Integer): string;
var
  Field: TField;
  Item: TObject;
begin
  Field := GetField(Index);
  try
    if Field.DataType = dtInteger then Result := IntToStr(GetValueInteger(Index))
    else if Field.DataType = dtString then Result := GetValueString(Index)
    //else if Field.DataType = dtEnumeration then Result := Field.EnumStates[Integer(GetValueEnumeration(Index))]
    else if Field.DataType = dtObject then begin
      Item := TObject(GetValueObject(Index));
      if Assigned(Item) then Result := Item.ClassName
        else Result := '';
    end else if Field.DataType = dtBoolean then begin
      if GetValueBoolean(Index) then Result := SYes else Result := SNo;
    end else
      raise Exception.Create(Format(SUnsupportedDataType, [DataTypeStr[Field.DataType]]));
  finally
    Field.Free;
  end;
end;

procedure TSourceNode.SetValueInteger(Index: Integer; Value: Integer);
begin
  SetValue(Index, Value);
end;

procedure TSourceNode.SetValueString(Index: Integer; Value: string);
begin
  SetValue(Index, Value);
end;

procedure TSourceNode.SetValueBoolean(Index: Integer; Value: Boolean);
begin
  SetValue(Index, Value);
end;

procedure TSourceNode.SetValueObject(Index: Integer; Value: TObject);
begin
  SetValue(Index, Value);
end;

function TSourceNode.GetFields: TFields;
var
  I: Integer;
begin
  Result := TFields.Create;
  for I := 0 to GetFieldsCount - 1 do
    Result.Add(GetField(I));
end;


end.