Thread: [Instantobjects-cvscommit] SF.net SVN: instantobjects:[805] trunk/Source

SourceForge Headquarters 225 Broadway Suite 1600 San Diego, CA 92101 +1 (858) 454-5900

Revision: 805
          http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=805&view=rev
Author:   wp2udk
Date:     2009-07-08 06:55:49 +0000 (Wed, 08 Jul 2009)

Log Message:
-----------
Import a model from an existing .res or .xml file and generate the equivalent Delphi source code. Only tested on Delphi 2006.

Modified Paths:
--------------
    trunk/Source/Core/InstantCode.pas
    trunk/Source/Design/D2006/DclIOCore.dpk
    trunk/Source/Design/InstantModelExplorer.dfm
    trunk/Source/Design/InstantModelExplorer.pas
    trunk/Source/Design/iodesimages.res

Modified: trunk/Source/Core/InstantCode.pas
===================================================================

--- trunk/Source/Core/InstantCode.pas	2009-07-08 06:34:35 UTC (rev 804)
+++ trunk/Source/Core/InstantCode.pas	2009-07-08 06:55:49 UTC (rev 805)
@@ -962,6 +962,19 @@
     property UnitName: string read GetUnitName write SetUnitName;
   end;
 
+  TInstantCodeClassList = class(TList)
+  private
+    function GetItem(Index: Integer): TInstantCodeClass;
+    procedure SetItem(Index: Integer; const Value: TInstantCodeClass);
+  public
+    function Add(Item: TInstantCodeClass): Integer;
+    procedure Insert(Index: Integer; Item: TInstantCodeClass);
+
+    procedure SortByBaseClass;
+
+    property Items[Index: Integer]: TInstantCodeClass read GetItem write SetItem; default;
+  end;
+
   TInstantCodeClassRef = class(TInstantCodeType)
   protected
     class function InternalAtInstance(Reader: TInstantCodeReader; out Name: string): Boolean; override;
@@ -5461,6 +5474,55 @@
     (TInstantCodeMember(Sender).Visibility in Visibilities)
 end;
 
+{ TInstantCodeClassList }
+
+function CompareCodeClasses(Item1, Item2: Pointer): Integer;
+var
+  CodeClass1, CodeClass2: TInstantCodeClass;
+begin
+  CodeClass1 := Item1;
+  CodeClass2 := Item2;
+
+  if (CodeClass1.BaseClass = nil) and (CodeClass2.BaseClass <> nil) then
+    Result := -1 else
+  if (CodeClass2.BaseClass = nil) and (CodeClass1.BaseClass <> nil) then
+    Result := 1 else
+  if CodeClass1.BaseClass = CodeClass2.BaseClass then
+    Result := 0 else
+  if CodeClass1.DerivesFrom(CodeClass2) then
+    Result := 1 else
+  if CodeClass2.DerivesFrom(CodeClass1) then
+    Result := -1 else
+    // CodeClass1.BaseClass <> CodeClass2.BaseClass
+    Result := CompareCodeClasses(CodeClass1.BaseClass, CodeClass2.BaseClass);
+end;
+
+function TInstantCodeClassList.Add(Item: TInstantCodeClass): Integer;
+begin
+  Result := inherited Add(Item);
+end;
+
+procedure TInstantCodeClassList.Insert(Index: Integer; Item: TInstantCodeClass);
+begin
+  inherited Insert(Index, Item);
+end;
+
+procedure TInstantCodeClassList.SortByBaseClass;
+begin
+  Sort(CompareCodeClasses);
+end;
+
+function TInstantCodeClassList.GetItem(Index: Integer): TInstantCodeClass;
+begin
+  Result := inherited Items[Index];
+end;
+
+procedure TInstantCodeClassList.SetItem(Index: Integer;
+  const Value: TInstantCodeClass);
+begin
+  inherited Items[Index] := Value;
+end;
+
 { TInstantCodeClassRef }
 
 class function TInstantCodeClassRef.Identifier: string;

Modified: trunk/Source/Design/D2006/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D2006/DclIOCore.dpk	2009-07-08 06:34:35 UTC (rev 804)
+++ trunk/Source/Design/D2006/DclIOCore.dpk	2009-07-08 06:55:49 UTC (rev 805)
@@ -7,7 +7,6 @@
 {$R '..\..\Core\InstantConnectionManager.dcr'}
 {$R '..\..\Core\InstantPump.dcr'}
 {$R '..\..\Core\InstantDBEvolution.dcr'}
-
 {$ALIGN 8}
 {$ASSERTIONS ON}
 {$BOOLEVAL OFF}
@@ -58,7 +57,8 @@
   InstantReg in '..\InstantReg.pas',
   InstantUnitSelect in '..\InstantUnitSelect.pas' {InstantUnitSelectForm},
   InstantAttributeEditor in '..\InstantAttributeEditor.pas' {InstantAttributeEditorForm},
-  InstantAbout in '..\InstantAbout.pas' {InstantAboutForm};
+  InstantAbout in '..\InstantAbout.pas' {InstantAboutForm},
+  InstantModelImport in '..\InstantModelImport.pas' {InstantImportModelForm};
 
 end.
 

Modified: trunk/Source/Design/InstantModelExplorer.dfm
===================================================================
--- trunk/Source/Design/InstantModelExplorer.dfm	2009-07-08 06:34:35 UTC (rev 804)
+++ trunk/Source/Design/InstantModelExplorer.dfm	2009-07-08 06:55:49 UTC (rev 805)
@@ -4,7 +4,6 @@
   Width = 259
   Height = 433
   VertScrollBar.Range = 20
-  AutoScroll = False
   Caption = 'InstantObjects Model Explorer'
   Color = clBtnFace
   Font.Charset = DEFAULT_CHARSET
@@ -23,7 +22,7 @@
     Left = 0
     Top = 27
     Width = 251
-    Height = 379
+    Height = 372
     Align = alClient
     BevelOuter = bvNone
     TabOrder = 0
@@ -35,8 +34,6 @@
     Height = 27
     BorderWidth = 1
     ButtonHeight = 23
-    EdgeBorders = []
-    Flat = True
     Images = ActionImages
     ParentShowHint = False
     ShowHint = True
@@ -104,6 +101,9 @@
     object N3: TMenuItem
       Caption = '-'
     end
+    object ImportModelItem: TMenuItem
+      Action = ImportModelAction
+    end
     object ExportModelItem: TMenuItem
       Action = ExportModelAction
     end
@@ -189,6 +189,12 @@
       Hint = 'Collapse All'
       OnExecute = CollapseAllActionExecute
     end
+    object ImportModelAction: TAction
+      Caption = '&Import Model...'
+      Hint = 'Import model'
+      ImageIndex = 11
+      OnExecute = ImportModelActionExecute
+    end
     object ExportModelAction: TAction
       Caption = '&Export Model...'
       Hint = 'Export Model'

Modified: trunk/Source/Design/InstantModelExplorer.pas
===================================================================
--- trunk/Source/Design/InstantModelExplorer.pas	2009-07-08 06:34:35 UTC (rev 804)
+++ trunk/Source/Design/InstantModelExplorer.pas	2009-07-08 06:55:49 UTC (rev 805)
@@ -24,7 +24,8 @@
  * the Initial Developer. All Rights Reserved.
  *
  * Contributor(s):
- * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell
+ * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell,
+ * Brian Andersen
  *
  * ***** END LICENSE BLOCK ***** *)
 
@@ -120,6 +121,8 @@
     ViewRelationsAction: TAction;
     ViewSourceAction: TAction;
     ViewSourceItem: TMenuItem;
+    ImportModelItem: TMenuItem;
+    ImportModelAction: TAction;
     procedure AboutActionExecute(Sender: TObject);
     procedure BuildDatabaseActionExecute(Sender: TObject);
     procedure CollapseAllActionExecute(Sender: TObject);
@@ -138,6 +141,7 @@
     procedure ViewInheritanceActionExecute(Sender: TObject);
     procedure ViewRelationsActionExecute(Sender: TObject);
     procedure ViewSourceActionExecute(Sender: TObject);
+    procedure ImportModelActionExecute(Sender: TObject);
   private
     FError: TInstantModelError;
     FModel: TInstantCodeModel;
@@ -195,7 +199,7 @@
   InstantModelExpert,
 {$ENDIF}
   InstantDesignUtils, InstantPersistence, InstantDesignHook, InstantAbout,
-  InstantImageUtils;
+  InstantImageUtils, InstantMetadata, InstantModelImport;
 
 resourcestring
   SDeleteClass = 'Delete Class ''%s''?';
@@ -381,6 +385,93 @@
     SelectedNode.Expand(True);
 end;
 
+procedure TInstantModelExplorerForm.ImportModelActionExecute(Sender: TObject);
+var
+  ClassIndex, AttributeIndex: Integer;
+  ImportModule: TInstantCodeModule;
+  ImportFileName: string;
+  ImportFileType: TInstantStreamFormat;
+  ImportModel: TInstantModel;
+  ImportClassMetadata: TInstantClassMetadata;
+  ImportBaseClassName: string;
+  ImportAttributeMetadata: TInstantAttributeMetadata;
+  NewClasses: TInstantCodeClassList;
+  NewClass: TInstantCodeClass;
+  NewAttribute: TInstantCodeAttribute;
+begin
+  with TInstantImportModelForm.Create(nil) do
+    try
+      if Execute(FModel) then
+      begin
+        ImportModule := SelectedModule;
+        ImportFileName := SelectedFileName;
+        ImportFileType := SelectedFileType;
+      end else
+        Exit;
+    finally
+      Free;
+    end;
+
+  ImportModel := TInstantModel.Create;
+  try
+    if ImportFileType = sfBinary then
+      ImportModel.LoadFromResFile(ImportFileName) else
+      ImportModel.LoadFromFile(ImportFileName);
+
+    FModelView.Items.BeginUpdate;
+    try
+      NewClasses := TInstantCodeClassList.Create;
+      try
+        for ClassIndex := 0 to ImportModel.ClassMetadatas.Count - 1 do
+        begin
+          ImportClassMetadata := ImportModel.ClassMetadatas[ClassIndex];
+
+          NewClass := ImportModule.InterfaceSection.AddClass;
+          ImportBaseClassName := ImportClassMetadata.ParentName;
+          if ImportBaseClassName = '' then
+            ImportBaseClassName := TInstantObject.ClassName;
+          NewClass.BaseClassName := ImportBaseClassName;
+          NewClass.Name := ImportClassMetadata.Name;
+          NewClass.Metadata.Assign(ImportClassMetadata);
+
+          for AttributeIndex := 0 to ImportClassMetadata.AttributeMetadatas.Count - 1 do
+          begin
+            ImportAttributeMetadata := ImportClassMetadata.AttributeMetadatas[AttributeIndex];
+
+            NewAttribute := NewClass.AddAttribute;
+            NewAttribute.IsIndexed := ImportAttributeMetadata.IsIndexed;
+            NewAttribute.IsRequired := ImportAttributeMetadata.IsRequired;
+            NewAttribute.IsDefault := ImportAttributeMetadata.IsDefault;
+            NewAttribute.AttributeType := ImportAttributeMetadata.AttributeType;
+            NewAttribute.AttributeTypeName := ImportAttributeMetadata.AttributeTypeName;
+            NewAttribute.Name := ImportAttributeMetadata.FieldName;
+            NewAttribute.StorageKind := ImportAttributeMetadata.StorageKind;
+            NewAttribute.StorageName := ImportAttributeMetadata.StorageName;
+            NewAttribute.ObjectClassName := ImportAttributeMetadata.ObjectClassName;
+            NewAttribute.Realize;
+          end;
+          NewClasses.Add(NewClass)
+        end;
+
+        // Classes needs to be sorted with base classes first or else the code
+        // generation might not be done correct.
+        NewClasses.SortByBaseClass;
+
+        for ClassIndex := 0 to NewClasses.Count - 1 do
+          ApplyClass(NewClasses[ClassIndex], ctNew, '');
+      finally
+        NewClasses.Free;
+      end;
+    finally
+      FModelView.Items.EndUpdate;
+    end;
+  finally
+    ImportModel.Free;
+  end;
+
+  Refresh;
+end;
+
 procedure TInstantModelExplorerForm.ExportModelActionExecute(
   Sender: TObject);
 begin
@@ -590,6 +681,7 @@
   SelectUnitsAction.Enabled := HasProject;
   BuildDatabaseAction.Enabled := HasClasses;
   NewClassAction.Enabled := HasModel;
+  ImportModelAction.Enabled := HasModel;
   ExportModelAction.Enabled := HasModel;
   EditClassAction.Enabled := AtClass;
   ViewSourceAction.Enabled := AtClass;

Modified: trunk/Source/Design/iodesimages.res
===================================================================
(Binary files differ)






Thread: [Instantobjects-cvscommit] SF.net SVN: instantobjects:[805] trunk/Source

instantobjects-cvscommit