Changeset 8 for trunk/UDatabase.pas

Timestamp:

Jan 23, 2015, 12:00:37 AM (10 years ago)

Author:

chronos

Message:

• Modified: All data types have own table which is used to specify supported data types by database engines.

File:

• trunk/UDatabase.pas (modified) (14 diffs)

trunk/UDatabase.pas

@@ -12 +12 @@
   TDatabaseEngine = class;
   TDatabaseClient = class;
+  TDatabase = class;
+  TDataType = class;
 
   TFieldType = (ftString, ftInteger, ftDateTime, ftBoolean, ftFloat, ftImage,
-    ftDate, tfTime, ftMapPosition);
+    ftDate, ftTime, ftMapPosition);
 
   { TValue }
@@ -44 +46 @@
   TField = class
   private
-    FFieldType: TFieldType;
-    procedure SetFieldType(AValue: TFieldType);
+    FDataType: TDataType;
+    procedure SetDataType(AValue: TDataType);
   public
     Name: string;
@@ -57 +59 @@
     Pos: TPoint;
     Size: TPoint;
+    Table: TTable;
     procedure Assign(Source: TField);
     function GetValueClass: TValueClass;
-    property FieldType: TFieldType read FFieldType write SetFieldType;
+    property DataType: TDataType read FDataType write SetDataType;
     constructor Create;
   end;
@@ -66 +69 @@
 
   TFields = class(TObjectList)
+    Table: TTable;
     function FindByName(Name: string): TField;
     procedure Assign(Source: TFields);
@@ -94 +98 @@
     Records: TRecords;
     Fields: TFields;
+    Database: TDatabase;
     procedure Assign(Source: TTable);
     constructor Create;
@@ -100 +105 @@
 
   TTables = class(TObjectList)
-
+    Database: TDatabase;
   end;
 
@@ -134 +139 @@
     Name: string;
     FieldType: TFieldType;
-  end;
+    FieldTypeClass: TFieldTypeSpecificClass;
+  end;
+
+  { TDataTypes }
 
   TDataTypes = class(TObjectList)
-    function RegisterType(Name: string; FieldType: TFieldType): TDataType;
+    function RegisterType(Name: string; FieldType: TFieldType; FieldTypeClass: TFieldTypeSpecificClass): TDataType;
+    function FindByType(FieldType: TFieldType): TDataType;
   end;
 
@@ -150 +159 @@
   TDatabaseClientClass = class of TDatabaseClient;
 
+  TFieldTypeSet = set of TFieldType;
+
   { TDatabaseEngine }
 
@@ -156 +167 @@
     DataTypes: TDataTypes;
     DatabaseClientClass: TDatabaseClientClass;
+    procedure UseTypes(ADataTypes: TDataTypes; Types: TFieldTypeSet);
     constructor Create;
     destructor Destroy; override;
@@ -208 +220 @@
 { TDataTypes }
 
-function TDataTypes.RegisterType(Name: string; FieldType: TFieldType): TDataType;
+function TDataTypes.RegisterType(Name: string; FieldType: TFieldType;
+  FieldTypeClass: TFieldTypeSpecificClass): TDataType;
 begin
   Result := TDataType.Create;
   Result.Name := Name;
   Result.FieldType := FieldType;
+  Result.FieldTypeClass := FieldTypeClass;
   Add(Result);
 end;
 
+function TDataTypes.FindByType(FieldType: TFieldType): TDataType;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TDataType(Items[I]).FieldType <> FieldType) do Inc(I);
+  if I < Count then Result := TDataType(Items[I])
+    else Result := nil;
+end;
+
 { TDatabaseEngine }
 
+procedure TDatabaseEngine.UseTypes(ADataTypes: TDataTypes; Types: TFieldTypeSet);
+var
+  I: TFieldType;
+begin
+  DataTypes.Clear;
+  for I := Low(TFieldType) to High(TFieldType) do
+    if I in Types then DataTypes.Add(ADataTypes.FindByType(I));
+end;
+
 constructor TDatabaseEngine.Create;
 begin
   DataTypes := TDataTypes.Create;
+  DataTypes.OwnsObjects := False;
 end;
 
@@ -335 +369 @@
 { TField }
 
-procedure TField.SetFieldType(AValue: TFieldType);
-begin
-  if FFieldType = AValue then Exit;
+procedure TField.SetDataType(AValue: TDataType);
+begin
+  if FDataType = AValue then Exit;
   if Assigned(TypeRelated) then TypeRelated.Free;
-  FFieldType := AValue;
-  TypeRelated := FieldTypeClass[FFieldType].Create;
+  FDataType := AValue;
+  if Assigned(AValue) then
+    TypeRelated := AValue.FieldTypeClass.Create
+    else TypeRelated := nil;
 end;
 
@@ -346 +382 @@
 begin
   Name := Source.Name;
-  FieldType := Source.FieldType;
+  DataType := Source.DataType;
   TextAfter := Source.TextAfter;
   TextBefore := Source.TextBefore;
@@ -382 +418 @@
   Records.Parent := Self;
   Fields := TFields.Create;
+  Fields.Table := Self;
 end;
 
@@ -408 +445 @@
 begin
   Tables := TTables.Create;
+  Tables.Database := Self;
   Engine := nil;
 end;