Changeset 4 for trunk/UDatabase.pas

Timestamp:

Jan 18, 2015, 11:29:26 PM (10 years ago)

Author:

chronos

Message:

• Moved: Field and value data type declaration moved to separate unit.
• Modified: Fields edit form is now modal and made need changes need to be accepted.
• Added: 32x32 icons to actions.
• Fixed: If fileds count or type changed then table values are updated.

File:

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

trunk/UDatabase.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn;
+  Classes, SysUtils, Contnrs, ExtCtrls, StdCtrls, EditBtn, dialogs;
 
 type
   TTable = class;
 
-  TFieldType = (ftString, ftNumeric, ftDateTime, ftBoolean, ftFloat, ftImage,
+  TFieldType = (ftString, ftInteger, ftDateTime, ftBoolean, ftFloat, ftImage,
     ftDate, tfTime, ftMapPosition);
 
@@ -17 +17 @@
 
   TValue = class
+    procedure Assign(Source: TValue); virtual;
     function GetString: string; virtual;
   end;
@@ -22 +23 @@
   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 }
 
   TValues = class(TObjectList)
+    procedure Assign(Source: TValues);
   end;
 
@@ -46 +32 @@
 
   TFieldTypeSpecific = class
+    procedure Assign(Source: TFieldTypeSpecific); virtual;
     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 }
@@ -117 +55 @@
     Pos: TPoint;
     Size: TPoint;
+    procedure Assign(Source: TField);
     function GetValueClass: TValueClass;
     property FieldType: TFieldType read FFieldType write SetFieldType;
@@ -122 +61 @@
   end;
 
+  { TFields }
+
   TFields = class(TObjectList)
+    function FindByName(Name: string): TField;
+    procedure Assign(Source: TFields);
   end;
 
@@ -130 +73 @@
     Parent: TTable;
     Values: TValues;
+    procedure Assign(Source: TRecord);
     constructor Create;
     destructor Destroy; override;
   end;
 
+  { TRecords }
+
   TRecords = class(TObjectList)
     Parent: TTable;
+    procedure Assign(Source: TRecords);
   end;
 
@@ -142 +89 @@
   TTable = class
     Name: string;
+    Caption: string;
     Records: TRecords;
     Fields: TFields;
+    procedure Assign(Source: TTable);
     constructor Create;
     destructor Destroy; override;
@@ -166 +115 @@
   end;
 
-const
-  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);
+uses
+  UDataTypes;
+
+{ TValues }
+
+procedure TValues.Assign(Source: TValues);
+var
+  I: Integer;
+  OldCount: Integer;
+begin
+  OldCount := Count;
+  Count := Source.Count;
+  for I := OldCount to Count - 1 do
+    //ShowMessage(TValue(Source.Items[I]).ClassName);
+    Items[I] := TValueClass(TValue(Source.Items[I]).ClassType).Create;
+  for I := 0 to Count - 1 do
+    if TValue(Items[I]).ClassType <> TValue(Source.Items[I]).ClassType then begin
+      Items[I] := TValueClass(TValue(Source.Items[I]).ClassType).Create;
+    end;
+  for I := 0 to Source.Count - 1 do begin
+    TValue(Items[I]).Assign(TValue(Source.Items[I]));
+  end;
+end;
+
+{ TRecords }
+
+procedure TRecords.Assign(Source: TRecords);
+var
+  I: Integer;
+  OldCount: Integer;
+begin
+  OldCount := Count;
+  Count := Source.Count;
+  for I := OldCount to Count - 1 do
+    Items[I] := TRecord.Create;
+  for I := 0 to Source.Count - 1 do begin
+    TRecord(Items[I]).Assign(TRecord(Source.Items[I]));
+  end;
+end;
+
+{ TFields }
+
+function TFields.FindByName(Name: string): TField;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TField(Items[I]).Name <> Name) do Inc(I);
+  if I < Count then Result := TField(Items[I])
+    else Result := nil;
+end;
+
+procedure TFields.Assign(Source: TFields);
+var
+  I: Integer;
+  OldCount: Integer;
+begin
+  OldCount := Count;
+  Count := Source.Count;
+  for I := OldCount to Count - 1 do
+    Items[I] := TField.Create;
+  for I := 0 to Source.Count - 1 do begin
+    TField(Items[I]).Assign(TField(Source.Items[I]));
+  end;
 end;
 
 { TRecord }
+
+procedure TRecord.Assign(Source: TRecord);
+begin
+  Values.Assign(Source.Values);
+end;
 
 constructor TRecord.Create;
@@ -203 +202 @@
 end;
 
-{ TValueString }
-
-function TValueString.GetString: string;
-begin
-  Result := Value;
-end;
-
 { TValue }
 
+procedure TValue.Assign(Source: TValue);
+begin
+end;
+
 function TValue.GetString: string;
 begin
@@ -217 +213 @@
 end;
 
-{ TFieldString }
-
-function TFieldString.GetValueClass: TValueClass;
-begin
-  Result := TValueString;
-end;
-
 { TFieldTypeSpecific }
+
+procedure TFieldTypeSpecific.Assign(Source: TFieldTypeSpecific);
+begin
+
+end;
 
 function TFieldTypeSpecific.GetValueClass: TValueClass;
@@ -241 +235 @@
 end;
 
+procedure TField.Assign(Source: TField);
+begin
+  Name := Source.Name;
+  FieldType := Source.FieldType;
+  TextAfter := Source.TextAfter;
+  TextBefore := Source.TextBefore;
+  Required := Source.Required;
+  ReadOnly := Source.ReadOnly;
+  Description := Source.Description;
+  AllowNull := Source.AllowNull;
+  TypeRelated.Assign(Source.TypeRelated);
+end;
+
 function TField.GetValueClass: TValueClass;
 begin
@@ -252 +259 @@
 end;
 
-{ TField }
-
-
 { TTable }
+
+procedure TTable.Assign(Source: TTable);
+begin
+  Name := Source.Name;
+  Caption := Source.Caption;
+  Fields.Assign(Source.Fields);
+  Records.Assign(Source.Records);
+end;
 
 constructor TTable.Create;