Changeset 3 for trunk/UDatabase.pas

Timestamp:

Jan 18, 2015, 5:25:37 PM (9 years ago)

Author:

chronos

Message:

• Added: Support for editing String and DateTime value types in record edit form.

Location:

trunk

Files:

• . (modified) (1 prop)
• UDatabase.pas (modified) (5 diffs)

trunk

@@ -3 +3 @@
 MyData.lps
 data.xml
+Config.xml

@@ -3 +3 @@
 MyData.lps
 data.xml
+Config.xml

trunk/UDatabase.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs;
+  Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn;
 
 type
+  TTable = class;
+
   TFieldType = (ftString, ftNumeric, ftDateTime, ftBoolean, ftFloat, ftImage,
     ftDate, tfTime, ftMapPosition);
 
+  { TValue }
+
+  TValue = class
+    function GetString: string; virtual;
+  end;
+
+  TValueClass = class of TValue;
+
+  { TValueString }
+
+  TValueString = class(TValue)
+    Value: string;
+    function GetString: string; override;
+  end;
+
+  TValueInteger = class(TValue)
+    Value: Integer;
+  end;
+
+  { TValueDateTime }
+
+  TValueDateTime = class(TValue)
+    Value: TDateTime;
+    function GetString: string; override;
+  end;
+
+  TValues = class(TObjectList)
+  end;
+
+  { TFieldTypeSpecific }
+
+  TFieldTypeSpecific = class
+    function GetValueClass: TValueClass; virtual;
+  end;
+
+  TFieldTypeSpecificClass = class of TFieldTypeSpecific;
+
+  { TFieldString }
+
+  TFieldString = class(TFieldTypeSpecific)
+    DefaultValue: string;
+    function GetValueClass: TValueClass; override;
+  end;
+
+  TFieldInteger = class(TFieldTypeSpecific)
+    Min: Integer;
+    Max: Integer;
+    DefaultValue: Integer;
+  end;
+
+  TFieldFloat = class(TFieldTypeSpecific)
+    Min: Double;
+    Max: Double;
+    DefaultValue: Double;
+  end;
+
+  { TFieldDateTime }
+
+  TFieldDateTime = class(TFieldTypeSpecific)
+    Min: TDateTime;
+    Max: TDateTime;
+    function GetValueClass: TValueClass; override;
+  end;
+
+  TFieldDate = class(TFieldTypeSpecific)
+    Min: TDate;
+    Max: TDate;
+  end;
+
+   TFieldTime = class(TFieldTypeSpecific)
+    Min: TTime;
+    Max: TTime;
+  end;
+
+  TFieldImage = class(TFieldTypeSpecific)
+    MinSize: TPoint;
+    MaxSize: TPoint;
+  end;
+
+  TFieldBoolean = class(TFieldTypeSpecific)
+    DefaultValue: Boolean;
+  end;
+
+  TFieldMapPosition = class(TFieldTypeSpecific)
+  end;
+
   { TField }
 
   TField = class
+  private
+    FFieldType: TFieldType;
+    procedure SetFieldType(AValue: TFieldType);
+  public
     Name: string;
-    FieldType: TFieldType;
+    TypeRelated: TFieldTypeSpecific;
     Required: Boolean;
     ReadOnly: Boolean;
@@ -25 +117 @@
     Pos: TPoint;
     Size: TPoint;
-  end;
-
-  TFieldString = class(TField)
-    DefaultValue: string;
-  end;
-
-  TFieldInteger = class(TField)
-    Min: Integer;
-    Max: Integer;
-    DefaultValue: Integer;
-  end;
-
-  TFieldDateTime = class(TField)
-    Min: TDateTime;
-    Max: TDateTime;
-  end;
-
-  TFieldImage = class(TField)
+    function GetValueClass: TValueClass;
+    property FieldType: TFieldType read FFieldType write SetFieldType;
+    constructor Create;
   end;
 
@@ -48 +125 @@
   end;
 
-  TValue = class
-  end;
-
-  TValueString = class
-    Value: string;
-  end;
-
-  TValueInteger = class
-    Value: Integer;
-  end;
-
-  TValueDateTime = class
-    Value: TDateTime;
-  end;
-
-  TValues = class(TObjectList)
-  end;
+  { TRecord }
 
   TRecord = class
+    Parent: TTable;
     Values: TValues;
+    constructor Create;
+    destructor Destroy; override;
   end;
 
   TRecords = class(TObjectList)
-
+    Parent: TTable;
   end;
 
@@ -105 +169 @@
   FieldTypeString: array[TFieldType] of string = ('String', 'Numeric', 'DateTime',
     'Boolean', 'Float', 'Image', 'Date', 'Time', 'MapPosition');
+  FieldTypeClass: array[TFieldType] of TFieldTypeSpecificClass = (TFieldString,
+    TFieldInteger, TFieldDateTime, TFieldBoolean, TFieldFloat, TFieldImage,
+    TFieldDate, TFieldTime, TFieldMapPosition);
 
 
 implementation
 
+{ TFieldDateTime }
+
+function TFieldDateTime.GetValueClass: TValueClass;
+begin
+  Result := TValueDateTime;
+end;
+
+{ TValueDateTime }
+
+function TValueDateTime.GetString: string;
+begin
+  Result := DateTimeToStr(Value);
+end;
+
+{ TRecord }
+
+constructor TRecord.Create;
+begin
+  Values := TValues.Create;
+end;
+
+destructor TRecord.Destroy;
+begin
+  Values.Free;
+  inherited Destroy;
+end;
+
+{ TValueString }
+
+function TValueString.GetString: string;
+begin
+  Result := Value;
+end;
+
+{ TValue }
+
+function TValue.GetString: string;
+begin
+  Result := '';
+end;
+
+{ TFieldString }
+
+function TFieldString.GetValueClass: TValueClass;
+begin
+  Result := TValueString;
+end;
+
+{ TFieldTypeSpecific }
+
+function TFieldTypeSpecific.GetValueClass: TValueClass;
+begin
+  Result := TValue;
+end;
+
 { TField }
 
+procedure TField.SetFieldType(AValue: TFieldType);
+begin
+  if FFieldType = AValue then Exit;
+  if Assigned(TypeRelated) then TypeRelated.Free;
+  FFieldType := AValue;
+  TypeRelated := FieldTypeClass[FFieldType].Create;
+end;
+
+function TField.GetValueClass: TValueClass;
+begin
+  if Assigned(TypeRelated) then Result := TypeRelated.GetValueClass
+    else Result := TValue;
+end;
+
+constructor TField.Create;
+begin
+  TypeRelated := TFieldString.Create;
+end;
+
+{ TField }
+
 
 { TTable }
@@ -117 +260 @@
 begin
   Records := TRecords.Create;
+  Records.Parent := Self;
   Fields := TFields.Create;
 end;

@@ -3 +3 @@
 MyData.lps
 data.xml
+Config.xml