Changeset 7 for trunk

Timestamp:

Jan 20, 2015, 11:33:39 PM (10 years ago)

Author:

chronos

Message:

• Fixed: XML database can be opened from file.

Location:

trunk

Files:

• DbEngines/UEngineMySQL.pas (modified) (1 diff)
• DbEngines/UEngineSQLite.pas (modified) (1 diff)
• DbEngines/UEngineXML.pas (modified) (6 diffs)
• Forms/UFormMain.lfm (modified) (1 diff)
• Forms/UFormMain.pas (modified) (2 diffs)
• UCore.lfm (modified) (1 diff)
• UCore.pas (modified) (2 diffs)
• UDatabase.pas (modified) (8 diffs)

trunk/DbEngines/UEngineMySQL.pas

@@ -9 +9 @@
 
 type
-  TDatabaseMySQL = class(TDatabase)
+  TDatabaseMySQL = class(TDatabaseClient)
 
   end;

trunk/DbEngines/UEngineSQLite.pas

@@ -9 +9 @@
 
 type
-  TDatabaseSQLite = class(TDatabase)
+  TDatabaseSQLite = class(TDatabaseClient)
 
   end;

trunk/DbEngines/UEngineXML.pas

@@ -11 +11 @@
   { TDatabaseXML }
 
-  TDatabaseXML = class(TDatabase)
+  TDatabaseXML = class(TDatabaseClient)
   private
     function GetFileName: string;
@@ -47 +47 @@
 function TDatabaseXML.GetFileName: string;
 begin
-  if Copy(ConnectionString, 1, 8) = 'file:///' then
-    Result := Copy(ConnectionString, 8, High(Integer))
+  if Copy(Database.ConnectionString, 1, 8) = 'file:///' then
+    Result := Copy(Database.ConnectionString, 8, High(Integer))
     else Result := '';
 end;
@@ -238 +238 @@
       NewNode := FindNode('Tables');
       if Assigned(NewNode) then
-        LoadNodeTables(Tables, NewNode);
+        LoadNodeTables(Database.Tables, NewNode);
     end;
   finally
@@ -259 +259 @@
       NewNode := OwnerDocument.CreateElement('Tables');
       AppendChild(NewNode);
-      SaveNodeTables(Tables, NewNode);
+      SaveNodeTables(Database.Tables, NewNode);
     end;
     ForceDirectoriesUTF8(ExtractFileDir(FileName));
@@ -270 +270 @@
 procedure TDatabaseXML.Load;
 begin
-  inherited Load;
   if FileExists(FileName) then
     LoadFromFile(FileName);
@@ -277 +276 @@
 procedure TDatabaseXML.Save;
 begin
-  inherited Save;
   SaveToFile(FileName);
 end;

trunk/Forms/UFormMain.lfm

@@ -5 +5 @@
   Width = 1250
   Caption = 'MyData'
+  ClientHeight = 820
+  ClientWidth = 1250
+  Menu = MainMenu1
   OnActivate = FormActivate
   OnClose = FormClose
   OnShow = FormShow
   LCLVersion = '1.3'
+  object StatusBar1: TStatusBar
+    Left = 0
+    Height = 29
+    Top = 791
+    Width = 1250
+    Panels = <>
+  end
+  object MainMenu1: TMainMenu
+    Images = Core.ImageList1
+    left = 870
+    top = 200
+    object MenuItem1: TMenuItem
+      Caption = 'Database'
+      object MenuItem2: TMenuItem
+        Caption = 'Connect'
+      end
+      object MenuItem4: TMenuItem
+        Caption = 'Disconnect'
+      end
+      object MenuItem5: TMenuItem
+        Caption = '-'
+      end
+      object MenuItem6: TMenuItem
+        Action = Core.AExit
+      end
+    end
+    object MenuItemPreferences: TMenuItem
+      Caption = 'Tools'
+      object MenuItem3: TMenuItem
+        Action = Core.APreferences
+      end
+    end
+  end
 end

trunk/Forms/UFormMain.pas

@@ -6 +6 @@
 
 uses
-  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;
+  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
+  ComCtrls;
 
 type
@@ -13 +14 @@
 
   TFormMain = class(TForm)
+    MainMenu1: TMainMenu;
+    MenuItem1: TMenuItem;
+    MenuItem2: TMenuItem;
+    MenuItem3: TMenuItem;
+    MenuItem4: TMenuItem;
+    MenuItem5: TMenuItem;
+    MenuItem6: TMenuItem;
+    MenuItemPreferences: TMenuItem;
+    StatusBar1: TStatusBar;
     procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);

trunk/UCore.lfm

@@ -1184 +1184 @@
       OnExecute = AExitExecute
     end
+    object APreferences: TAction
+      Caption = 'Preferences'
+    end
   end
 end

trunk/UCore.pas

@@ -13 +13 @@
 
   TCore = class(TDataModule)
+    APreferences: TAction;
     AExit: TAction;
     ActionList1: TActionList;
@@ -99 +100 @@
   I: Integer;
   NewDatabase: TDatabase;
+  Engine: TDatabaseEngine;
 begin
   Databases.Count := XMLConfig1.GetValue('Database/Count', 0);
   for I := 0 to Databases.Count - 1 do begin
+    Engine := Core.Engines.FindByName(XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/Engine', ''));
+
     NewDatabase := TDatabase.Create;
+    NewDatabase.Engine := Engine;
     NewDatabase.Name := XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/Name', '');
     NewDatabase.ConnectionString := XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/ConnectionString', '');
-    NewDatabase.Engine := Core.Engines.FindByName(XMLConfig1.GetValue('Database/Item' + IntToStr(I) + '/Engine', ''));
     Databases[I] := NewDatabase;
   end;

trunk/UDatabase.pas

@@ -11 +11 @@
   TTable = class;
   TDatabaseEngine = class;
+  TDatabaseClient = class;
 
   TFieldType = (ftString, ftInteger, ftDateTime, ftBoolean, ftFloat, ftImage,
@@ -107 +108 @@
 
   TDatabase = class
+  private
+    FEngine: TDatabaseEngine;
+    procedure SetEngine(AValue: TDatabaseEngine);
+  public
     Name: string;
     Tables: TTables;
     ConnectionString: string;
-    Engine: TDatabaseEngine;
+    Client: TDatabaseClient;
     constructor Create;
     destructor Destroy; override;
     procedure Load; virtual;
     procedure Save; virtual;
+    property Engine: TDatabaseEngine read FEngine write SetEngine;
   end;
 
@@ -134 +140 @@
   end;
 
+  { TDatabaseClient }
+
+  TDatabaseClient = class
+    Database: TDatabase;
+    procedure Load; virtual;
+    procedure Save; virtual;
+  end;
+
+  TDatabaseClientClass = class of TDatabaseClient;
+
   { TDatabaseEngine }
 
@@ -139 +155 @@
     Name: string;
     DataTypes: TDataTypes;
-    DatabaseClass: TDatabaseClass;
+    DatabaseClientClass: TDatabaseClientClass;
     constructor Create;
     destructor Destroy; override;
@@ -147 +163 @@
 
   TDatabaseEngines = class(TObjectList)
-    function RegisterEngine(Name: string; DatabaseClass: TDatabaseClass): TDatabaseEngine;
+    function RegisterEngine(Name: string; DatabaseClass: TDatabaseClientClass): TDatabaseEngine;
     function FindByName(Name: string): TDatabaseEngine;
   end;
@@ -157 +173 @@
   UDataTypes;
 
+{ TDatabaseClient }
+
+procedure TDatabaseClient.Load;
+begin
+
+end;
+
+procedure TDatabaseClient.Save;
+begin
+
+end;
+
 { TDatabaseEngines }
 
 function TDatabaseEngines.RegisterEngine(Name: string;
-  DatabaseClass: TDatabaseClass): TDatabaseEngine;
+  DatabaseClass: TDatabaseClientClass): TDatabaseEngine;
 begin
   Result := TDatabaseEngine.Create;
   Result.Name := Name;
-  Result.DatabaseClass := DatabaseClass;
+  Result.DatabaseClientClass := DatabaseClass;
   Add(Result);
 end;
@@ -365 +393 @@
 { TDatabase }
 
+procedure TDatabase.SetEngine(AValue: TDatabaseEngine);
+begin
+  if FEngine = AValue then Exit;
+  if Assigned(Client) then
+    Client.Free;
+  FEngine := AValue;
+  if Assigned(FEngine) then begin
+    Client := Engine.DatabaseClientClass.Create;
+    Client.Database := Self;
+  end;
+end;
+
 constructor TDatabase.Create;
 begin
   Tables := TTables.Create;
+  Engine := nil;
 end;
 
@@ -378 +419 @@
 procedure TDatabase.Load;
 begin
-
+  if Assigned(Client) then Client.Load;
 end;
 
 procedure TDatabase.Save;
 begin
-
+  if Assigned(Client) then Client.Save;
 end;