Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects:[829] trunk/Source/Design
|
From: <dav...@us...> - 2009-08-16 06:01:59
|
Revision: 829
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=829&view=rev
Author: davidvtaylor
Date: 2009-08-16 06:01:49 +0000 (Sun, 16 Aug 2009)
Log Message:
-----------
Merged changes to show an attributes pane in Model Explorer (code provided by David MoorHouse)
See thread in repository forum: "Enhancement: Show Attributes in the IO Model Explorer" 10-10-2007
- Cleaned up code a bit, adjusted default sizing/positioning and added control size constraints
- Fixed an AV when switching between projects in the IDE (caused by model reloading)
- Added the new InstantAttributeView frame to the IDE design packages (only D2009 tested. D5,D6,K3 ignored)
Modified Paths:
--------------
trunk/Source/Design/D2005/DclIOCore.dpk
trunk/Source/Design/D2006/DclIOCore.dpk
trunk/Source/Design/D2007/DclIOCore.dpk
trunk/Source/Design/D2007/DclIOCore.dproj
trunk/Source/Design/D2009/DclIOCore.dpk
trunk/Source/Design/D2009/DclIOCore.dproj
trunk/Source/Design/D7/DclIOCore.dpk
trunk/Source/Design/InstantModelExplorer.dfm
trunk/Source/Design/InstantModelExplorer.pas
Added Paths:
-----------
trunk/Source/Design/InstantAttributeView.dfm
trunk/Source/Design/InstantAttributeView.pas
Modified: trunk/Source/Design/D2005/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D2005/DclIOCore.dpk 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D2005/DclIOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
@@ -58,7 +58,9 @@
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},
+ InstantAttributeView in '..\InstantAttributeView.pas' {InstantAttributeViewFrame: TFrame};
end.
Modified: trunk/Source/Design/D2006/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D2006/DclIOCore.dpk 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D2006/DclIOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
@@ -58,7 +58,8 @@
InstantUnitSelect in '..\InstantUnitSelect.pas' {InstantUnitSelectForm},
InstantAttributeEditor in '..\InstantAttributeEditor.pas' {InstantAttributeEditorForm},
InstantAbout in '..\InstantAbout.pas' {InstantAboutForm},
- InstantModelImport in '..\InstantModelImport.pas' {InstantImportModelForm};
+ InstantModelImport in '..\InstantModelImport.pas' {InstantImportModelForm},
+ InstantAttributeView in '..\InstantAttributeView.pas' {InstantAttributeViewFrame: TFrame};
end.
Modified: trunk/Source/Design/D2007/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D2007/DclIOCore.dpk 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D2007/DclIOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
@@ -54,7 +54,8 @@
InstantUnitSelect in '..\InstantUnitSelect.pas' {InstantUnitSelectForm},
InstantAttributeEditor in '..\InstantAttributeEditor.pas' {InstantAttributeEditorForm},
InstantAbout in '..\InstantAbout.pas' {InstantAboutForm},
- InstantModelImport in '..\InstantModelImport.pas';
+ InstantModelImport in '..\InstantModelImport.pas',
+ InstantAttributeView in '..\InstantAttributeView.pas' {InstantAttributeViewFrame: TFrame};
end.
Modified: trunk/Source/Design/D2007/DclIOCore.dproj
===================================================================
--- trunk/Source/Design/D2007/DclIOCore.dproj 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D2007/DclIOCore.dproj 2009-08-16 06:01:49 UTC (rev 829)
@@ -43,6 +43,10 @@
<DCCReference Include="..\InstantAbout.pas">
<Form>InstantAboutForm</Form>
</DCCReference>
+ <DCCReference Include="..\InstantAttributeView.pas">
+ <Form>InstantAttributeViewFrame</Form>
+ <DesignClass>TFrame</DesignClass>
+ </DCCReference>
<DCCReference Include="..\InstantAttributeEditor.pas">
<Form>InstantAttributeEditorForm</Form>
</DCCReference>
Modified: trunk/Source/Design/D2009/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D2009/DclIOCore.dpk 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D2009/DclIOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
@@ -58,7 +58,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},
+ InstantAttributeView in '..\InstantAttributeView.pas' {InstantAttributeViewFrame: TFrame};
end.
Modified: trunk/Source/Design/D2009/DclIOCore.dproj
===================================================================
--- trunk/Source/Design/D2009/DclIOCore.dproj 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D2009/DclIOCore.dproj 2009-08-16 06:01:49 UTC (rev 829)
@@ -103,6 +103,10 @@
<DCCReference Include="..\InstantAbout.pas">
<Form>InstantAboutForm</Form>
</DCCReference>
+ <DCCReference Include="..\InstantAttributeView.pas">
+ <Form>InstantAttributeViewFrame</Form>
+ <DesignClass>TFrame</DesignClass>
+ </DCCReference>
<DCCReference Include="..\..\Core\InstantPresentation.dcr"/>
<DCCReference Include="..\..\Core\InstantExplorer.dcr"/>
<DCCReference Include="..\..\Core\InstantPersistence.dcr"/>
Modified: trunk/Source/Design/D7/DclIOCore.dpk
===================================================================
--- trunk/Source/Design/D7/DclIOCore.dpk 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/D7/DclIOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
@@ -58,7 +58,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},
+ InstantAttributeView in '..\InstantAttributeView.pas' {InstantAttributeViewFrame: TFrame};
end.
Added: trunk/Source/Design/InstantAttributeView.dfm
===================================================================
--- trunk/Source/Design/InstantAttributeView.dfm (rev 0)
+++ trunk/Source/Design/InstantAttributeView.dfm 2009-08-16 06:01:49 UTC (rev 829)
@@ -0,0 +1,166 @@
+object InstantAttributeViewFrame: TInstantAttributeViewFrame
+ Left = 0
+ Top = 0
+ Width = 376
+ Height = 188
+ TabOrder = 0
+ object AttributesSplitter: TSplitter
+ Left = 0
+ Top = 84
+ Width = 376
+ Height = 4
+ Cursor = crVSplit
+ Align = alBottom
+ Constraints.MinHeight = 4
+ end
+ object InheritedAttributesPanel: TPanel
+ Left = 0
+ Top = 88
+ Width = 376
+ Height = 100
+ Align = alBottom
+ BevelOuter = bvNone
+ Constraints.MinHeight = 60
+ TabOrder = 1
+ object InheritedAttributesLabel: TLabel
+ Left = 0
+ Top = 0
+ Width = 376
+ Height = 16
+ Align = alTop
+ AutoSize = False
+ Caption = 'Inherited'
+ end
+ object InheritedAttributesView: TListView
+ Left = 0
+ Top = 16
+ Width = 376
+ Height = 84
+ Align = alClient
+ Columns = <
+ item
+ Caption = 'Name'
+ Width = 124
+ end
+ item
+ Caption = 'Type'
+ Width = 124
+ end
+ item
+ Caption = 'Storage Name'
+ Width = 124
+ end>
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ ReadOnly = True
+ ParentFont = False
+ PopupMenu = AttributesMenu
+ TabOrder = 0
+ ViewStyle = vsReport
+ end
+ end
+ object IntroducedAttributesPanel: TPanel
+ Left = 0
+ Top = 0
+ Width = 376
+ Height = 84
+ Align = alClient
+ BevelOuter = bvNone
+ Constraints.MinHeight = 60
+ TabOrder = 0
+ object IntroducedAttributesLabel: TLabel
+ Left = 0
+ Top = 0
+ Width = 376
+ Height = 16
+ Align = alTop
+ AutoSize = False
+ Caption = 'Introduced'
+ end
+ object IntroducedAttributesView: TListView
+ Left = 0
+ Top = 16
+ Width = 376
+ Height = 68
+ Align = alClient
+ Columns = <
+ item
+ Caption = 'Name'
+ Width = 124
+ end
+ item
+ Caption = 'Type'
+ Width = 124
+ end
+ item
+ Caption = 'Storage Name'
+ Width = 124
+ end>
+ ReadOnly = True
+ PopupMenu = AttributesMenu
+ TabOrder = 0
+ ViewStyle = vsReport
+ OnDblClick = IntroducedAttributesViewDblClick
+ end
+ end
+ object SubjectSource: TDataSource
+ Left = 76
+ Top = 132
+ end
+ object AttributeImages: TImageList
+ Left = 108
+ Top = 132
+ end
+ object StateImages: TImageList
+ Left = 140
+ Top = 132
+ end
+ object AttributesMenu: TPopupMenu
+ Images = ActionImages
+ OnPopup = AttributesMenuPopup
+ Left = 204
+ Top = 132
+ object AttributeNewItem: TMenuItem
+ Action = AttributeNewAction
+ ShortCut = 45
+ end
+ object AttributeDeleteItem: TMenuItem
+ Action = AttributeDeleteAction
+ ShortCut = 46
+ end
+ object AttributeEditItem: TMenuItem
+ Action = AttributeEditAction
+ ShortCut = 32781
+ end
+ end
+ object Actions: TActionList
+ Images = ActionImages
+ Left = 236
+ Top = 132
+ object AttributeNewAction: TAction
+ Caption = '&New'
+ Hint = 'New Attribute'
+ ImageIndex = 0
+ OnExecute = AttributeNewActionExecute
+ end
+ object AttributeDeleteAction: TAction
+ Caption = '&Delete'
+ Hint = 'Delete'
+ ImageIndex = 1
+ OnExecute = AttributeDeleteActionExecute
+ end
+ object AttributeEditAction: TAction
+ Caption = '&Edit'
+ Hint = 'Edit'
+ ImageIndex = 2
+ OnExecute = AttributeEditActionExecute
+ end
+ end
+ object ActionImages: TImageList
+ Left = 172
+ Top = 132
+ end
+end
Property changes on: trunk/Source/Design/InstantAttributeView.dfm
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
Added: trunk/Source/Design/InstantAttributeView.pas
===================================================================
--- trunk/Source/Design/InstantAttributeView.pas (rev 0)
+++ trunk/Source/Design/InstantAttributeView.pas 2009-08-16 06:01:49 UTC (rev 829)
@@ -0,0 +1,506 @@
+(*
+ * InstantObjects
+ * Attribute View Frame
+ *)
+
+(* ***** BEGIN LICENSE BLOCK *****
+ * Version: MPL 1.1
+ *
+ * The contents of this file are subject to the Mozilla Public License Version
+ * 1.1 (the "License"); you may not use this file except in compliance with
+ * the License. You may obtain a copy of the License at
+ * http://www.mozilla.org/MPL/
+ *
+ * Software distributed under the License is distributed on an "AS IS" basis,
+ * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+ * for the specific language governing rights and limitations under the
+ * License.
+ *
+ * The Original Code is: Seleqt InstantObjects
+ *
+ * The Initial Developer of the Original Code is: Seleqt
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2001-2003
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ * David Moorhouse, Carlo Barazzetta, Adrea Petrelli, Steven Mitchell,
+ * Nando Dessena, David Taylor
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantAttributeView;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils, Classes, DB, Contnrs, InstantPresentation,
+ InstantPersistence, InstantCode, InstantEdit,
+{$IFDEF MSWINDOWS}
+ Windows, Messages, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ComCtrls, ExtCtrls, Mask, DBCtrls,
+ ImgList, ActnList, Menus, Buttons;
+{$ENDIF}
+{$IFDEF LINUX}
+ QActnList, QMenus, QTypes, QImgList, QComCtrls, QControls, QExtCtrls,
+ QStdCtrls, QDBCtrls, QMask, QForms;
+{$ENDIF}
+
+type
+ TInstantAttributeViewFrame = class(TFrame)
+ SubjectSource: TDataSource;
+ AttributeImages: TImageList;
+ StateImages: TImageList;
+ AttributesMenu: TPopupMenu;
+ Actions: TActionList;
+ ActionImages: TImageList;
+ AttributeNewAction: TAction;
+ AttributeDeleteAction: TAction;
+ AttributeNewItem: TMenuItem;
+ AttributeDeleteItem: TMenuItem;
+ AttributeEditAction: TAction;
+ AttributeEditItem: TMenuItem;
+ AttributesSplitter: TSplitter;
+ InheritedAttributesPanel: TPanel;
+ InheritedAttributesLabel: TLabel;
+ InheritedAttributesView: TListView;
+ IntroducedAttributesPanel: TPanel;
+ IntroducedAttributesView: TListView;
+ IntroducedAttributesLabel: TLabel;
+ procedure AttributeNewActionExecute(Sender: TObject);
+ procedure AttributeDeleteActionExecute(Sender: TObject);
+ procedure AttributeEditActionExecute(Sender: TObject);
+ procedure IntroducedAttributesViewDblClick(Sender: TObject);
+ procedure IntroducedAttributesViewEdited(Sender: TObject; Item: TListItem;
+ var S: String);
+ procedure SubjectExposerAfterPostField(Sender: TObject; Field: TField);
+ procedure AttributesMenuPopup(Sender: TObject);
+ private
+ FSubject: TInstantCodeClass;
+ FBackupAttributes: TObjectList;
+ FChangedAttributes: TStringList;
+ FNewAttributes: TList;
+ FModel: TInstantCodeModel;
+ FNameAttribute: TInstantCodeAttribute;
+ procedure DeleteAttribute(Attribute: TInstantCodeAttribute);
+ procedure FitColumns(View: TListView);
+ function GetNameAttribute: TInstantCodeAttribute;
+ procedure LoadAttributeView(View: TListView; AClass: TInstantCodeClass;
+ Recursive: Boolean);
+ procedure SetModel(const Value: TInstantCodeModel);
+ procedure SetSubject(const Value: TInstantCodeClass);
+ function GetFocusedAttribute: TInstantCodeAttribute;
+ protected
+ function AddAttributeToView(View: TListView;
+ Attribute: TInstantCodeAttribute): TListItem;
+ function EditAttribute(Attribute: TInstantCodeAttribute;
+ Exists: Boolean; const Title: string = ''): Boolean;
+ procedure PopulateInheritedAttributes;
+ procedure PopulateIntroducedAttributes;
+ property NameAttribute: TInstantCodeAttribute read GetNameAttribute;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure RestoreAttributes;
+ procedure UpdateActions;
+ procedure RestoreLayout;
+ procedure StoreLayout;
+ property ChangedAttributes: TStringList read FChangedAttributes;
+ property FocusedAttribute: TInstantCodeAttribute read GetFocusedAttribute;
+ property Model: TInstantCodeModel read FModel write SetModel;
+ property NewAttributes: TList read FNewAttributes;
+ property Subject: TInstantCodeClass read FSubject write SetSubject;
+ end;
+
+implementation
+
+uses
+ InstantAttributeEditor, InstantDesignUtils, InstantConsts, InstantRtti,
+ TypInfo, InstantImageUtils, InstantTypes, Registry;
+
+{$R *.dfm}
+
+resourcestring
+ SConfirmDeleteAttribute = 'Delete attribute ''%s''?';
+
+{ TInstantAttributeViewFrame }
+
+function TInstantAttributeViewFrame.AddAttributeToView(View: TListView;
+ Attribute: TInstantCodeAttribute): TListItem;
+begin
+ Result := View.Items.Add;
+ with Result do
+ begin
+ with Attribute do
+ if (HostClass = Subject) or not Assigned(HostClass) then
+ Caption := Name else
+ Caption := HostClass.Name + '.' + Name;
+ Data := Attribute;
+ //Add Attribute Type
+ SubItems.Add(Attribute.AttributeTypeText);
+ //Add StorageName or ExternalStorageName
+ if Attribute.CanBeExternal and not Attribute.CanHaveStorageName then
+ SubItems.Add(Attribute.ExternalStorageName)
+ else
+ SubItems.Add(Attribute.StorageName);
+ case Attribute.AttributeType of
+ atReference: ImageIndex := 1;
+ atPart: ImageIndex := 2;
+ atReferences: ImageIndex := 3;
+ atParts: ImageIndex := 4;
+ else
+ ImageIndex := 0;
+ end;
+ if Attribute.HostClass <> Subject then
+ ImageIndex := ImageIndex + 5;
+ end;
+ FitColumns(View);
+end;
+
+procedure TInstantAttributeViewFrame.AttributeDeleteActionExecute(
+ Sender: TObject);
+var
+ Attribute: TInstantCodeAttribute;
+begin
+ with IntroducedAttributesView do
+ if Assigned(ItemFocused) then
+ begin
+ Attribute := ItemFocused.Data;
+ if not Confirm(Format(SConfirmDeleteAttribute, [Attribute.Name])) then
+ Exit;
+ DeleteAttribute(Attribute);
+ ItemFocused.Delete;
+ if Assigned(ItemFocused) then
+ ItemFocused.Selected := True;
+ FitColumns(IntroducedAttributesView);
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.AttributeEditActionExecute(
+ Sender: TObject);
+var
+ OldName: string;
+ Attribute: TInstantCodeAttribute;
+ Exists: Boolean;
+begin
+ Attribute := FocusedAttribute;
+ if not Assigned(Attribute) then
+ Exit;
+ OldName := Attribute.Name;
+ Exists := FNewAttributes.IndexOf(Attribute) = -1;
+ if Exists then
+ Attribute.DetectMethodTypes;
+ if EditAttribute(Attribute, Exists) then
+ begin
+ if Exists and (FChangedAttributes.IndexOfObject(Attribute) = -1) then
+ FChangedAttributes.AddObject(OldName, Attribute);
+ PopulateIntroducedAttributes;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.AttributeNewActionExecute(Sender: TObject);
+var
+ Attribute: TInstantCodeAttribute;
+ NewItem: TListItem;
+begin
+ Attribute := Subject.AddAttribute;
+ if not EditAttribute(Attribute, False, 'New Attribute') then
+ Attribute.Free
+ else begin
+ FNewAttributes.Add(Attribute);
+ with IntroducedAttributesView do
+ begin
+ Items.BeginUpdate;
+ try
+ NewItem := AddAttributeToView(IntroducedAttributesView, Attribute);
+ NewItem.Focused := True;
+ Selected := NewItem;
+ finally
+ Items.EndUpdate;
+ end;
+ NewItem.MakeVisible{$IFDEF MSWINDOWS}(False){$ENDIF};
+ end;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.AttributesMenuPopup(Sender: TObject);
+begin
+ UpdateActions;
+end;
+
+procedure TInstantAttributeViewFrame.Clear;
+begin
+ InheritedAttributesView.Clear;
+ IntroducedAttributesView.Clear;
+end;
+
+constructor TInstantAttributeViewFrame.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBackupAttributes := TObjectList.Create;
+ FChangedAttributes := TStringList.Create;
+ FNewAttributes := TList.Create;
+ LoadMultipleImages(AttributeImages, 'IO_CLASSEDITORATTRIBUTEIMAGES', HInstance);
+{$IFDEF MSWINDOWS}
+ IntroducedAttributesView.SmallImages := AttributeImages;
+ InheritedAttributesView.SmallImages := AttributeImages;
+{$ENDIF}
+{$IFDEF LINUX}
+ IntroducedAttributesView.Images := AttributeImages;
+ InheritedAttributesView.Images := AttributeImages;
+{$ENDIF}
+end;
+
+procedure TInstantAttributeViewFrame.DeleteAttribute(
+ Attribute: TInstantCodeAttribute);
+var
+ Index: Integer;
+begin
+ Index := FChangedAttributes.IndexOfObject(Attribute);
+ if Index <> -1 then
+ FChangedAttributes.Delete(Index);
+ FNewAttributes.Remove(Attribute);
+ Attribute.Delete;
+ Attribute.Free;
+end;
+
+destructor TInstantAttributeViewFrame.Destroy;
+begin
+ FNewAttributes.Free;
+ FChangedAttributes.Free;
+ FBackupAttributes.Free;
+ FNameAttribute.Free;
+ inherited;
+end;
+
+function TInstantAttributeViewFrame.EditAttribute(Attribute: TInstantCodeAttribute;
+ Exists: Boolean; const Title: string): Boolean;
+
+ function GetClassStorageName: String;
+ begin
+ if Attribute.Metadata.ClassMetadata.StorageName <> '' then
+ Result := Attribute.Metadata.ClassMetadata.StorageName
+ else
+ Result := Remove_T_FromClassName(Attribute.Metadata.ClassMetadata.Name);
+ end;
+
+begin
+ with TInstantAttributeEditorForm.Create(nil) do
+ try
+ if Title <> '' then
+ Caption := Title;
+ Model := Self.Model;
+ BaseClassStorageName := GetClassStorageName;
+ Limited := Exists;
+ Subject := Attribute;
+ Result := ShowModal = mrOk;
+ if Result then
+ Attribute.Realize;
+ finally
+ Free;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.FitColumns(View: TListView);
+var
+ i : integer;
+begin
+ //adjust Columns size to window width
+ for i := View.Columns.Count-1 downto 0 do
+ begin
+{$IFDEF MSWINDOWS}
+ View.Columns[i].AutoSize := True;
+{$ENDIF}
+{$IFDEF LINUX}
+ View.Columns[i].Width := View.Width div View.Columns.Count;
+{$ENDIF}
+ end;
+end;
+
+function TInstantAttributeViewFrame.GetFocusedAttribute: TInstantCodeAttribute;
+begin
+ with IntroducedAttributesView do
+ if Assigned(ItemFocused) then
+ Result := ItemFocused.Data
+ else
+ Result := nil;
+end;
+
+function TInstantAttributeViewFrame.GetNameAttribute: TInstantCodeAttribute;
+begin
+ if not Assigned(FNameAttribute) and
+ Subject.DerivesFrom(TInstantObject.ClassName) then
+ begin
+ FNameAttribute := TInstantCodeAttribute.Create(nil);
+ FNameAttribute.Name := TInstantObject.ClassName + '.' +
+ InstantIdFieldName;
+ FNameAttribute.AttributeTypeName := 'String';
+ end;
+ Result := FNameAttribute;
+end;
+
+procedure TInstantAttributeViewFrame.IntroducedAttributesViewDblClick(
+ Sender: TObject);
+begin
+ AttributeEditAction.Execute;
+end;
+
+procedure TInstantAttributeViewFrame.IntroducedAttributesViewEdited(
+ Sender: TObject; Item: TListItem; var S: String);
+var
+ Attribute: TInstantCodeAttribute;
+begin
+ Attribute := TInstantCodeAttribute(Item.Data);
+ if Assigned(Attribute) then
+ begin
+ Attribute.Name := S;
+ S := Attribute.Name;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.LoadAttributeView(View: TListView;
+ AClass: TInstantCodeClass; Recursive: Boolean);
+var
+ FocusedData: Pointer;
+
+ procedure LoadClass(AClass: TInstantCodeClass);
+ var
+ I: Integer;
+ NewItem: TListItem;
+ FocusItem: TListItem;
+ begin
+ FocusItem := nil;
+ if Assigned(AClass) then
+ with AClass do
+ begin
+ for I := 0 to Pred(AttributeCount) do
+ begin
+ NewItem := AddAttributeToView(View, Attributes[I]);
+ if NewItem.Data = FocusedData then
+ FocusItem := NewItem;
+ end;
+ if Recursive then
+ LoadClass(BaseClass)
+ else begin
+ if not Assigned(FocusedData) and (View.Items.Count > 0) then
+ FocusItem := View.Items[0];
+ if Assigned(FocusItem) then
+ begin
+ FocusItem.Focused := True;
+ View.Selected := FocusItem;
+ end;
+ end;
+ end;
+ end;
+
+begin
+ with View do
+ begin
+ if Assigned(ItemFocused) then
+ FocusedData := ItemFocused.Data else
+ FocusedData := nil;
+ with Items do
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ if Recursive and Assigned(NameAttribute) then
+ AddAttributeToView(View, NameAttribute);
+ LoadClass(AClass);
+ finally
+ EndUpdate;
+ FitColumns(View);
+ end;
+ end;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.PopulateInheritedAttributes;
+begin
+ LoadAttributeView(InheritedAttributesView, Subject.BaseClass, True);
+end;
+
+procedure TInstantAttributeViewFrame.PopulateIntroducedAttributes;
+begin
+ LoadAttributeView(IntroducedAttributesView, Subject, False);
+end;
+
+procedure TInstantAttributeViewFrame.RestoreLayout;
+begin
+ with TRegistry.Create do try
+ RootKey := HKEY_CURRENT_USER;
+ if OpenKey('Software\InstantObjects.org\Layout', False) then begin
+ if not ReadBool('Default') then Exit;
+ InheritedAttributesPanel.Height := ReadInteger('Splitter');
+ end;
+ finally
+ Free;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.SetModel(const Value: TInstantCodeModel);
+begin
+ if Value <> FModel then
+ begin
+ FModel := Value;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.SetSubject(const Value: TInstantCodeClass);
+begin
+ if Value <> Subject then
+ begin
+ FSubject := Value;
+ if Subject <> nil then
+ Subject.CloneAttributes(FBackupAttributes);
+ PopulateIntroducedAttributes;
+ PopulateInheritedAttributes;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.StoreLayout;
+begin
+ with TRegistry.Create do try
+ RootKey := HKEY_CURRENT_USER;
+ if OpenKey('Software\InstantObjects.org\Layout', True) then begin
+ WriteInteger('Splitter', InheritedAttributesPanel.Height);
+ end;
+ finally
+ Free;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.SubjectExposerAfterPostField(
+ Sender: TObject; Field: TField);
+begin
+ if Field.FieldName = 'BaseClassName' then
+ begin
+ FreeAndNil(FNameAttribute);
+ PopulateInheritedAttributes;
+ end;
+end;
+
+procedure TInstantAttributeViewFrame.UpdateActions;
+var
+ Attribute: TInstantCodeAttribute;
+begin
+ inherited;
+ Attribute := FocusedAttribute;
+ AttributeEditAction.Enabled := Assigned(Attribute);
+ AttributeDeleteAction.Enabled := Assigned(Attribute);
+end;
+
+procedure TInstantAttributeViewFrame.RestoreAttributes;
+begin
+ Subject.AssignAttributes(FBackupAttributes);
+end;
+
+
+end.
Property changes on: trunk/Source/Design/InstantAttributeView.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
Modified: trunk/Source/Design/InstantModelExplorer.dfm
===================================================================
--- trunk/Source/Design/InstantModelExplorer.dfm 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/InstantModelExplorer.dfm 2009-08-16 06:01:49 UTC (rev 829)
@@ -1,8 +1,8 @@
object InstantModelExplorerForm: TInstantModelExplorerForm
Left = 385
Top = 186
- Width = 259
- Height = 433
+ Width = 418
+ Height = 536
VertScrollBar.Range = 20
Caption = 'InstantObjects Model Explorer'
Color = clBtnFace
@@ -18,19 +18,30 @@
OnShow = FormShow
PixelsPerInch = 96
TextHeight = 13
+ object AttributeSplitter: TSplitter
+ Left = 0
+ Top = 255
+ Width = 410
+ Height = 4
+ Cursor = crVSplit
+ Align = alBottom
+ Constraints.MinHeight = 4
+ Visible = False
+ end
object ModelPanel: TPanel
Left = 0
Top = 27
- Width = 251
- Height = 372
+ Width = 410
+ Height = 228
Align = alClient
BevelOuter = bvNone
+ Constraints.MinHeight = 20
TabOrder = 0
end
object ToolBar: TToolBar
Left = 0
Top = 0
- Width = 251
+ Width = 410
Height = 27
BorderWidth = 1
ButtonHeight = 23
@@ -61,7 +72,57 @@
Top = 0
Action = ViewRelationsAction
end
+ object ToolSep2: TToolButton
+ Left = 77
+ Top = 0
+ Width = 8
+ Caption = 'ToolSep2'
+ ImageIndex = 4
+ Style = tbsSeparator
+ end
+ object ViewAttributeButton: TToolButton
+ Left = 85
+ Top = 0
+ Action = ViewAttributesAction
+ end
end
+ object AttributePanel: TPanel
+ Left = 0
+ Top = 259
+ Width = 410
+ Height = 243
+ Align = alBottom
+ BevelOuter = bvNone
+ Constraints.MinHeight = 45
+ Padding.Left = 3
+ Padding.Right = 3
+ Padding.Bottom = 3
+ TabOrder = 2
+ Visible = False
+ object AttributeCaptionPanel: TPanel
+ Left = 3
+ Top = 0
+ Width = 404
+ Height = 25
+ Align = alTop
+ BevelOuter = bvLowered
+ TabOrder = 0
+ object AttributeCaptionLabel: TLabel
+ Left = 12
+ Top = 6
+ Width = 89
+ Height = 13
+ Caption = 'Class Attributes'
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = 11
+ Font.Name = 'MS Sans Serif'
+ Font.Pitch = fpVariable
+ Font.Style = [fsBold]
+ ParentFont = False
+ end
+ end
+ end
object ModelImages: TImageList
Left = 104
Top = 40
@@ -83,6 +144,9 @@
object ViewSourceItem: TMenuItem
Action = ViewSourceAction
end
+ object ViewAttributes: TMenuItem
+ Action = ViewAttributesAction
+ end
object N1: TMenuItem
Caption = '-'
end
@@ -206,6 +270,12 @@
Hint = 'About InstantObjects'
OnExecute = AboutActionExecute
end
+ object ViewAttributesAction: TAction
+ Caption = 'View Attributes'
+ Hint = 'View Class Attributes'
+ ImageIndex = 11
+ OnExecute = ViewAttributesActionExecute
+ end
end
object AttributeImages: TImageList
Left = 136
Modified: trunk/Source/Design/InstantModelExplorer.pas
===================================================================
--- trunk/Source/Design/InstantModelExplorer.pas 2009-08-16 05:23:17 UTC (rev 828)
+++ trunk/Source/Design/InstantModelExplorer.pas 2009-08-16 06:01:49 UTC (rev 829)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell,
- * Brian Andersen
+ * Brian Andersen, David Moorhouse, David Taylor
*
* ***** END LICENSE BLOCK ***** *)
@@ -48,7 +48,7 @@
{$IFDEF LINUX}
QForms, QActnList, QMenus, QTypes, QImgList, QComCtrls, QControls, QExtCtrls,
{$ENDIF}
- InstantCode;
+ InstantCode, InstantAttributeView;
type
TInstantModelStyle = (msInheritance, msRelations);
@@ -123,6 +123,14 @@
ViewSourceItem: TMenuItem;
ImportModelItem: TMenuItem;
ImportModelAction: TAction;
+ AttributePanel: TPanel;
+ AttributeSplitter: TSplitter;
+ AttributeCaptionPanel: TPanel;
+ AttributeCaptionLabel: TLabel;
+ ToolSep2: TToolButton;
+ ViewAttributeButton: TToolButton;
+ ViewAttributesAction: TAction;
+ ViewAttributes: TMenuItem;
procedure AboutActionExecute(Sender: TObject);
procedure BuildDatabaseActionExecute(Sender: TObject);
procedure CollapseAllActionExecute(Sender: TObject);
@@ -138,6 +146,7 @@
procedure RefreshActionExecute(Sender: TObject);
procedure SelectUnitsActionExecute(Sender: TObject);
procedure TreeMenuPopup(Sender: TObject);
+ procedure ViewAttributesActionExecute(Sender: TObject);
procedure ViewInheritanceActionExecute(Sender: TObject);
procedure ViewRelationsActionExecute(Sender: TObject);
procedure ViewSourceActionExecute(Sender: TObject);
@@ -146,15 +155,21 @@
FError: TInstantModelError;
FModel: TInstantCodeModel;
FModelView: TModelTreeView;
+ FAttributeFrame: TInstantAttributeViewFrame;
FSelectedNode: TTreeNode;
FStyle: TInstantModelStyle;
FOnApplyClass: TInstantCodeClassApplyEvent;
FOnGotoSource: TInstantGotoSourceEvent;
FOnLoadModel: TInstantCodeModelEvent;
+ FViewUpdateDisableCount: Integer;
function GetFocusedClass: TInstantCodeClass;
function GetSelectedNode: TTreeNode;
procedure SetError(E: Exception);
procedure SetStyle(const Value: TInstantModelStyle);
+ procedure ViewClassAttributes(AClass: TInstantCodeClass);
+ procedure SetAttributePanelVisible(Visible: Boolean);
+ procedure RestoreLayout;
+ procedure StoreLayout;
protected
procedure ApplyClass(AClass: TInstantCodeClass;
ChangeType: TInstantCodeChangeType; OldName: string = '';
@@ -162,6 +177,9 @@
function ClassFromNode(Node: TTreeNode): TInstantCodeClass;
procedure DoApplyClass(AClass: TInstantCodeClass;
ChangeInfo: TInstantCodeClassChangeInfo);
+ procedure DisableViewUpdate;
+ procedure EnableViewUpdate;
+ function ViewUpdateEnabled: boolean;
function EditClass(AClass: TInstantCodeClass; New: Boolean): Boolean;
procedure GotoNodeSource(Node: TTreeNode);
procedure GotoSource(const FileName: string; Pos: TInstantCodePos);
@@ -199,7 +217,7 @@
InstantModelExpert,
{$ENDIF}
InstantDesignUtils, InstantPersistence, InstantDesignHook, InstantAbout,
- InstantImageUtils, InstantMetadata, InstantModelImport;
+ InstantImageUtils, InstantMetadata, InstantModelImport, Registry;
resourcestring
SDeleteClass = 'Delete Class ''%s''?';
@@ -305,6 +323,7 @@
Images := ModelImages;
PopupMenu := TreeMenu;
ReadOnly := True;
+ HideSelection := False;
{$IFDEF MSWINDOWS}
RightClickSelect := True;
{$ENDIF}
@@ -312,6 +331,14 @@
OnNodeDblClick := ModelViewNodeDblClick;
OnGetImageIndex := ModelViewGetImageIndex;
end;
+
+ FAttributeFrame := TInstantAttributeViewFrame.Create(Self);
+ with FAttributeFrame do
+ begin
+ Parent := AttributePanel;
+ Align := alClient;
+ end;
+
FModel := TInstantCodeModel.Create;
DesignModel := @FModel;
{$IFDEF MSWINDOWS}
@@ -319,6 +346,8 @@
AutoSave := True;
{$ENDIF}
ModelExplorer := Self;
+ SetAttributePanelVisible(True);
+ RestoreLayout;
Refresh;
end;
@@ -337,6 +366,7 @@
destructor TInstantModelExplorerForm.Destroy;
begin
+ StoreLayout;
ModelExplorer := nil;
FModel.Free;
FError.Free;
@@ -350,6 +380,22 @@
FOnApplyClass(Self, AClass, ChangeInfo);
end;
+procedure TInstantModelExplorerForm.DisableViewUpdate;
+ begin
+ inc(FViewUpdateDisableCount);
+ end;
+
+procedure TInstantModelExplorerForm.EnableViewUpdate;
+ begin
+ if (FViewUpdateDisableCount > 0) then
+ dec(FViewUpdateDisableCount);
+ end;
+
+function TInstantModelExplorerForm.ViewUpdateEnabled: boolean;
+ begin
+ Result := (FViewUpdateDisableCount = 0);
+ end;
+
function TInstantModelExplorerForm.EditClass(AClass: TInstantCodeClass;
New: Boolean): Boolean;
const
@@ -365,8 +411,9 @@
Subject := AClass;
Result := ShowModal = mrOk;
if Result then
- ApplyClass(AClass, ChangeTypes[New], OldName, ChangedAttributes,
- NewAttributes);
+ ApplyClass(AClass, ChangeTypes[New], OldName,
+ FAttributeFrame.ChangedAttributes,
+ FAttributeFrame.NewAttributes);
finally
Free;
end;
@@ -520,7 +567,7 @@
Pos: TInstantCodePos);
begin
if Assigned(FOnGotoSource) then
- FOnGotoSource(Self, FileName, Pos);
+ FOnGotoSource(Self, FileName, Pos);
end;
procedure TInstantModelExplorerForm.LoadModel;
@@ -548,6 +595,8 @@
Node: TTreeNode);
begin
FSelectedNode := nil;
+ if (ViewUpdateEnabled) then
+ ViewClassAttributes(FocusedClass);
end;
procedure TInstantModelExplorerForm.ModelViewGetImageIndex(Sender: TObject;
@@ -639,6 +688,13 @@
ModelExpert.SelectUnits;
end;
+procedure TInstantModelExplorerForm.SetAttributePanelVisible(Visible: Boolean);
+begin
+ AttributePanel.Visible := Visible;
+ AttributeSplitter.Visible := Visible;
+ ViewAttributeButton.Down := Visible;
+end;
+
procedure TInstantModelExplorerForm.SetError(E: Exception);
begin
FreeAndNil(FError);
@@ -666,7 +722,7 @@
procedure TInstantModelExplorerForm.TreeMenuPopup(Sender: TObject);
begin
- FSelectedNode := ModelView.Selected;
+ FSelectedNode := ModelView.Selected;
end;
procedure TInstantModelExplorerForm.UpdateActions;
@@ -797,42 +853,50 @@
I: Integer;
Level: Integer;
begin
- Level := 0;
- FSelectedNode := nil;
- ModelView.Items.BeginUpdate;
+ FAttributeFrame.Clear;
+
+ DisableViewUpdate;
+
try
- if Assigned(FError) then
- begin
- ModelView.Items.Clear;
-{$IFDEF MSWINDOWS}
- ModelView.ShowRoot := False;
-{$ENDIF}
- ModelView.Items.AddObject(nil, FError.Text, FError)
- end else
- begin
- Nodes := TList.Create;
- try
-{$IFDEF MSWINDOWS}
- ModelView.ShowRoot := True;
-{$ENDIF}
- for I := 0 to Pred(Model.ClassCount) do
- begin
- AClass := Model.Classes[I];
- if (Style = msRelations) or not Assigned(AClass.BaseClass) then
- Nodes.Add(AddClass(nil, AClass, '', Level));
+ Level := 0;
+ FSelectedNode := nil;
+ ModelView.Items.BeginUpdate;
+ try
+ if Assigned(FError) then
+ begin
+ ModelView.Items.Clear;
+ {$IFDEF MSWINDOWS}
+ ModelView.ShowRoot := False;
+ {$ENDIF}
+ ModelView.Items.AddObject(nil, FError.Text, FError)
+ end else
+ begin
+ Nodes := TList.Create;
+ try
+ {$IFDEF MSWINDOWS}
+ ModelView.ShowRoot := True;
+ {$ENDIF}
+ for I := 0 to Pred(Model.ClassCount) do
+ begin
+ AClass := Model.Classes[I];
+ if (Style = msRelations) or not Assigned(AClass.BaseClass) then
+ Nodes.Add(AddClass(nil, AClass, '', Level));
+ end;
+ ModelView.AlphaSort;
+ RemoveInvalidNodes(nil, Nodes);
+ FirstNode := ModelView.Items.GetFirstNode;
+ if Assigned(FirstNode) and (FirstNode.GetNextSibling = nil) then
+ FirstNode.Expand(False);
+ finally
+ Nodes.Free;
end;
- ModelView.AlphaSort;
- RemoveInvalidNodes(nil, Nodes);
- FirstNode := ModelView.Items.GetFirstNode;
- if Assigned(FirstNode) and (FirstNode.GetNextSibling = nil) then
- FirstNode.Expand(False);
- finally
- Nodes.Free;
end;
+ finally;
+ ModelView.Items.EndUpdate;
+ ModelView.Repaint;
end;
- finally;
- ModelView.Items.EndUpdate;
- ModelView.Repaint;
+ finally
+ EnableViewUpdate;
end;
end;
@@ -856,6 +920,49 @@
GotoNodeSource(SelectedNode);
end;
+procedure TInstantModelExplorerForm.ViewAttributesActionExecute(Sender: TObject);
+begin
+ SetAttributePanelVisible(not AttributePanel.Visible);
+end;
+
+procedure TInstantModelExplorerForm.ViewClassAttributes(AClass: TInstantCodeClass);
+begin
+ FAttributeFrame.Subject := AClass;
+end;
+
+procedure TInstantModelExplorerForm.RestoreLayout;
+begin
+ try
+ with TRegistry.Create do try
+ RootKey := HKEY_CURRENT_USER;
+ if OpenKey('Software\InstantObjects.org\Layout\ClassAttributes', False) then begin
+ SetAttributePanelVisible(ReadBool('ShowAttributes'));
+ AttributePanel.Height := ReadInteger('AttributePanelHeight');
+ FAttributeFrame.InheritedAttributesPanel.Height := ReadInteger('InheritedAttributeHeight');
+ end;
+ finally
+ Free;
+ end;
+ except
+ // silently swallow exception
+ end;
+end;
+
+procedure TInstantModelExplorerForm.StoreLayout;
+begin
+ with TRegistry.Create do try
+ RootKey := HKEY_CURRENT_USER;
+ if OpenKey('Software\InstantObjects.org\Layout\ClassAttributes', True) then begin
+ WriteBool('ShowAttributes', ViewAttributeButton.Down);
+ WriteInteger('AttributePanelHeight', AttributePanel.Height);
+ WriteInteger('InheritedAttributeHeight', FAttributeFrame.InheritedAttributesPanel.Height);
+ end;
+ finally
+ Free;
+ end;
+end;
+
+
initialization
ModelExplorer := nil;
RegisterFieldAddress('InstantModelExplorer', @ModelExplorer);
|
