Menu
▾
▴
instantobjects-cvscommit — Generates a message for every commit made on CVS
You can subscribe to this list here.
| 2004 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(13) |
Sep
(25) |
Oct
(10) |
Nov
(19) |
Dec
(20) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2005 |
Jan
|
Feb
(206) |
Mar
(43) |
Apr
(25) |
May
(20) |
Jun
(69) |
Jul
(121) |
Aug
(95) |
Sep
(122) |
Oct
(213) |
Nov
(46) |
Dec
(39) |
| 2006 |
Jan
(28) |
Feb
(57) |
Mar
(21) |
Apr
(7) |
May
(11) |
Jun
(2) |
Jul
(8) |
Aug
(13) |
Sep
(2) |
Oct
(2) |
Nov
(20) |
Dec
(16) |
| 2007 |
Jan
(9) |
Feb
(15) |
Mar
|
Apr
(4) |
May
(1) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
|
Nov
|
Dec
|
| 2008 |
Jan
|
Feb
(2) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(3) |
Aug
(1) |
Sep
(9) |
Oct
|
Nov
(1) |
Dec
|
| 2009 |
Jan
|
Feb
|
Mar
(8) |
Apr
(1) |
May
|
Jun
|
Jul
(11) |
Aug
(57) |
Sep
(2) |
Oct
(6) |
Nov
|
Dec
(7) |
| 2010 |
Jan
(11) |
Feb
(1) |
Mar
|
Apr
(1) |
May
|
Jun
|
Jul
(1) |
Aug
(2) |
Sep
(27) |
Oct
(3) |
Nov
(7) |
Dec
(1) |
| 2011 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
(10) |
Oct
|
Nov
|
Dec
|
| 2012 |
Jan
(8) |
Feb
(1) |
Mar
|
Apr
|
May
|
Jun
|
Jul
(1) |
Aug
|
Sep
|
Oct
(3) |
Nov
(1) |
Dec
(1) |
| 2013 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2014 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
(1) |
Oct
|
Nov
(4) |
Dec
|
| 2015 |
Jan
|
Feb
|
Mar
(1) |
Apr
|
May
|
Jun
(1) |
Jul
|
Aug
(1) |
Sep
(1) |
Oct
|
Nov
|
Dec
|
| 2016 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(3) |
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2017 |
Jan
|
Feb
|
Mar
(1) |
Apr
(4) |
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
|
| 2018 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
(1) |
Sep
(3) |
Oct
|
Nov
(4) |
Dec
|
| 2022 |
Jan
|
Feb
|
Mar
|
Apr
|
May
|
Jun
|
Jul
|
Aug
|
Sep
|
Oct
|
Nov
|
Dec
(1) |
|
From: <dav...@us...> - 2009-08-18 05:27:48
|
Revision: 843
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=843&view=rev
Author: davidvtaylor
Date: 2009-08-18 05:27:40 +0000 (Tue, 18 Aug 2009)
Log Message:
-----------
Add AnyDAC broker packages for Delphi 7 (not extensively tested)
Added Paths:
-----------
trunk/Source/Brokers/AnyDAC/D7/
trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.dpk
trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.res
trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.dpk
trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.res
Added: trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.dpk
===================================================================
--- trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.dpk (rev 0)
+++ trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.dpk 2009-08-18 05:27:40 UTC (rev 843)
@@ -0,0 +1,39 @@
+package DclIOAnyDAC;
+
+{$R *.res}
+{$R '..\InstantAnyDAC.dcr'}
+
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS ON}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'InstantObjects AnyDAC Design-Time Support (Delphi 7)'}
+{$LIBSUFFIX '_D7'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ IOAnyDAC;
+
+contains
+ InstantAnyDACReg in '..\InstantAnyDACReg.pas';
+
+end.
+
Property changes on: trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.dpk
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
Added: trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.res
===================================================================
(Binary files differ)
Property changes on: trunk/Source/Brokers/AnyDAC/D7/DclIOAnyDAC.res
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.dpk
===================================================================
--- trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.dpk (rev 0)
+++ trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.dpk 2009-08-18 05:27:40 UTC (rev 843)
@@ -0,0 +1,42 @@
+package IOAnyDAC;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS ON}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'InstantObjects AnyDAC Run-Time Support (Delphi 7)'}
+{$LIBSUFFIX '_D7'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ IOCore,
+ xmlrtl,
+ AnyDAC_Phys_D7,
+ AnyDAC_ComI_D7,
+ AnyDAC_Comp_D7;
+
+contains
+ InstantAnyDAC in '..\InstantAnyDAC.pas',
+ InstantAnyDACCatalog in '..\InstantAnyDACCatalog.pas',
+ InstantAnyDACConnectionDefEdit in '..\InstantAnyDACConnectionDefEdit.pas' {InstantAnyDACConnectionDefEditForm};
+
+end.
Property changes on: trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.dpk
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Author Date Id Revision
Added: svn:eol-style
+ native
Added: trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.res
===================================================================
(Binary files differ)
Property changes on: trunk/Source/Brokers/AnyDAC/D7/IOAnyDAC.res
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
|
|
From: <dav...@us...> - 2009-08-18 05:02:22
|
Revision: 842
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=842&view=rev
Author: davidvtaylor
Date: 2009-08-18 05:02:14 +0000 (Tue, 18 Aug 2009)
Log Message:
-----------
Remove AnyDAC development branch since it is now in trunk
Removed Paths:
-------------
branches/BrokerDev/AnyDAC/
|
|
From: <dav...@us...> - 2009-08-18 04:55:58
|
Revision: 841
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=841&view=rev
Author: davidvtaylor
Date: 2009-08-18 04:55:46 +0000 (Tue, 18 Aug 2009)
Log Message:
-----------
Add initial version of RemObjects AnyDAC v2 broker
- Partially tested on MSSQL 2000/2005 and Firebird 2.1
Added Paths:
-----------
trunk/Source/Brokers/AnyDAC/
|
|
From: <dav...@us...> - 2009-08-18 04:44:43
|
Revision: 840
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=840&view=rev
Author: davidvtaylor
Date: 2009-08-18 04:44:31 +0000 (Tue, 18 Aug 2009)
Log Message:
-----------
Small catalog change to get AnyDAC working with Firebird
Modified Paths:
--------------
branches/BrokerDev/AnyDAC/InstantAnyDACCatalog.pas
Modified: branches/BrokerDev/AnyDAC/InstantAnyDACCatalog.pas
===================================================================
--- branches/BrokerDev/AnyDAC/InstantAnyDACCatalog.pas 2009-08-18 04:42:40 UTC (rev 839)
+++ branches/BrokerDev/AnyDAC/InstantAnyDACCatalog.pas 2009-08-18 04:44:31 UTC (rev 840)
@@ -83,6 +83,7 @@
ADFieldAttrib : TADDataAttributes;
IntValue : integer;
FieldRow : TADDatSRow;
+ ColumnLength : variant;
I : integer;
begin
ConnMetadata := Connector.Connection.ConnectionMetaDataIntf;
@@ -102,7 +103,9 @@
FieldMetadata.Name := ADFieldName;
FieldMetadata.DataType := FieldDataType;
FieldMetadata.AlternateDataTypes := FieldAltDataTypes;
- FieldMetadata.Size := Integer(FieldRow.GetData('COLUMN_LENGTH'));
+ ColumnLength := FieldRow.GetData('COLUMN_LENGTH');
+ if VarIsOrdinal(ColumnLength) then
+ FieldMetadata.Size := Integer(ColumnLength);
FieldMetadata.Options := [];
if (not (caAllowNull in ADFieldAttrib)) then
|
|
From: <dav...@us...> - 2009-08-18 04:42:50
|
Revision: 839
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=839&view=rev
Author: davidvtaylor
Date: 2009-08-18 04:42:40 +0000 (Tue, 18 Aug 2009)
Log Message:
-----------
Add packages to support Delphi 2009
Added Paths:
-----------
branches/BrokerDev/AnyDAC/D2009/
branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dpk
branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dproj
branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.res
branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dpk
branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dproj
branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.res
Added: branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dpk
===================================================================
--- branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dpk (rev 0)
+++ branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dpk 2009-08-18 04:42:40 UTC (rev 839)
@@ -0,0 +1,39 @@
+package DclIOAnyDAC;
+
+{$R *.res}
+{$R '..\InstantAnyDAC.dcr'}
+
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS ON}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'InstantObjects AnyDAC Design-Time Support (Delphi 2009)'}
+{$LIBSUFFIX '_D12'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ IOAnyDAC;
+
+contains
+ InstantAnyDACReg in '..\InstantAnyDACReg.pas';
+
+end.
+
Property changes on: branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dpk
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Id
Added: svn:eol-style
+ native
Added: branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dproj
===================================================================
--- branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dproj (rev 0)
+++ branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dproj 2009-08-18 04:42:40 UTC (rev 839)
@@ -0,0 +1,115 @@
+ <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <ProjectGuid>{672E116D-774F-4C6F-8271-5418FFD47016}</ProjectGuid>
+ <MainSource>DclIOAnyDAC.dpk</MainSource>
+ <Config Condition="'$(Config)'==''">Debug</Config>
+ <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+ <ProjectVersion>12.0</ProjectVersion>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
+ <Cfg_1>true</Cfg_1>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
+ <Cfg_2>true</Cfg_2>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base)'!=''">
+ <DCC_DependencyCheckOutputName>C:\Documents and Settings\All Users\Documents\RAD Studio\6.0\Bpl\DclIOAnyDAC_D12.bpl</DCC_DependencyCheckOutputName>
+ <DesignOnlyPackage>true</DesignOnlyPackage>
+ <DCC_TypedAtParameter>true</DCC_TypedAtParameter>
+ <DCC_Description>InstantObjects AnyDAC Design-Time Support (Delphi 2009)</DCC_Description>
+ <DllSuffix>_D12</DllSuffix>
+ <DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
+ <GenDll>true</GenDll>
+ <GenPackage>true</GenPackage>
+ <DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
+ <DCC_ImageBase>00400000</DCC_ImageBase>
+ <DCC_Platform>x86</DCC_Platform>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1)'!=''">
+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+ <DCC_DebugInformation>false</DCC_DebugInformation>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+ </PropertyGroup>
+ <ItemGroup>
+ <DelphiCompile Include="DclIOAnyDAC.dpk">
+ <MainSource>MainSource</MainSource>
+ </DelphiCompile>
+ <DCCReference Include="..\InstantAnyDAC.dcr"/>
+ <DCCReference Include="IOAnyDAC.dcp"/>
+ <DCCReference Include="..\InstantAnyDACReg.pas"/>
+ <DCCReference Include="..\InstantAnyDAC.dcr"/>
+ <BuildConfiguration Include="Base">
+ <Key>Base</Key>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Debug">
+ <Key>Cfg_2</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Release">
+ <Key>Cfg_1</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ </ItemGroup>
+ <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+ <ProjectExtensions>
+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+ <Borland.ProjectType>Package</Borland.ProjectType>
+ <BorlandProject>
+ <Delphi.Personality>
+ <Source>
+ <Source Name="MainSource">DclIOAnyDAC.dpk</Source>
+ </Source>
+ <Parameters>
+ <Parameters Name="UseLauncher">False</Parameters>
+ <Parameters Name="LoadAllSymbols">True</Parameters>
+ <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
+ </Parameters>
+ <VersionInfo>
+ <VersionInfo Name="IncludeVerInfo">True</VersionInfo>
+ <VersionInfo Name="AutoIncBuild">False</VersionInfo>
+ <VersionInfo Name="MajorVer">1</VersionInfo>
+ <VersionInfo Name="MinorVer">0</VersionInfo>
+ <VersionInfo Name="Release">0</VersionInfo>
+ <VersionInfo Name="Build">0</VersionInfo>
+ <VersionInfo Name="Debug">False</VersionInfo>
+ <VersionInfo Name="PreRelease">False</VersionInfo>
+ <VersionInfo Name="Special">False</VersionInfo>
+ <VersionInfo Name="Private">False</VersionInfo>
+ <VersionInfo Name="DLL">False</VersionInfo>
+ <VersionInfo Name="Locale">1033</VersionInfo>
+ <VersionInfo Name="CodePage">1252</VersionInfo>
+ </VersionInfo>
+ <VersionInfoKeys>
+ <VersionInfoKeys Name="CompanyName"/>
+ <VersionInfoKeys Name="FileDescription"/>
+ <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="InternalName"/>
+ <VersionInfoKeys Name="LegalCopyright"/>
+ <VersionInfoKeys Name="LegalTrademarks"/>
+ <VersionInfoKeys Name="OriginalFilename"/>
+ <VersionInfoKeys Name="ProductName"/>
+ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="Comments"/>
+ </VersionInfoKeys>
+ <Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\bcboffice2k120.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\bcbofficexp120.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\dcloffice2k120.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\dclofficexp120.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
+ </Excluded_Packages>
+ </Delphi.Personality>
+ </BorlandProject>
+ <ProjectFileVersion>12</ProjectFileVersion>
+ </ProjectExtensions>
+ </Project>
Property changes on: branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.dproj
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Id
Added: svn:eol-style
+ native
Added: branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.res
===================================================================
(Binary files differ)
Property changes on: branches/BrokerDev/AnyDAC/D2009/DclIOAnyDAC.res
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
Added: branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dpk
===================================================================
--- branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dpk (rev 0)
+++ branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dpk 2009-08-18 04:42:40 UTC (rev 839)
@@ -0,0 +1,42 @@
+package IOAnyDAC;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS ON}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'InstantObjects AnyDAC Run-Time Support (Delphi 2009)'}
+{$LIBSUFFIX '_D12'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ IOCore,
+ xmlrtl,
+ AnyDAC_Phys_D12,
+ AnyDAC_ComI_D12,
+ AnyDAC_Comp_D12;
+
+contains
+ InstantAnyDAC in '..\InstantAnyDAC.pas',
+ InstantAnyDACCatalog in '..\InstantAnyDACCatalog.pas',
+ InstantAnyDACConnectionDefEdit in '..\InstantAnyDACConnectionDefEdit.pas' {InstantAnyDACConnectionDefEditForm};
+
+end.
Property changes on: branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dpk
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Id
Added: svn:eol-style
+ native
Added: branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dproj
===================================================================
--- branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dproj (rev 0)
+++ branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dproj 2009-08-18 04:42:40 UTC (rev 839)
@@ -0,0 +1,121 @@
+ <Project xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
+ <PropertyGroup>
+ <ProjectGuid>{7F71F3E4-9F89-4489-836B-BA66DB02C802}</ProjectGuid>
+ <MainSource>IOAnyDAC.dpk</MainSource>
+ <Config Condition="'$(Config)'==''">Debug</Config>
+ <DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
+ <ProjectVersion>12.0</ProjectVersion>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Base' or '$(Base)'!=''">
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Release' or '$(Cfg_1)'!=''">
+ <Cfg_1>true</Cfg_1>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Config)'=='Debug' or '$(Cfg_2)'!=''">
+ <Cfg_2>true</Cfg_2>
+ <CfgParent>Base</CfgParent>
+ <Base>true</Base>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Base)'!=''">
+ <DCC_DependencyCheckOutputName>C:\Documents and Settings\All Users\Documents\RAD Studio\6.0\Bpl\IOAnyDAC_D12.bpl</DCC_DependencyCheckOutputName>
+ <DCC_TypedAtParameter>true</DCC_TypedAtParameter>
+ <DCC_Description>InstantObjects AnyDAC Run-Time Support (Delphi 2009)</DCC_Description>
+ <RuntimeOnlyPackage>true</RuntimeOnlyPackage>
+ <DllSuffix>_D12</DllSuffix>
+ <DCC_OutputNeverBuildDcps>true</DCC_OutputNeverBuildDcps>
+ <GenDll>true</GenDll>
+ <DCC_SymbolReferenceInfo>1</DCC_SymbolReferenceInfo>
+ <GenPackage>true</GenPackage>
+ <DCC_ImageBase>00400000</DCC_ImageBase>
+ <DCC_Platform>x86</DCC_Platform>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_1)'!=''">
+ <DCC_LocalDebugSymbols>false</DCC_LocalDebugSymbols>
+ <DCC_Define>RELEASE;$(DCC_Define)</DCC_Define>
+ <DCC_SymbolReferenceInfo>0</DCC_SymbolReferenceInfo>
+ <DCC_DebugInformation>false</DCC_DebugInformation>
+ </PropertyGroup>
+ <PropertyGroup Condition="'$(Cfg_2)'!=''">
+ <DCC_Define>DEBUG;$(DCC_Define)</DCC_Define>
+ </PropertyGroup>
+ <ItemGroup>
+ <DelphiCompile Include="IOAnyDAC.dpk">
+ <MainSource>MainSource</MainSource>
+ </DelphiCompile>
+ <DCCReference Include="IOCore.dcp"/>
+ <DCCReference Include="xmlrtl.dcp"/>
+ <DCCReference Include="AnyDAC_Phys_D12.dcp"/>
+ <DCCReference Include="AnyDAC_ComI_D12.dcp"/>
+ <DCCReference Include="AnyDAC_Comp_D12.dcp"/>
+ <DCCReference Include="..\InstantAnyDAC.pas"/>
+ <DCCReference Include="..\InstantAnyDACCatalog.pas"/>
+ <DCCReference Include="..\InstantAnyDACConnectionDefEdit.pas">
+ <Form>InstantAnyDACConnectionDefEditForm</Form>
+ </DCCReference>
+ <BuildConfiguration Include="Base">
+ <Key>Base</Key>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Debug">
+ <Key>Cfg_2</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ <BuildConfiguration Include="Release">
+ <Key>Cfg_1</Key>
+ <CfgParent>Base</CfgParent>
+ </BuildConfiguration>
+ </ItemGroup>
+ <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/>
+ <ProjectExtensions>
+ <Borland.Personality>Delphi.Personality.12</Borland.Personality>
+ <Borland.ProjectType>Package</Borland.ProjectType>
+ <BorlandProject>
+ <Delphi.Personality>
+ <Source>
+ <Source Name="MainSource">IOAnyDAC.dpk</Source>
+ </Source>
+ <Parameters>
+ <Parameters Name="UseLauncher">False</Parameters>
+ <Parameters Name="LoadAllSymbols">True</Parameters>
+ <Parameters Name="LoadUnspecifiedSymbols">False</Parameters>
+ </Parameters>
+ <VersionInfo>
+ <VersionInfo Name="IncludeVerInfo">True</VersionInfo>
+ <VersionInfo Name="AutoIncBuild">False</VersionInfo>
+ <VersionInfo Name="MajorVer">1</VersionInfo>
+ <VersionInfo Name="MinorVer">0</VersionInfo>
+ <VersionInfo Name="Release">0</VersionInfo>
+ <VersionInfo Name="Build">0</VersionInfo>
+ <VersionInfo Name="Debug">False</VersionInfo>
+ <VersionInfo Name="PreRelease">False</VersionInfo>
+ <VersionInfo Name="Special">False</VersionInfo>
+ <VersionInfo Name="Private">False</VersionInfo>
+ <VersionInfo Name="DLL">False</VersionInfo>
+ <VersionInfo Name="Locale">1033</VersionInfo>
+ <VersionInfo Name="CodePage">1252</VersionInfo>
+ </VersionInfo>
+ <VersionInfoKeys>
+ <VersionInfoKeys Name="CompanyName"/>
+ <VersionInfoKeys Name="FileDescription"/>
+ <VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="InternalName"/>
+ <VersionInfoKeys Name="LegalCopyright"/>
+ <VersionInfoKeys Name="LegalTrademarks"/>
+ <VersionInfoKeys Name="OriginalFilename"/>
+ <VersionInfoKeys Name="ProductName"/>
+ <VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys>
+ <VersionInfoKeys Name="Comments"/>
+ </VersionInfoKeys>
+ <Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\bcboffice2k120.bpl">CodeGear C++Builder Office 2000 Servers Package</Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\bcbofficexp120.bpl">CodeGear C++Builder Office XP Servers Package</Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\dcloffice2k120.bpl">Microsoft Office 2000 Sample Automation Server Wrapper Components</Excluded_Packages>
+ <Excluded_Packages Name="$(BDS)\bin\dclofficexp120.bpl">Microsoft Office XP Sample Automation Server Wrapper Components</Excluded_Packages>
+ </Excluded_Packages>
+ </Delphi.Personality>
+ </BorlandProject>
+ <ProjectFileVersion>12</ProjectFileVersion>
+ </ProjectExtensions>
+ </Project>
Property changes on: branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.dproj
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:keywords
+ Id
Added: svn:eol-style
+ native
Added: branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.res
===================================================================
(Binary files differ)
Property changes on: branches/BrokerDev/AnyDAC/D2009/IOAnyDAC.res
___________________________________________________________________
Added: svn:mime-type
+ application/octet-stream
|
|
From: <dav...@us...> - 2009-08-18 04:25:37
|
Revision: 838
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=838&view=rev
Author: davidvtaylor
Date: 2009-08-18 04:25:29 +0000 (Tue, 18 Aug 2009)
Log Message:
-----------
Remove unused branch for D2009. Development was done on trunk instead
Removed Paths:
-------------
branches/Delphi2009/
|
|
From: <dav...@us...> - 2009-08-17 08:27:28
|
Revision: 837
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=837&view=rev
Author: davidvtaylor
Date: 2009-08-17 08:27:21 +0000 (Mon, 17 Aug 2009)
Log Message:
-----------
New custom made icon for Model Explorer attribute toggle. Bitmap also upgraded from 4-bit to 8-bit
Modified Paths:
--------------
trunk/Source/Design/InstantModelExplorer.dfm
trunk/Source/Design/iodesimages.res
Modified: trunk/Source/Design/InstantModelExplorer.dfm
===================================================================
--- trunk/Source/Design/InstantModelExplorer.dfm 2009-08-17 08:05:05 UTC (rev 836)
+++ trunk/Source/Design/InstantModelExplorer.dfm 2009-08-17 08:27:21 UTC (rev 837)
@@ -84,6 +84,7 @@
Left = 85
Top = 0
Action = ViewAttributesAction
+ ImageIndex = 12
end
end
object AttributePanel: TPanel
Modified: trunk/Source/Design/iodesimages.res
===================================================================
(Binary files differ)
|
|
From: <dav...@us...> - 2009-08-17 08:05:18
|
Revision: 836
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=836&view=rev
Author: davidvtaylor
Date: 2009-08-17 08:05:05 +0000 (Mon, 17 Aug 2009)
Log Message:
-----------
Fix related to rename of UnitName property to PascalUnitName
Modified Paths:
--------------
trunk/Source/Design/InstantClassEditor.dfm
Modified: trunk/Source/Design/InstantClassEditor.dfm
===================================================================
--- trunk/Source/Design/InstantClassEditor.dfm 2009-08-17 06:05:03 UTC (rev 835)
+++ trunk/Source/Design/InstantClassEditor.dfm 2009-08-17 08:05:05 UTC (rev 836)
@@ -89,7 +89,7 @@
Width = 353
Height = 21
Style = csDropDownList
- DataField = 'UnitName'
+ DataField = 'PascalUnitName'
DataSource = SubjectSource
ItemHeight = 13
TabOrder = 2
|
|
From: <dav...@us...> - 2009-08-17 06:05:12
|
Revision: 835
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=835&view=rev
Author: davidvtaylor
Date: 2009-08-17 06:05:03 +0000 (Mon, 17 Aug 2009)
Log Message:
-----------
Fixes and refinements to Model Explorer attribute enhancement and improved IDE menu integration
- Fix for problems where IDE menu images are incorrect after packages are reloaded
- Redesign of IDE menu Action list image handling to use newer INTAServices.AddMasked method
- Remove obsolete menu image handling logic and refactor procedure code into class methods
- Add logic to enable/disable the Model Explorer and Database Builder actions based on project state
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/InstantModelExpert.pas
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2009-08-17 05:52:54 UTC (rev 834)
+++ trunk/Source/Design/InstantModelExpert.pas 2009-08-17 06:05:03 UTC (rev 835)
@@ -77,8 +77,6 @@
FMustUpdateAfterCompile: Boolean;
FResourceModule: TInstantDesignResourceModule;
FSaveApplicationIdle: TIdleEvent;
- FToolImageCount: Integer;
- FToolImageOffset: Integer;
FUpdateDisableCount: Integer;
FUpdateTimer: TTimer;
MetaDataCheckState : TIOMetaDataCheckState;
@@ -113,8 +111,13 @@
function CreateIDEInterface: TInstantOTAIDEInterface;
function CreateUpdateTimer: TTimer;
procedure DetachMenus;
+ procedure DetachMenuActionEvent(AName: string);
procedure EnumSources(Modules: TInterfaceList;
Enumerator: TSourceEnumerator);
+ function FindMenuAction(AName: string; out AAction: TContainedAction): boolean;
+ function FindOrCreateMenuAction(AName, ACaption: string;
+ AEventHandler: TNotifyEvent; AImageIndex : integer = -1;
+ AShortCut: TShortCut = 0): TContainedAction;
procedure CheckIOMetadataKeyword(const FileName, Source: string);
procedure ExplorerItemClick(Sender: TObject);
procedure GetModelModules(Modules: TInterfaceList);
@@ -132,6 +135,7 @@
procedure ShowExplorer;
procedure UpdateModel;
procedure UpdateTimerTick(Sender: TObject);
+ procedure UpdateMenuActions;
property CurrentSource: string read GetCurrentSource;
property Explorer: TInstantModelExplorerForm read GetExplorer;
public
@@ -162,17 +166,16 @@
uses
SysUtils, TypInfo, InstantDesignUtils, InstantUtils, InstantUnitSelect,
- InstantConnectionManager, Dialogs;
+ InstantConnectionManager, Dialogs, Graphics;
const
SIOIdeMenuCategory = 'InstantObjects';
SBuilderItemCaption = 'InstantObjects Database &Builder...';
+ SExplorerItemCaption = 'InstantObjects &Model Explorer';
SBuilderItemName = 'InstantBuilderItem'; // Do not localize
- SExplorerItemCaption = 'InstantObjects &Model Explorer';
SExplorerItemName = 'InstantExplorerItem'; // Do not localize
SExplorerItemActionName = 'InstantExplorerItemAction'; // Do not localize
SBuilderItemActionName = 'InstantBuilderItemAction'; // Do not localize
- SModelCompiler = 'Model Compiler';
SResFileExt = '.mdr';
UpdateInterval = 500;
@@ -189,81 +192,6 @@
InstantCodeReaderIdle := ReaderIdle;
end;
-function FindOrCreateMenuAction(AName, ACaption: string;
- AEventHandler: TNotifyEvent; AImageIndex : integer = -1;
- AShortCut: TShortCut = 0): TContainedAction;
-var
- IdeMainForm: TCustomForm;
- IdeActionList: TCustomActionList;
- NTAServices: INTAServices;
- NewAction: TAction;
- I: integer;
-begin
- // Get the IDE's action list
- NTAServices := BorlandIDEServices as INTAServices;
- Assert(Assigned(NTAServices));
- IdeActionList := NTAServices.ActionList;
- Assert(Assigned(IdeActionList));
-
- // Search for an existing IDE action
- Result := nil;
- for I := 0 to IdeActionList.ActionCount-1 do
- begin
- if (not SameText(IdeActionList.Actions[I].Name, AName)) then
- continue;
- Result := IdeActionList.Actions[I];
- // Reconnect/enable the event handler (package reload)
- Result.OnExecute := AEventHandler;
- if (Result is TCustomAction) then
- TCustomAction(Result).Enabled := true;
- break;
- end;
-
- // Create a new action if not found
- if (not assigned(Result)) then
- begin
- // Get the IDE's main form
- Assert(Assigned(Application));
- IdeMainForm := Application.FindComponent('AppBuilder') as TCustomForm;
-
- // Create and initialize the action
- NewAction := TAction.Create(IdeMainForm);
- NewAction.ActionList := IdeActionList;
- NewAction.Name := AName;
- NewAction.Caption := ACaption;
- NewAction.Category := SIOIdeMenuCategory;
- NewAction.ImageIndex := AImageIndex;
- NewAction.ShortCut := AShortCut;
- NewAction.OnExecute := AEventHandler;
- Result := NewAction;
- end;
-end;
-
-// Searches for an IDE action matching the given name and
-// diables its OnExecute event handlers This avoids an AV
-// if the expert is unloaded (e.g. during a package rebuild)
-procedure DisableMenuAction(AName: string);
-var
- IdeActionList: TCustomActionList;
- NTAServices: INTAServices;
- I: integer;
-begin
- // Get the IDE's action list
- NTAServices := BorlandIDEServices as INTAServices;
- Assert(Assigned(NTAServices));
- IdeActionList := NTAServices.ActionList;
- Assert(Assigned(IdeActionList));
-
- // Search for and diable IDE action
- for I := 0 to IdeActionList.ActionCount-1 do
- begin
- if (not SameText(IdeActionList.Actions[I].Name, AName)) then
- continue;
- IdeActionList.Actions[I].OnExecute := nil;
- break;
- end;
-end;
-
function FindText(const SubStr, Str: string;
var Pos, Line, Column: Integer): Boolean;
var
@@ -546,8 +474,7 @@
FBuilderItem.Action := FindOrCreateMenuAction(
SBuilderItemActionName,
SBuilderItemCaption,
- BuilderItemClick,
- FToolImageOffset + 1,
+ BuilderItemClick, 1,
Menus.ShortCut(Word('B'), [ssCtrl, ssShift]));
end;
@@ -557,18 +484,12 @@
begin
if not Assigned(BorlandIDEServices) then
Exit;
+
MainMenu := (BorlandIDEServices as INTAServices40).MainMenu;
+
if not Assigned(MainMenu) then
Exit;
- { Add images }
- with MainMenu.Images do
- begin
- FToolImageOffset := Count;
- FToolImageCount := FResourceModule.ToolImages.Count;
- AddImages(TCustomImageList(FResourceModule.ToolImages));
- end;
-
{ Add 'Model Explorer' to View-menu }
Menu := ItemByName(MainMenu.Items, 'ViewsMenu');
if Assigned(Menu) then
@@ -578,8 +499,7 @@
FExplorerItem.Action := FindOrCreateMenuAction(
SExplorerItemActionName,
SExplorerItemCaption,
- ExplorerItemClick,
- FToolImageOffset,
+ ExplorerItemClick, 0,
Menus.ShortCut(Word('M'), [ssCtrl, ssShift]));
{$IFDEF D9+}
@@ -658,6 +578,8 @@
UpdateModel;
FActiveProjectName := '';
end;
+
+ UpdateMenuActions;
end;
procedure TInstantModelExpert.CollectModules(Project: IOTAProject;
@@ -758,8 +680,6 @@
destructor TInstantModelExpert.Destroy;
begin
- DisableMenuAction(SBuilderItemActionName);
- DisableMenuAction(SExplorerItemActionName);
Application.OnIdle := FSaveApplicationIdle;
DetachMenus;
FUpdateTimer.Free;
@@ -770,25 +690,32 @@
end;
procedure TInstantModelExpert.DetachMenus;
-var
- MainMenu: TMainMenu;
- I: Integer;
begin
- if not Application.Terminated then
- begin
- { Remove images }
- MainMenu := (BorlandIDEServices as INTAServices40).MainMenu;
- if Assigned(MainMenu) and Assigned(MainMenu.Images) then
- with MainMenu.Images do
- for I := 0 to Pred(FToolImageCount) do
- Delete(FToolImageOffset);
- end;
+ { Unhook action event handlers }
+ DetachMenuActionEvent(SBuilderItemActionName);
+ DetachMenuActionEvent(SExplorerItemActionName);
{ Remove items }
FBuilderItem.Free;
FExplorerItem.Free;
end;
+// Searches for an IDE action matching the given name and disables its
+// OnExecute event handler and sets Visible to False. This disables
+// the action and avoids an AV if the expert is unloaded and the
+// event handler becomes invalid (e.g. during a package rebuild)
+procedure TInstantModelExpert.DetachMenuActionEvent(AName: string);
+var
+ LAction : TContainedAction;
+begin
+ if (FindMenuAction(AName, LAction)) then
+ begin
+ LAction.OnExecute := nil;
+ if (LAction is TCustomAction) then
+ TCustomAction(LAction).Visible := False;
+ end;
+end;
+
procedure TInstantModelExpert.DisableUpdate;
begin
Inc(FUpdateDisableCount);
@@ -855,6 +782,91 @@
LoadModel(Model);
end;
+// Searches for an IDE action matching the given name
+function TInstantModelExpert.FindMenuAction(AName: string;
+ out AAction: TContainedAction): boolean;
+var
+ IdeActionList: TCustomActionList;
+ NTAServices: INTAServices;
+ I: integer;
+begin
+ // Get the IDE's action list
+ NTAServices := BorlandIDEServices as INTAServices;
+ Assert(Assigned(NTAServices));
+ IdeActionList := NTAServices.ActionList;
+ Assert(Assigned(IdeActionList));
+
+ // Search for and diable IDE action
+ AAction := nil;
+
+ for I := 0 to IdeActionList.ActionCount-1 do
+ begin
+ if (not SameText(IdeActionList.Actions[I].Name, AName)) then
+ continue;
+ AAction := IdeActionList.Actions[I];
+ break;
+ end;
+
+ Result := assigned(AAction);
+end;
+
+function TInstantModelExpert.FindOrCreateMenuAction(AName, ACaption: string;
+ AEventHandler: TNotifyEvent; AImageIndex : integer = -1;
+ AShortCut: TShortCut = 0): TContainedAction;
+var
+ NTAServices: INTAServices;
+ IdeMainForm: TCustomForm;
+ IdeActionList: TCustomActionList;
+ NewAction: TAction;
+ ActionImage: TBitmap;
+begin
+ if (FindMenuAction(AName, Result)) then
+ begin
+ // Enable action and connect the event handler
+ Result.OnExecute := AEventHandler;
+ if (Result is TCustomAction) then
+ begin
+ TCustomAction(Result).Enabled := true;
+ TCustomAction(Result).Visible := true;
+ end;
+ end else
+ begin
+ // Get the IDE's main form
+ Assert(Assigned(Application));
+ IdeMainForm := Application.FindComponent('AppBuilder') as TCustomForm;
+
+ // Get the IDE's action list
+ NTAServices := (BorlandIDEServices as INTAServices);
+ Assert(Assigned(NTAServices));
+ IdeActionList := NTAServices.ActionList;
+ Assert(Assigned(IdeActionList));
+
+ // Create and initialize the action
+ NewAction := TAction.Create(IdeMainForm);
+ NewAction.ActionList := IdeActionList;
+ NewAction.Name := AName;
+ NewAction.Caption := ACaption;
+ NewAction.Category := SIOIdeMenuCategory;
+ NewAction.ShortCut := AShortCut;
+ NewAction.OnExecute := AEventHandler;
+ Result := NewAction;
+
+ if (AImageIndex >= 0) and (AImageIndex < FResourceModule.ToolImages.Count) then
+ begin
+ ActionImage := TBitmap.Create;
+
+ try
+ FResourceModule.ToolImages.GetBitmap(AImageIndex,ActionImage);
+ Assert(Assigned(ActionImage));
+ NewAction.ImageIndex := NTAServices.AddMasked(ActionImage,
+ ActionImage.TransparentColor,AName);
+ finally
+ FreeAndNil(ActionImage);
+ end;
+ end;
+ end;
+end;
+
function TInstantModelExpert.GetActiveProject: IOTAProject;
begin
with FIDEInterface do
@@ -1273,6 +1285,25 @@
UpdateModel;
end;
+procedure TInstantModelExpert.UpdateMenuActions;
+
+ procedure EnableMenuItem(const AMenuItem: TMenuItem; AEnable: boolean);
+ begin
+ if (assigned(AMenuItem)) then
+ if (AMenuItem.Action is TCustomAction) then
+ TCustomAction(AMenuItem.Action).Enabled := AEnable;
+ end;
+
+var
+ HaveProject: boolean;
+ HaveModel: boolean;
+begin
+ HaveProject := Assigned(ActiveProject);
+ HaveModel := Explorer.Model.ModuleCount > 0;
+ EnableMenuItem(FExplorerItem, HaveProject);
+ EnableMenuItem(FBuilderItem, HaveModel);
+end;
+
procedure TInstantModelExpert.CheckIOMetadataKeyword(const FileName, Source: string);
begin
if pos('{ stored', Source) > 0 then
|
|
From: <dav...@us...> - 2009-08-17 05:53:04
|
Revision: 834
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=834&view=rev
Author: davidvtaylor
Date: 2009-08-17 05:52:54 +0000 (Mon, 17 Aug 2009)
Log Message:
-----------
Enhancement to Connection Manager form to deal with case where no broker packages are installed
- "New" context menu now displays "No Brokers Installed" message if no brokers are loaded
Modified Paths:
--------------
trunk/Source/Core/InstantConnectionManagerFormUnit.pas
Modified: trunk/Source/Core/InstantConnectionManagerFormUnit.pas
===================================================================
--- trunk/Source/Core/InstantConnectionManagerFormUnit.pas 2009-08-17 05:47:44 UTC (rev 833)
+++ trunk/Source/Core/InstantConnectionManagerFormUnit.pas 2009-08-17 05:52:54 UTC (rev 834)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta, Nando Dessena
+ * Carlo Barazzetta, Nando Dessena, David Taylor
*
* ***** END LICENSE BLOCK ***** *)
@@ -183,6 +183,9 @@
InstantImageUtils, InstantConsts, InstantDBEvolverFormUnit,
InstantDBBuilderFormUnit;
+const
+ SNoConnectorsFound = '< No Brokers Installed >';
+
procedure DefaultConnectionManagerExecutor(ConnectionManager: TInstantConnectionManager);
var
ConnectionManagerForm: TInstantConnectionManagerForm;
@@ -717,6 +720,13 @@
Item.OnClick := NewMenuItemClick;
NewMenu.Add(Item);
end;
+
+ if (ConnectorClassList.Count < 1) then
+ begin
+ Item := TMenuItem.Create(NewMenu);
+ Item.Caption := SNoConnectorsFound;
+ NewMenu.Add(Item);
+ end;
finally
ConnectorClassList.Free;
end;
|
|
From: <dav...@us...> - 2009-08-17 05:47:52
|
Revision: 833
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=833&view=rev
Author: davidvtaylor
Date: 2009-08-17 05:47:44 +0000 (Mon, 17 Aug 2009)
Log Message:
-----------
Fix minor form height issue cause Close button to be clipped on Evolver and Builder forms
Modified Paths:
--------------
trunk/Source/Core/InstantCustomDBEvolverFormUnit.dfm
Modified: trunk/Source/Core/InstantCustomDBEvolverFormUnit.dfm
===================================================================
--- trunk/Source/Core/InstantCustomDBEvolverFormUnit.dfm 2009-08-17 03:57:48 UTC (rev 832)
+++ trunk/Source/Core/InstantCustomDBEvolverFormUnit.dfm 2009-08-17 05:47:44 UTC (rev 833)
@@ -2,7 +2,7 @@
Left = 244
Top = 191
Width = 601
- Height = 360
+ Height = 370
Caption = 'InstantCustomDBEvolverForm'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
|
|
From: <dav...@us...> - 2009-08-17 03:57:57
|
Revision: 832
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=832&view=rev
Author: davidvtaylor
Date: 2009-08-17 03:57:48 +0000 (Mon, 17 Aug 2009)
Log Message:
-----------
Fix for FileAge deprecation warning in InstantModelExpert. Single argument version was deprecated in D2006.
- Added InstantFileAge function to InstantUtils with same signature as new FileAge function
- Replaced calls to FileAge with calls to InstantFileAge
Modified Paths:
--------------
trunk/Source/Core/InstantUtils.pas
trunk/Source/Design/InstantModelExpert.pas
Modified: trunk/Source/Core/InstantUtils.pas
===================================================================
--- trunk/Source/Core/InstantUtils.pas 2009-08-16 17:38:57 UTC (rev 831)
+++ trunk/Source/Core/InstantUtils.pas 2009-08-17 03:57:48 UTC (rev 832)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Uberto Barbini,
- * Brian Andersen
+ * Brian Andersen, David Taylor
*
* ***** END LICENSE BLOCK ***** *)
@@ -60,6 +60,7 @@
function InstantConstArrayToVariant(AValues : array of const) : Variant;
function InstantDateTimeToStr(DateTime: TDateTime): string;
function InstantEmbrace(const S, Delimiters: string): string;
+function InstantFileAge(const FileName: string; out FileDateTime: TDateTime): boolean;
{$IFDEF MSWINDOWS}
function InstantFileVersionValue(const FileName, ValueName: string): string;
function InstantFileVersion(const FileName: string): TInstantVersion;
@@ -269,6 +270,22 @@
Result := LeftDelimiter + S + RightDelimiter;
end;
+function InstantFileAge(const FileName: string; out FileDateTime: TDateTime): boolean;
+{$IFNDEF D10+}
+var
+ LFileAge : integer;
+{$ENDIF}
+begin
+ {$IFDEF D10+} // Single param FileAge deprecated in D2006
+ Result := FileAge(FileName, FileDateTime);
+ {$ELSE}
+ LFileAge := FileAge(FileName);
+ Result := (LFileAge <> -1);
+ if (Result) then
+ FileDateTime := FileDateToDateTime(LFileAge);
+ {$ENDIF}
+end;
+
{$IFDEF MSWINDOWS}
function InstantFileVersionStr(const FileName: string): string;
begin
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2009-08-16 17:38:57 UTC (rev 831)
+++ trunk/Source/Design/InstantModelExpert.pas 2009-08-17 03:57:48 UTC (rev 832)
@@ -692,17 +692,16 @@
var
Model: TInstantCodeModel;
ResFileName: string;
- ResFileAge: Integer;
ResFileTime: TDateTime;
begin
DisableUpdate;
Model := TInstantCodeModel.Create;
try
ResFileName := ChangeFileExt(Project.FileName, SResFileExt);
- ResFileAge := FileAge(ResFileName);
- if ResFileAge = -1 then
- ResFileTime := 0 else
- ResFileTime := FileDateToDateTime(ResFileAge);
+
+ if (not InstantFileAge(ResFileName, ResFileTime)) then
+ ResFileTime := 0;
+
try
if LoadModel(Model, Project, ResFileTime) then
Model.SaveToResFile(ResFileName);
@@ -1037,13 +1036,12 @@
function FileModified(const FileName: string; Since: TDateTime): Boolean;
var
- Age: Integer;
+ FileTime: TDateTime;
begin
- Age := FileAge(FileName);
- if Age = -1 then
+ if (not InstantFileAge(FileName, FileTime)) then
Result := False
else
- Result := FileDateToDateTime(Age) > Since;
+ Result := (FileTime > Since);
end;
function ModuleModified(Module: IOTAModule; Since: TDateTime): Boolean;
|
|
From: <na...@us...> - 2009-08-16 17:39:04
|
Revision: 831
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=831&view=rev
Author: nandod
Date: 2009-08-16 17:38:57 +0000 (Sun, 16 Aug 2009)
Log Message:
-----------
* Fixed some "deprecated" warning in the DBX broker under D2007+.
Modified Paths:
--------------
trunk/Source/Brokers/DBX/InstantDBX.pas
Modified: trunk/Source/Brokers/DBX/InstantDBX.pas
===================================================================
--- trunk/Source/Brokers/DBX/InstantDBX.pas 2009-08-16 16:59:53 UTC (rev 830)
+++ trunk/Source/Brokers/DBX/InstantDBX.pas 2009-08-16 17:38:57 UTC (rev 831)
@@ -46,7 +46,7 @@
QControls,
{$ENDIF}
Classes, DB,
- {$IFNDEF D11+}DBXpress,{$ENDIF}
+ {$IFNDEF D11+}DBXpress,{$ELSE}DBXCommon,{$ENDIF}
SqlExpr, InstantPersistence, InstantCommand,
InstantBrokers, InstantMetadata, InstantTypes;
@@ -74,17 +74,21 @@
property VendorLib: string read FVendorLib write FVendorLib;
end;
+ TInstantDBXTransaction = class;
+
TInstantDBXConnector = class(TInstantConnectionBasedConnector)
private
- FTransactionDesc: TTransactionDesc;
+ FTransaction: TInstantDBXTransaction;
FOnLogin: TSQLConnectionLoginEvent;
function GetConnection: TSQLConnection;
procedure SetConnection(Value: TSQLConnection);
function GetCanTransaction: Boolean;
+ function GetTransaction: TInstantDBXTransaction;
+ function CreateTransaction: TInstantDBXTransaction;
+ property Transaction: TInstantDBXTransaction read GetTransaction;
protected
- procedure AssignLoginOptions; override;//CB
+ procedure AssignLoginOptions; override;
function CreateBroker: TInstantBroker; override;
- procedure InitTransactionDesc(var ATransactionDesc: TTransactionDesc); virtual;
procedure InternalCommitTransaction; override;
procedure InternalRollbackTransaction; override;
procedure InternalStartTransaction; override;
@@ -92,6 +96,7 @@
procedure InternalBuildDatabase(Scheme: TInstantScheme); override;
public
class function ConnectionDefClass: TInstantConnectionDefClass; override;
+ destructor Destroy; override;
property CanTransaction: Boolean read GetCanTransaction;
published
property Connection: TSQLConnection read GetConnection write SetConnection;
@@ -221,6 +226,50 @@
function DataTypeToColumnType(DataType: TInstantDataType; Size: Integer): string; override;
end;
+ {
+ Base class for handling transactions. Concrete descendants handle
+ transactions differently in different versions of DBX.
+ }
+ TInstantDBXTransaction = class
+ private
+ FConnector: TInstantDBXConnector;
+ protected
+ property Connector: TInstantDBXConnector read FConnector;
+ public
+ constructor Create(const AConnector: TInstantDBXConnector); virtual;
+ procedure Start; virtual; abstract;
+ procedure Commit; virtual; abstract;
+ procedure Rollback; virtual; abstract;
+ end;
+
+ {
+ Handles transactions in DBX3.
+ }
+ {$IFNDEF D11+}
+ TInstantDBX3Transaction = class(TInstantDBXTransaction)
+ private
+ FTransactionDesc: TTransactionDesc;
+ public
+ procedure Start; override;
+ procedure Commit; override;
+ procedure Rollback; override;
+ end;
+ {$ENDIF}
+
+ {
+ Handles transactions in DBX4.
+ }
+ {$IFDEF D11+}
+ TInstantDBX4Transaction = class(TInstantDBXTransaction)
+ private
+ FTransaction: TDBXTransaction;
+ public
+ procedure Start; override;
+ procedure Commit; override;
+ procedure Rollback; override;
+ end;
+ {$ENDIF}
+
implementation
uses
@@ -279,13 +328,28 @@
Result := inherited Connection as TSQLConnection;
end;
-procedure TInstantDBXConnector.InitTransactionDesc(
- var ATransactionDesc: TTransactionDesc);
+function TInstantDBXConnector.GetTransaction: TInstantDBXTransaction;
begin
- ATransactionDesc.TransactionID := 1;
- ATransactionDesc.GlobalID := 0;
+ if not Assigned(FTransaction) then
+ FTransaction := CreateTransaction;
+ Result := FTransaction;
end;
+function TInstantDBXConnector.CreateTransaction: TInstantDBXTransaction;
+begin
+ {$IFDEF D11+}
+ Result := TInstantDBX4Transaction.Create(Self);
+ {$ELSE}
+ Result := TInstantDBX3Transaction.Create(Self);
+ {$ENDIF}
+end;
+
+destructor TInstantDBXConnector.Destroy;
+begin
+ FreeAndNil(FTransaction);
+ inherited;
+end;
+
procedure TInstantDBXConnector.InternalBuildDatabase(Scheme: TInstantScheme);
begin
StartTransaction;
@@ -301,22 +365,19 @@
procedure TInstantDBXConnector.InternalCommitTransaction;
begin
if CanTransaction then
- Connection.Commit(FTransactionDesc);
+ Transaction.Commit;
end;
procedure TInstantDBXConnector.InternalRollbackTransaction;
begin
if CanTransaction then
- Connection.Rollback(FTransactionDesc);
+ Transaction.Rollback;
end;
procedure TInstantDBXConnector.InternalStartTransaction;
begin
if CanTransaction then
- begin
- InitTransactionDesc(FTransactionDesc);
- Connection.StartTransaction(FTransactionDesc);
- end;
+ Transaction.Start;
end;
function TInstantDBXConnector.ParamByName(const AName: string): string;
@@ -807,6 +868,60 @@
Result := 'Firebird';
end;
+{ TInstantDBXTransaction }
+
+constructor TInstantDBXTransaction.Create(const AConnector: TInstantDBXConnector);
+begin
+ Assert(Assigned(AConnector));
+
+ inherited Create;
+ FConnector := AConnector;
+end;
+
+{ TInstantDBX3Transaction }
+
+{$IFNDEF D11+}
+procedure TInstantDBX3Transaction.Commit;
+begin
+ Connector.Connection.Commit(FTransactionDesc);
+end;
+
+procedure TInstantDBX3Transaction.Rollback;
+begin
+ Connector.Connection.Rollback(FTransactionDesc);
+end;
+
+procedure TInstantDBX3Transaction.Start;
+begin
+ if FTransactionDesc.TransactionID = MAXLONG then
+ FTransactionDesc.TransactionID := 1
+ else
+ FTransactionDesc.TransactionID := FTransactionDesc.TransactionID + 1;
+ FTransactionDesc.IsolationLevel :=
+ TransIsolationLevelMap[Database.TransIsolation];
+ Connector.Connection.StartTransaction(FTransactionDesc);
+end;
+{$ENDIF}
+
+{ TInstantDBX4Transaction }
+
+{$IFDEF D11+}
+procedure TInstantDBX4Transaction.Commit;
+begin
+ Connector.Connection.CommitFreeAndNil(FTransaction);
+end;
+
+procedure TInstantDBX4Transaction.Rollback;
+begin
+ Connector.Connection.RollbackFreeAndNil(FTransaction);
+end;
+
+procedure TInstantDBX4Transaction.Start;
+begin
+ FTransaction := Connector.Connection.BeginTransaction;
+end;
+{$ENDIF}
+
initialization
RegisterClass(TInstantDBXConnectionDef);
TInstantDBXConnector.RegisterClass;
|
|
From: <na...@us...> - 2009-08-16 17:00:02
|
Revision: 830
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=830&view=rev
Author: nandod
Date: 2009-08-16 16:59:53 +0000 (Sun, 16 Aug 2009)
Log Message:
-----------
+ New validation framework; initial implementation substitutes TInstantAttributeMatadata.ValidChars; can be extended. Tests added.
- Removed unused TChars support in filers. Limited use of TChars (ANSI-only) to where strictly necessary.
* Fixed: writing to a blob did not always correctly set IsChanged (historical error, probably).
* Fixed: ValidChars was not always correctly applied in blob fields (historical error, probably),
* Removed a few warnings on D2007/D2009.
Modified Paths:
--------------
trunk/Source/Brokers/ADO/InstantADOTools.pas
trunk/Source/Brokers/ADS/InstantADS.pas
trunk/Source/Core/D2007/IOCore.dpk
trunk/Source/Core/D2007/IOCore.dproj
trunk/Source/Core/D2009/IOCore.dpk
trunk/Source/Core/D2009/IOCore.dproj
trunk/Source/Core/D2009/IOCore.res
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantCode.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantMetadata.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
trunk/Source/Core/InstantUtils.pas
trunk/Source/Design/InstantModelExpert.pas
trunk/Source/Design/InstantModelImport.pas
trunk/Tests/TestIO.dproj
trunk/Tests/TestIO_D2009.mdr
trunk/Tests/TestIO_D2009.mdrt
trunk/Tests/TestIO_D2009.mdx
trunk/Tests/TestIO_D2009.mdxt
trunk/Tests/TestInstantAttributeMetadata.pas
trunk/Tests/TestInstantBlob.pas
trunk/Tests/TestInstantParts.pas
trunk/Tests/TestInstantReferences.pas
trunk/Tests/TestModel.pas
trunk/Tests/ubmock/src/fpcunit.pas
Added Paths:
-----------
trunk/Source/Core/InstantStandardValidators.pas
trunk/Source/Core/InstantValidation.pas
Property Changed:
----------------
trunk/Source/Brokers/ADO/
trunk/Source/Brokers/ADS/
trunk/Source/Core/D2009/
trunk/Tests/ubmock/src/
Property changes on: trunk/Source/Brokers/ADO
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.~pas
*.~dfm
+ *.dcu
*.~pas
*.~dfm
__history
Modified: trunk/Source/Brokers/ADO/InstantADOTools.pas
===================================================================
--- trunk/Source/Brokers/ADO/InstantADOTools.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Brokers/ADO/InstantADOTools.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -32,7 +32,7 @@
interface
uses
- ADODB, InstantADOJRO, SysUtils;
+ ADODB, InstantADOJRO;
type
TInstantADOSyncType = (stSend, stReceive, stSendReceive);
@@ -51,6 +51,9 @@
implementation
+uses
+ Windows, SysUtils;
+
const
SMSJetProvider = 'Microsoft.Jet.OLEDB.4.0';
Property changes on: trunk/Source/Brokers/ADS
___________________________________________________________________
Added: svn:ignore
+ __history
Modified: trunk/Source/Brokers/ADS/InstantADS.pas
===================================================================
--- trunk/Source/Brokers/ADS/InstantADS.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Brokers/ADS/InstantADS.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -178,13 +178,13 @@
function TInstantADSConnectionDef.GetDatabaseName: string;
const
- ValidChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+ LValidChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
var
I: Integer;
begin
Result := Name;
for I := 1 to Length(Result) do
- if not (Result[I] in ValidChars) then
+ if not (Result[I] in LValidChars) then
Result[I] := '_';
end;
Modified: trunk/Source/Core/D2007/IOCore.dpk
===================================================================
--- trunk/Source/Core/D2007/IOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2007/IOCore.dpk 2009-08-16 16:59:53 UTC (rev 830)
@@ -56,6 +56,8 @@
InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm},
InstantTypes in '..\InstantTypes.pas',
InstantBrokers in '..\InstantBrokers.pas',
- InstantMetadata in '..\InstantMetadata.pas';
+ InstantMetadata in '..\InstantMetadata.pas',
+ InstantStandardValidators in '..\InstantStandardValidators.pas',
+ InstantValidation in '..\InstantValidation.pas';
end.
Modified: trunk/Source/Core/D2007/IOCore.dproj
===================================================================
--- trunk/Source/Core/D2007/IOCore.dproj 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2007/IOCore.dproj 2009-08-16 16:59:53 UTC (rev 830)
@@ -6,7 +6,7 @@
<Configuration Condition=" '$(Configuration)' == '' ">Debug</Configuration>
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<DCC_DCCCompiler>DCC32</DCC_DCCCompiler>
- <DCC_DependencyCheckOutputName>..\..\..\..\..\..\..\Documents\RAD Studio\5.0\Bpl\IOCore_D11.bpl</DCC_DependencyCheckOutputName>
+ <DCC_DependencyCheckOutputName>C:\Users\nandod\Documents\RAD Studio\5.0\Bpl\IOCore_D11.bpl</DCC_DependencyCheckOutputName>
</PropertyGroup>
<PropertyGroup Condition=" '$(Configuration)|$(Platform)' == 'Release|AnyCPU' ">
<Version>7.0</Version>
@@ -24,17 +24,16 @@
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>Package</Borland.ProjectType>
<BorlandProject>
-<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages"></Compiler></Compiler><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">InstantObjects Run-Time Package (Delphi 2007)</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">_D11</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">2</VersionInfo><VersionInfo Name="MinorVer">1</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1040</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">www.instantobjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">IOCore.dpk</Source></Source>
- </Delphi.Personality></BorlandProject></BorlandProject>
+<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages"></Compiler></Compiler><Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Package_Options><Package_Options Name="PackageDescription">InstantObjects Run-Time Package (Delphi 2007)</Package_Options><Package_Options Name="ImplicitBuild">False</Package_Options><Package_Options Name="DesigntimeOnly">False</Package_Options><Package_Options Name="RuntimeOnly">True</Package_Options><Package_Options Name="LibSuffix">_D11</Package_Options></Package_Options><VersionInfo><VersionInfo Name="IncludeVerInfo">True</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">2</VersionInfo><VersionInfo Name="MinorVer">1</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">1040</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName">www.instantobjects.org</VersionInfoKeys><VersionInfoKeys Name="FileDescription">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="FileVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName">InstantObjects</VersionInfoKeys><VersionInfoKeys Name="ProductVersion">2.1.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">IOCore.dpk</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
<DelphiCompile Include="IOCore.dpk">
<MainSource>MainSource</MainSource>
</DelphiCompile>
- <DCCReference Include="..\..\PackageGroups\D2007\rtl.dcp" />
- <DCCReference Include="..\..\PackageGroups\D2007\vcl.dcp" />
- <DCCReference Include="..\..\PackageGroups\D2007\vcldb.dcp" />
+ <DCCReference Include="..\..\..\Tests\rtl.dcp" />
+ <DCCReference Include="..\..\..\Tests\vcl.dcp" />
+ <DCCReference Include="..\..\..\Tests\vcldb.dcp" />
<DCCReference Include="..\InstantAccessors.pas" />
<DCCReference Include="..\InstantBrokers.pas" />
<DCCReference Include="..\InstantClasses.pas" />
@@ -64,8 +63,10 @@
<DCCReference Include="..\InstantPresentation.pas" />
<DCCReference Include="..\InstantPump.pas" />
<DCCReference Include="..\InstantRtti.pas" />
+ <DCCReference Include="..\InstantStandardValidators.pas" />
<DCCReference Include="..\InstantTextFiler.pas" />
<DCCReference Include="..\InstantTypes.pas" />
<DCCReference Include="..\InstantUtils.pas" />
+ <DCCReference Include="..\InstantValidation.pas" />
</ItemGroup>
</Project>
\ No newline at end of file
Property changes on: trunk/Source/Core/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
*.identcache
+ *.dcu
*.local
*.identcache
__history
Modified: trunk/Source/Core/D2009/IOCore.dpk
===================================================================
--- trunk/Source/Core/D2009/IOCore.dpk 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2009/IOCore.dpk 2009-08-16 16:59:53 UTC (rev 830)
@@ -56,6 +56,8 @@
InstantDBBuilderFormUnit in '..\InstantDBBuilderFormUnit.pas' {InstantDBBuilderForm},
InstantTypes in '..\InstantTypes.pas',
InstantBrokers in '..\InstantBrokers.pas',
- InstantMetadata in '..\InstantMetadata.pas';
+ InstantMetadata in '..\InstantMetadata.pas',
+ InstantStandardValidators in '..\InstantStandardValidators.pas',
+ InstantValidation in '..\InstantValidation.pas';
end.
Modified: trunk/Source/Core/D2009/IOCore.dproj
===================================================================
--- trunk/Source/Core/D2009/IOCore.dproj 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/D2009/IOCore.dproj 2009-08-16 16:59:53 UTC (rev 830)
@@ -86,6 +86,8 @@
<DCCReference Include="..\InstantTypes.pas"/>
<DCCReference Include="..\InstantBrokers.pas"/>
<DCCReference Include="..\InstantMetadata.pas"/>
+ <DCCReference Include="..\InstantStandardValidators.pas"/>
+ <DCCReference Include="..\InstantValidation.pas"/>
<BuildConfiguration Include="Base">
<Key>Base</Key>
</BuildConfiguration>
Modified: trunk/Source/Core/D2009/IOCore.res
===================================================================
(Binary files differ)
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -50,11 +50,7 @@
InstantBufferSize = 4096;
type
-{$IFDEF D12+}
- TChars = set of AnsiChar; // Avoid WideChar reduced to byte warning
-{$ELSE}
- TChars = set of Char;
-{$ENDIF}
+ TChars = set of AnsiChar;
{$IFDEF LINUX}
TDate = type TDateTime;
@@ -179,7 +175,6 @@
public
constructor Create(Stream: TStream; BufSize: Integer = InstantBufferSize);
procedure ReadBinary(ReadData: TStreamProc);
- function ReadCharSet: TChars;
function ReadObject(AObject: TPersistent = nil;
Arg: Pointer = nil): TPersistent; virtual;
procedure ReadProperties(AObject: TPersistent);
@@ -195,7 +190,6 @@
public
constructor Create(Stream: TStream; BufSize: Integer = InstantBufferSize);
procedure WriteBinary(WriteData: TStreamProc);
- procedure WriteCharSet(CharSet: TChars);
procedure WriteObject(AObject: TPersistent); virtual;
procedure WriteProperties(AObject: TPersistent);
{$IFNDEF UNICODE}
@@ -976,11 +970,6 @@
end;
end;
-function TInstantReader.ReadCharSet: TChars;
-begin
- Result := InstantStrToCharSet(ReadStr);
-end;
-
function TInstantReader.ReadObject(AObject: TPersistent;
Arg: Pointer): TPersistent;
@@ -1068,11 +1057,6 @@
inherited WriteBinary(WriteData);
end;
-procedure TInstantWriter.WriteCharSet(CharSet: TChars);
-begin
- WriteStr(InstantCharSetToStr(CharSet));
-end;
-
procedure TInstantWriter.WriteObject(AObject: TPersistent);
begin
WriteUTF8Str(AObject.ClassName);
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantCode.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -871,12 +871,12 @@
function GetSubClass(Index: Integer): TInstantCodeClass;
function GetSubClassCount: Integer;
function GetSubClassList: TList;
- function GetUnitName: string;
+ function GetPascalUnitName: string;
procedure SetBaseClass(const Value: TInstantCodeClass);
procedure SetBaseClassName(const Value: string);
procedure SetPersistence(const Value: TInstantPersistence);
procedure SetStorageName(const Value: string);
- procedure SetUnitName(const Value: string);
+ procedure SetPascalUnitName(const Value: string);
procedure RemoveDivision(Division: TInstantCodeDivision);
procedure SetSubClass(Index: Integer; const Value: TInstantCodeClass);
protected
@@ -959,7 +959,7 @@
property BaseClassName: string read GetBaseClassName write SetBaseClassName;
property Persistence: TInstantPersistence read GetPersistence write SetPersistence;
property StorageName: string read GetStorageName write SetStorageName;
- property UnitName: string read GetUnitName write SetUnitName;
+ property PascalUnitName: string read GetPascalUnitName write SetPascalUnitName;
end;
TInstantCodeClassList = class(TList)
@@ -1258,7 +1258,7 @@
function GetProgramSection: TInstantCodeProgramSection;
function GetTypeCount: Integer;
function GetTypes(Index: Integer): TInstantCodeType;
- function GetUnitName: string;
+ function GetPascalUnitName: string;
procedure SetModuleTypeName(const Value: string);
protected
function GetModule: TInstantCodeModule; override;
@@ -1291,7 +1291,7 @@
property TypeCount: Integer read GetTypeCount;
property Types[Index: Integer]: TInstantCodeType read GetTypes;
published
- property UnitName: string read GetUnitName;
+ property PascalUnitName: string read GetPascalUnitName;
end;
TInstantCodeProject = class(TInstantCodeObject)
@@ -5251,9 +5251,9 @@
Result := FSubClassList;
end;
-function TInstantCodeClass.GetUnitName: string;
+function TInstantCodeClass.GetPascalUnitName: string;
begin
- Result := Module.UnitName;
+ Result := Module.PascalUnitName;
end;
class function TInstantCodeClass.Identifier: string;
@@ -5439,7 +5439,7 @@
SubClassList[Index] := Value;
end;
-procedure TInstantCodeClass.SetUnitName(const Value: string);
+procedure TInstantCodeClass.SetPascalUnitName(const Value: string);
var
NewModule: TInstantCodeModule;
begin
@@ -6986,7 +6986,7 @@
Result := TInstantCodeType(FTypes[Index]);
end;
-function TInstantCodeModule.GetUnitName: string;
+function TInstantCodeModule.GetPascalUnitName: string;
begin
Result := ChangeFileExt(ExtractFileName(Name), '');
end;
@@ -7006,7 +7006,7 @@
procedure TInstantCodeModule.InternalWrite(Writer: TInstantCodeWriter);
begin
- Writer.WriteLnFmt('%s %s;', [ModuleTypeName, UnitName]);
+ Writer.WriteLnFmt('%s %s;', [ModuleTypeName, PascalUnitName]);
Writer.WriteLn;
InterfaceSection.Write(Writer);
ImplementationSection.Write(Writer);
Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantConsts.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -132,7 +132,7 @@
SInitializationFailed = 'Initialization failed for object of class %s: "%s"';
SInvalidArgument = 'Invalid argument for object of class %s. Expected argument of class %s';
SInvalidAttributeValue = 'Invalid value "%s" for attribute %s(''%s'')';
- SInvalidChar = 'Invalid character ''%s'' (#%d) for attribute %s(''%s'')';
+ SInvalidChar = 'Invalid character ''%s'' (#%d). Valid characters are ''%s''';
SInvalidClass = 'Invalid class %s. Expected %s';
SInvalidConnector = 'Invalid connector for object %s(''%s'') in attribute %s(''%s'')';
SInvalidDataType = 'Invalid data type';
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantMetadata.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -40,7 +40,8 @@
interface
-uses Classes, Contnrs, Db, InstantClasses, InstantTypes, InstantConsts;
+uses
+ Classes, Contnrs, Db, InstantClasses, InstantTypes, InstantConsts;
type
TInstantAttributeMap = class;
@@ -430,6 +431,33 @@
write SetItems; default;
end;
+ TInstantValidator = class
+ private
+ FMetadata: TInstantAttributeMetadata;
+ public
+ // A reference to the metadata. Should be set by CreateValidator on
+ // the created instance.
+ property Metadata: TInstantAttributeMetadata read FMetadata write FMetadata;
+ // Creates and returns a validator instance suitable for the specified
+ // metadata, or nil if the class doesn't apply to the metadata.
+ { TODO : extend this to support class-level validation? }
+ class function CreateValidator(const AMetadata: TInstantAttributeMetadata):
+ TInstantValidator; virtual;
+ // Should check the value against the validation settings
+ // that are specific for each derived class, and return
+ // True if the value is valid for the attribute.
+ // Otherwise, this method should return False and set an appropriate
+ // error message in AValidationErrorText.
+ // When this method is called, AAttribute is guaranteed to be assigned.
+ function IsValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean; virtual; abstract;
+ // Raises an exception if the proposed value is not valid for
+ // the attribute.
+ procedure Validate(const AAttribute: TInstantAbstractAttribute; const AValue: string);
+ end;
+
+ TInstantValidatorClass = class of TInstantValidator;
+
TInstantAttributeMetadata = class(TInstantMetadata)
private
FAttributeType: TInstantAttributeType;
@@ -442,9 +470,10 @@
FObjectClassName: string;
FSize: Integer;
FStorageName: string;
- FValidChars: TChars;
+ FValidCharsString: string;
FStorageKind: TInstantStorageKind;
FExternalStorageName: string;
+ FValidator: TInstantValidator;
function GetAttributeClass: TInstantAbstractAttributeClass;
function GetAttributeClassName: string;
function GetAttributeTypeName: string;
@@ -458,7 +487,6 @@
function GetObjectClass: TInstantAbstractObjectClass;
function GetObjectClassMetadata: TInstantClassMetadata;
function GetTableName: string;
- function GetValidChars: TChars;
function GetValidCharsString: string;
procedure SetAttributeClass(const AClass: TInstantAbstractAttributeClass);
procedure SetAttributeClassName(const Value: string);
@@ -466,15 +494,22 @@
procedure SetCollection(Value: TInstantAttributeMetadatas);
procedure SetFieldName(const Value: string);
procedure SetIsDefault(const Value: Boolean);
- procedure SetValidCharsString(const Value: string);
+ procedure SetValidCharsString(const AValue: string);
+ function GetValidator: TInstantValidator;
+ // Should be called whenever a validation-related property,
+ // such as ValidCharsString, changes.
+ procedure FreeValidator;
+ protected
+ property Validator: TInstantValidator read GetValidator;
public
- function CreateAttribute(AObject: TInstantAbstractObject):
- TInstantAbstractAttribute;
+ function CreateAttribute(
+ AObject: TInstantAbstractObject): TInstantAbstractAttribute;
procedure Assign(Source: TPersistent); override;
procedure CheckAttributeClass(AClass: TInstantAbstractAttributeClass);
procedure CheckCategory(ACategory: TInstantAttributeCategory);
procedure CheckIsIndexed;
function IsAttributeClass(AClass: TInstantAbstractAttributeClass): Boolean;
+ destructor Destroy; override;
property AttributeClass: TInstantAbstractAttributeClass
read GetAttributeClass write SetAttributeClass;
property AttributeClassName: string read GetAttributeClassName
@@ -490,7 +525,8 @@
property FieldName: string read GetFieldName write SetFieldName;
property HasValidChars: Boolean read GetHasValidChars;
property TableName: string read GetTableName;
- property ValidChars: TChars read GetValidChars write FValidChars;
+ procedure ValidateAttribute(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string);
published
property AttributeType: TInstantAttributeType read FAttributeType
write FAttributeType default atUnknown;
@@ -535,7 +571,9 @@
implementation
-uses SysUtils, TypInfo, InstantPersistence, InstantUtils;
+uses
+ SysUtils, TypInfo, InstantPersistence, InstantUtils, InstantValidation,
+ InstantStandardValidators {registers the standard validators - do not remove};
const
AttributeClasses: array[TInstantAttributeType] of TInstantAttributeClass = (
@@ -1655,7 +1693,7 @@
Self.FStorageName := FStorageName;
Self.FStorageKind := FStorageKind;
Self.FExternalStorageName := FExternalStorageName;
- Self.FValidChars := FValidChars;
+ Self.FValidCharsString := FValidCharsString;
end;
end;
@@ -1700,6 +1738,17 @@
Result := AClass.Create(TInstantObject(AObject), Self);
end;
+destructor TInstantAttributeMetadata.Destroy;
+begin
+ FreeAndNil(FValidator);
+ inherited;
+end;
+
+procedure TInstantAttributeMetadata.FreeValidator;
+begin
+ FreeAndNil(FValidator);
+end;
+
function TInstantAttributeMetadata.GetAttributeClass:
TInstantAbstractAttributeClass;
begin
@@ -1766,7 +1815,7 @@
function TInstantAttributeMetadata.GetHasValidChars: Boolean;
begin
- Result := FValidChars <> [];
+ Result := FValidCharsString <> '';
end;
function TInstantAttributeMetadata.GetIsDefault: Boolean;
@@ -1798,14 +1847,16 @@
Result := '';
end;
-function TInstantAttributeMetadata.GetValidChars: TChars;
+function TInstantAttributeMetadata.GetValidator: TInstantValidator;
begin
- Result := FValidChars;
+ if not Assigned(FValidator) then
+ FValidator := InstantValidatorFactory.CreateValidator(Self);
+ Result := FValidator;
end;
function TInstantAttributeMetadata.GetValidCharsString: string;
begin
- Result := InstantCharSetToStr(FValidChars);
+ Result := FValidCharsString;
end;
function TInstantAttributeMetadata.IsAttributeClass(AClass:
@@ -1883,11 +1934,21 @@
end;
end;
-procedure TInstantAttributeMetadata.SetValidCharsString(const Value: string);
+procedure TInstantAttributeMetadata.SetValidCharsString(const AValue: string);
begin
- FValidChars := InstantStrToCharSet(Value);
+ if AValue <> FValidCharsString then
+ begin
+ FreeValidator;
+ FValidCharsString := AValue;
+ end;
end;
+procedure TInstantAttributeMetadata.ValidateAttribute(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string);
+begin
+ Validator.Validate(AAttribute, AValue);
+end;
+
constructor TInstantAttributeMetadatas.Create(AOwner: TInstantClassMetadata);
begin
inherited Create(AOwner, TInstantAttributeMetadata);
@@ -1942,5 +2003,23 @@
inherited Items[Index] := Value;
end;
+{ TInstantValidator }
+
+class function TInstantValidator.CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+begin
+ Result := Create;
+ Result.Metadata := AMetadata;
+end;
+
+procedure TInstantValidator.Validate(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string);
+var
+ LValidationErrorText: string;
+begin
+ if not IsValid(AAttribute, AValue, LValidationErrorText) then
+ raise EInstantValidationError.Create(LValidationErrorText);
+end;
+
end.
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -196,8 +196,8 @@
procedure SetAsVariant(AValue: Variant); virtual;
procedure SetIsChanged(Value: Boolean);
procedure SetOwner(AOwner: TInstantObject); virtual;
- procedure StringValidationError(InvalidChar: Char);
procedure WriteName(Writer: TInstantWriter);
+ procedure Validate(const AValue: string); virtual;
public
constructor Create(AOwner: TInstantAbstractObject = nil; AMetadata:
TInstantCollectionItem = nil); override;
@@ -1613,23 +1613,6 @@
ObjectNotifiers: TInstantObjectNotifiers;
DefaultConnector: TInstantConnector;
-{ Local Routines }
-
-function ValidateChars(Buffer: PChar; BufferLength: Integer;
- ValidChars: TChars; var InvalidChar: Char): Boolean;
-var
- I: Integer;
-begin
- Result := True;
- for I := 0 to Pred(BufferLength div SizeOf(Char)) do
- if (ValidChars <> []) and not (InstantCharInSet(Buffer[I], ValidChars + [#8, #10, #13])) then
- begin
- Result := False;
- InvalidChar := Buffer[I];
- Break;
- end;
-end;
-
{ Global routines }
procedure AssignInstantStreamFormat(Strings: TStrings);
@@ -2537,15 +2520,15 @@
AsVariant := AValue;
end;
-procedure TInstantAttribute.StringValidationError(InvalidChar: Char);
+procedure TInstantAttribute.Unchanged;
begin
- raise EInstantValidationError.CreateFmt(SInvalidChar,
- [InvalidChar, Ord(InvalidChar), ClassName, Name]);
+ IsChanged := False;
end;
-procedure TInstantAttribute.Unchanged;
+procedure TInstantAttribute.Validate(const AValue: string);
begin
- IsChanged := False;
+ if Assigned(Metadata) then
+ Metadata.ValidateAttribute(Self, AValue);
end;
procedure TInstantAttribute.WriteName(Writer: TInstantWriter);
@@ -3257,12 +3240,8 @@
end;
procedure TInstantString.SetValue(const AValue: string);
-var
- InvalidChar: Char;
begin
- if Assigned(Metadata) and not ValidateChars(PChar(AValue), Length(AValue),
- Metadata.ValidChars, InvalidChar) then
- StringValidationError(InvalidChar);
+ Validate(AValue);
if AValue <> FValue then
begin
FValue:= AValue;
@@ -3590,16 +3569,18 @@
function TInstantBlob.Write(const Buffer; Position, Count: Integer): Integer;
var
- C: Char;
+ LValue: AnsiString;
+ LBufferPointer: {$IFDEF D12+}PByte{$ELSE}PChar{$ENDIF};
function CompareBuffers: Boolean;
var
I: Integer;
+ B: {$IFDEF D12+}Byte{$ELSE}Char{$ENDIF};
begin
Stream.Position := Position;
- for I := 0 to Pred(Count) do
+ for I := Position to Pred(Position + Count) do
begin
- Result := (Stream.Read(C, 1) = 1) and (C = PChar(@Buffer)[I]);
+ Result := (Stream.Read(B, 1) = 1) and (B = {$IFDEF D12+}PByte{$ELSE}PChar{$ENDIF}(@Buffer)[I]);
if not Result then
Exit;
end;
@@ -3607,13 +3588,17 @@
end;
begin
- if not ValidateChars(PChar(@Buffer), Count, Metadata.ValidChars, C) then
- StringValidationError(C);
+ SetLength(LValue, Count);
+ LBufferPointer := @Buffer;
+ Inc(LBufferPointer, Position);
+ StrLCopy(PAnsiChar(LValue), PAnsiChar(LBufferPointer), Count);
+ Validate(string(LValue));
if not CompareBuffers then
begin
Stream.Position := Position;
Result := Stream.Write(Buffer, Count);
- end else
+ end
+ else
Result := 0;
end;
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantPresentation.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -3654,6 +3654,32 @@
Field: TField);
var
Metadata: TInstantAttributeMetadata;
+
+ function InstantStrToCharSet(const Str: AnsiString): TFieldChars;
+ const
+ Dots: array[0..1] of Char = '..';
+ var
+ I, J: Integer;
+ begin
+ Result := [];
+ I := 1;
+ while I <= Length(Str) do
+ begin
+ if CompareMem(@Str[I], @Dots, Length(Dots)) and
+ (I > 1) and (Length(Str) > I + 1) then
+ begin
+ for J := Ord(Str[I - 1]) to Ord(Str[I + 2]) do
+ Result := Result + [Chr(J)];
+ Inc(I, Length(Dots));
+ end
+ else
+ begin
+ Include(Result, Str[I]);
+ Inc(I);
+ end;
+ end;
+ end;
+
begin
if AObject is TInstantObject then
begin
@@ -3663,8 +3689,8 @@
begin
if Field.EditMask <> Metadata.EditMask then
Field.EditMask := Metadata.EditMask;
- if Metadata.ValidChars <> [] then
- Field.ValidChars := Metadata.ValidChars;
+ if Metadata.ValidCharsString <> '' then
+ Field.ValidChars := InstantStrToCharSet(AnsiString(Metadata.ValidCharsString));
end;
end;
end;
@@ -3712,7 +3738,7 @@
FillChar(Buffer^, Field.DataSize, 0);
if not Empty then
begin
- S := Value;
+ S := AnsiString(Value);
Len := Length(S);
if Len >= Field.DataSize then
Len := Pred(Field.DataSize);
Added: trunk/Source/Core/InstantStandardValidators.pas
===================================================================
--- trunk/Source/Core/InstantStandardValidators.pas (rev 0)
+++ trunk/Source/Core/InstantStandardValidators.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -0,0 +1,282 @@
+(*
+ * InstantObjects
+ * Validation framework - standard validators.
+ *)
+
+(* ***** 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):
+ * Nando Dessena
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantStandardValidators;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+uses
+ Contnrs, InstantClasses, InstantMetadata, InstantValidation;
+
+type
+ // Base class for classes that handle the pieces of a ValidCharsString string.
+ TInstantCharSetPieceValidator = class
+ protected
+ function GetValidCharsAsString: string; virtual;
+ public
+ function IsValidChar(const AChar: Char): Boolean; virtual; abstract;
+ property ValidCharsAsString: string read GetValidCharsAsString;
+ end;
+
+ // Validates a character against a set of distinct characters stored in a string.
+ TInstantCharsPieceValidator = class(TInstantCharSetPieceValidator)
+ private
+ FValidChars: string;
+ protected
+ function GetValidCharsAsString: string; override;
+ public
+ procedure AfterConstruction; override;
+ procedure AddChar(const AChar: Char);
+ procedure RemoveLastChar;
+ function IsValidChar(const AChar: Char): Boolean; override;
+ end;
+
+ // Validates a character against a range of characters.
+ TInstantCharRangePieceValidator = class(TInstantCharSetPieceValidator)
+ private
+ FValidFrom: Char;
+ FValidTo: Char;
+ protected
+ function GetValidCharsAsString: string; override;
+ public
+ procedure SetValidChars(const AValidFrom, AValidTo: Char);
+ function IsValidChar(const AChar: Char): Boolean; override;
+ end;
+
+ // Splits a ValidCharsString string into pieces that hands each to a
+ // different internal instance of TInstantCharSetPieceValidator.
+ TInstantCharSetValidator = class(TInstantValidator)
+ private
+ FPieces: TObjectList;
+ procedure CreatePieceValidators(const AValidChars: string);
+ function IsValidChar(const AChar: Char;
+ out AValidationErrorText: string): Boolean;
+ public
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+ class function CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator; override;
+ function IsValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ override;
+ end;
+
+implementation
+
+uses
+ SysUtils, InstantConsts;
+
+{ TInstantCharSetValidator }
+
+procedure TInstantCharSetValidator.AfterConstruction;
+begin
+ inherited;
+ FPieces := TObjectList.Create;
+end;
+
+procedure TInstantCharSetValidator.CreatePieceValidators(
+ const AValidChars: string);
+var
+ I: Integer;
+ LCharsValidator: TInstantCharsPieceValidator;
+ LCharRangeValidator: TInstantCharRangePieceValidator;
+ LChar: Char;
+begin
+ LCharsValidator := TInstantCharsPieceValidator.Create;
+ FPieces.Add(LCharsValidator);
+ I := 1;
+ while I <= Length(AValidChars) do
+ begin
+ LChar := AValidChars[I];
+ // a..b means a range from a to b.
+ if (LChar = '.') and (I > 1) and (I < Length(AValidChars) - 1) and (AValidChars[Succ(I)] = '.') then
+ begin
+ LCharRangeValidator := TInstantCharRangePieceValidator.Create;
+ FPieces.Add(LCharRangeValidator);
+ LCharRangeValidator.SetValidChars(AValidChars[Pred(I)],
+ AValidChars[I + 2]);
+ // no need for the chars validator to take care of the first char in
+ // my range.
+ LCharsValidator.RemoveLastChar;
+ // skip the second dot and the range end char.
+ Inc(I, 2);
+ end
+ // everything else is a simple match.
+ else
+ LCharsValidator.AddChar(LChar);
+ Inc(I);
+ end;
+end;
+
+class function TInstantCharSetValidator.CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+begin
+ if Assigned(AMetadata) and (AMetadata.ValidCharsString <> '') then
+ begin
+ Result := Create;
+ try
+ Result.Metadata := AMetadata;
+ TInstantCharSetValidator(Result).CreatePieceValidators(AMetadata.ValidCharsString);
+ except
+ FreeAndNil(Result);
+ raise;
+ end;
+ end
+ else
+ Result := nil;
+end;
+
+destructor TInstantCharSetValidator.Destroy;
+begin
+ FreeAndNil(FPieces);
+ inherited;
+end;
+
+function TInstantCharSetValidator.IsValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+begin
+ Result := True;
+ for I := 1 to Length(AValue) do
+ begin
+ if not IsValidChar(AValue[I], AValidationErrorText) then
+ begin
+ Result := False;
+ Break;
+ end;
+ end;
+ if not Result then
+ AValidationErrorText := Format(SInvalidAttributeValue, [AValue,
+ AAttribute.ClassName, Metadata.Name]) + sLineBreak +
+ AValidationErrorText;
+end;
+
+function TInstantCharSetValidator.IsValidChar(
+ const AChar: Char; out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+begin
+ Result := False;
+ AValidationErrorText := '';
+ for I := 0 to FPieces.Count - 1 do
+ begin
+ if TInstantCharSetPieceValidator(FPieces[I]).IsValidChar(AChar) then
+ begin
+ Result := True;
+ Break;
+ end;
+ end;
+ if not Result then
+ AValidationErrorText := Format(SInvalidChar, [AChar, Ord(AChar), Metadata.ValidCharsString]);
+end;
+
+{ TInstantCharSetPieceValidator }
+
+function TInstantCharSetPieceValidator.GetValidCharsAsString: string;
+begin
+ Result := '';
+end;
+
+{ TInstantCharsPieceValidator }
+
+procedure TInstantCharsPieceValidator.AddChar(const AChar: Char);
+begin
+ if Pos(AChar, FValidChars) = 0 then
+ FValidChars := FValidChars + AChar;
+end;
+
+procedure TInstantCharsPieceValidator.AfterConstruction;
+begin
+ inherited;
+ // This is for backward compatibility, as IO has always allowed these
+ // characters in a string or memo when ValidCharsString is not empty.
+ // I don't think this is strictly correct, especially for string fields.
+ FValidChars := #8#10#13;
+end;
+
+function TInstantCharsPieceValidator.GetValidCharsAsString: string;
+begin
+ Result := FValidChars;
+end;
+
+function TInstantCharsPieceValidator.IsValidChar(const AChar: Char): Boolean;
+begin
+ Result := Pos(AChar, FValidChars) > 0;
+end;
+
+procedure TInstantCharsPieceValidator.RemoveLastChar;
+begin
+ if FValidChars <> '' then
+ Delete(FValidChars, Length(FValidChars) , 1);
+end;
+
+{ TInstantCharRangePieceValidator }
+
+function TInstantCharRangePieceValidator.GetValidCharsAsString: string;
+begin
+ Result := FValidFrom + '..' + FValidTo;
+end;
+
+function TInstantCharRangePieceValidator.IsValidChar(const AChar: Char): Boolean;
+begin
+ Result := (AChar >= FValidFrom) and (AChar <= FValidTo);
+end;
+
+procedure TInstantCharRangePieceValidator.SetValidChars(const AValidFrom,
+ AValidTo: Char);
+begin
+ if AValidFrom > AValidTo then
+ begin
+ FValidFrom := AValidTo;
+ FValidTo := AValidFrom;
+ end
+ else
+ begin
+ FValidFrom := AValidFrom;
+ FValidTo := AValidTo;
+ end;
+end;
+
+initialization
+ InstantValidatorFactory.AddValidatorClass(TInstantCharSetValidator);
+
+finalization
+ InstantValidatorFactory.RemoveValidatorClass(TInstantCharSetValidator);
+
+end.
+
Property changes on: trunk/Source/Core/InstantStandardValidators.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Modified: trunk/Source/Core/InstantUtils.pas
===================================================================
--- trunk/Source/Core/InstantUtils.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Core/InstantUtils.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -50,7 +50,6 @@
Major, Minor, Release, Build: Word;
end;
-function InstantCharSetToStr(C: TChars): string;
function InstantCompareObjects(Obj1, Obj2: TObject; PropName: string;
Options: TInstantCompareOptions): Integer; overload;
function InstantCompareObjects(Obj1, Obj2: TObject; PropNames: TStrings;
@@ -82,7 +81,6 @@
function InstantSameText(const S1, S2: string; IgnoreCase: Boolean): Boolean;
function InstantStrToDate(const Str: string): TDateTime;
function InstantStrToDateTime(const Str: string): TDateTime;
-function InstantStrToCharSet(const Str: AnsiString): TChars;
procedure InstantStrToList(const Str: string; List: TStrings;
Delimiters: TChars);
function InstantStrToTime(const Str: string): TDateTime;
@@ -109,37 +107,6 @@
{$ENDIF}
{$IFDEF D6+}Variants,{$ENDIF} InstantConsts, InstantRtti;
-function InstantCharSetToStr(C: TChars): string;
-var
- I, J, L: Integer;
- S: string;
-begin
- Result := '';
- for I := 0 to 255 do
- if InstantCharInSet(Chr(I), C) then
- S := S + Chr(I);
- I := 1;
- L := Length(S);
- Result := '';
- while I <= L do
- begin
- J := 1;
- Result := Result + S[I];
- while ((I + J) <= L) and (Ord(S[I]) + J = Ord(S[I + J])) do
- Inc(J);
- if J > 3 then
- Result := Result + '..' + S[I + J - 1]
- else
- while J > 1 do
- begin
- Inc(I);
- Dec(J);
- Result := Result + S[I];
- end;
- I := I + J;
- end;
-end;
-
function InstantCompareObjects(Obj1, Obj2: TObject; PropName: string;
Options: TInstantCompareOptions): Integer;
var
@@ -541,31 +508,6 @@
end;
end;
-function InstantStrToCharSet(const Str: AnsiString): TChars;
-const
- Dots: array[0..1] of Char = '..';
-var
- I, J: Integer;
-begin
- Result := [];
- I := 1;
- while I <= Length(Str) do
- begin
- if CompareMem(@Str[I], @Dots, Length(Dots)) and
- (I > 1) and (Length(Str) > I + 1) then
- begin
- for J := Ord(Str[I - 1]) to Ord(Str[I + 2]) do
- Result := Result + [Chr(J)];
- Inc(I, Length(Dots));
- end
- else
- begin
- Include(Result, Str[I]);
- Inc(I);
- end;
- end;
-end;
-
procedure InstantStrToList(const Str: string; List: TStrings;
Delimiters: TChars);
Added: trunk/Source/Core/InstantValidation.pas
===================================================================
--- trunk/Source/Core/InstantValidation.pas (rev 0)
+++ trunk/Source/Core/InstantValidation.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -0,0 +1,230 @@
+(*
+ * InstantObjects
+ * Validation framework
+ *)
+
+(* ***** 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):
+ * Nando Dessena
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit InstantValidation;
+
+{$IFDEF LINUX}
+{$I '../InstantDefines.inc'}
+{$ELSE}
+{$I '..\InstantDefines.inc'}
+{$ENDIF}
+
+interface
+
+uses
+ Contnrs, InstantClasses, InstantMetadata, InstantPersistence;
+
+type
+ TInstantValidatorListValidationMode = (vmAll, vmAny);
+
+ // A validator that is a list of validators (composite).
+ // Shouldn't be registered as it's used directly by the
+ // factory as a wrapper for multiple validators and also as a null object,
+ // for when no validators apply. It is also a base class for other
+ // validators.
+ TInstantValidatorList = class(TInstantValidator)
+ private
+ FValidators: TObjectList;
+ FConcatMode: TInstantValidatorListValidationMode;
+ function AllValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ function AnyValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ public
+ function IsValid(const AAttribute: TInstantAbstractAttribute;
+ const AValue: string; out AValidationErrorText: string): Boolean;
+ override;
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+ // Adds a validator to the inner list.
+ procedure Add(const AValidator: TInstantValidator);
+ // Decides whether validators in lists should all pass for a value to be
+ // accepted (vmAll) or if any one of them suffices (vmAny).
+ property ConcatMode: TInstantValidatorListValidationMode
+ read FConcatMode write FConcatMode default vmAll;
+ end;
+
+ // Creates validators based on metadata contents.
+ TInstantValidatorFactory = class
+ private
+ FClasses: TClassList;
+ public
+ procedure AfterConstruction; override;
+ destructor Destroy; override;
+
+ procedure AddValidatorClass(const AValidatorClass: TInstantValidatorClass);
+ procedure RemoveValidatorClass(const AValidatorClass: TInstantValidatorClass);
+
+ { TODO : Extend this for class-level validation? }
+ function CreateValidator(const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+ end;
+
+function InstantValidatorFactory: TInstantValidatorFactory;
+
+implementation
+
+uses
+ SysUtils;
+
+var
+ _InstantValidatorFactory: TInstantValidatorFactory;
+
+function InstantValidatorFactory: TInstantValidatorFactory;
+begin
+ if not Assigned(_InstantValidatorFactory) then
+ _InstantValidatorFactory := TInstantValidatorFactory.Create;
+ Result := _InstantValidatorFactory;
+end;
+
+{ TInstantValidatorFactory }
+
+procedure TInstantValidatorFactory.AddValidatorClass(
+ const AValidatorClass: TInstantValidatorClass);
+begin
+ FClasses.Add(AValidatorClass);
+end;
+
+procedure TInstantValidatorFactory.AfterConstruction;
+begin
+ inherited;
+ FClasses := TClassList.Create;
+end;
+
+function TInstantValidatorFactory.CreateValidator(
+ const AMetadata: TInstantAttributeMetadata): TInstantValidator;
+var
+ I: Integer;
+begin
+ Result := TInstantValidatorList.Create;
+ try
+ for I := 0 to FClasses.Count - 1 do
+ TInstantValidatorList(Result).Add(
+ TInstantValidatorClass(FClasses[I]).CreateValidator(AMetadata));
+ except
+ FreeAndNil(Result);
+ raise;
+ end;
+end;
+
+destructor TInstantValidatorFactory.Destroy;
+begin
+ FreeAndNil(FClasses);
+ inherited;
+end;
+
+procedure TInstantValidatorFactory.RemoveValidatorClass(
+ const AValidatorClass: TInstantValidatorClass);
+begin
+ FClasses.Remove(AValidatorClass);
+end;
+
+{ TInstantValidatorList }
+
+procedure TInstantValidatorList.Add(const AValidator: TInstantValidator);
+begin
+ // It is valid for this method to receive nil and don't do anything.
+ if Assigned(AValidator) then
+ FValidators.Add(AValidator);
+end;
+
+procedure TInstantValidatorList.AfterConstruction;
+begin
+ inherited;
+ FValidators := TObjectList.Create;
+ FConcatMode := vmAll;
+end;
+
+destructor TInstantValidatorList.Destroy;
+begin
+ FreeAndNil(FValidators);
+ inherited;
+end;
+
+function TInstantValidatorList.IsValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+begin
+ if FConcatMode = vmAll then
+ Result := AllValid(AAttribute, AValue, AValidationErrorText)
+ else
+ Result := AnyValid(AAttribute, AValue, AValidationErrorText);
+end;
+
+function TInstantValidatorList.AllValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+begin
+ Result := True;
+ AValidationErrorText := '';
+ for I := 0 to FValidators.Count - 1 do
+ begin
+ if not TInstantValidator(FValidators[I]).IsValid(AAttribute, AValue, AValidationErrorText) then
+ begin
+ Result := False;
+ Break;
+ end;
+ end;
+end;
+
+function TInstantValidatorList.AnyValid(
+ const AAttribute: TInstantAbstractAttribute; const AValue: string;
+ out AValidationErrorText: string): Boolean;
+var
+ I: Integer;
+ LErrorText: string;
+begin
+ Result := False;
+ AValidationErrorText := '';
+ for I := 0 to FValidators.Count - 1 do
+ begin
+ if TInstantValidator(FValidators[I]).IsValid(AAttribute, AValue, LErrorText) then
+ begin
+ Result := True;
+ Break;
+ end
+ else
+ begin
+ if AValidationErrorText = '' then
+ AValidationErrorText := LErrorText
+ else
+ AValidationErrorText := AValidationErrorText + sLineBreak + LErrorText;
+ end;
+ end;
+end;
+
+initialization
+
+finalization
+ FreeAndNil(_InstantValidatorFactory);
+
+end.
+
Property changes on: trunk/Source/Core/InstantValidation.pas
___________________________________________________________________
Added: svn:mime-type
+ text/plain
Added: svn:eol-style
+ native
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Design/InstantModelExpert.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -504,7 +504,7 @@
Editor: IOTASourceEditor;
OldLen: Integer;
begin
- Module := FIDEInterface.FindModule(AClass.Module.UnitName);
+ Module := FIDEInterface.FindModule(AClass.Module.PascalUnitName);
if not Assigned(Module) then
Exit;
Editor := FIDEInterface.SourceEditor(Module);
Modified: trunk/Source/Design/InstantModelImport.pas
===================================================================
--- trunk/Source/Design/InstantModelImport.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Source/Design/InstantModelImport.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -114,7 +114,7 @@
for I := 0 to FModel.ModuleCount - 1 do
begin
Module := FModel.Modules[I];
- ImportModuleCombo.Items.AddObject(Module.UnitName, Module)
+ ImportModuleCombo.Items.AddObject(Module.PascalUnitName, Module)
end;
end;
Modified: trunk/Tests/TestIO.dproj
===================================================================
--- trunk/Tests/TestIO.dproj 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestIO.dproj 2009-08-16 16:59:53 UTC (rev 830)
@@ -37,7 +37,8 @@
<Borland.Personality>Delphi.Personality</Borland.Personality>
<Borland.ProjectType>VCLApplication</Borland.ProjectType>
<BorlandProject>
-<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages">vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;vclactnband;vclshlctrls;CS30Logging70;Rz30Ctls70;Rz30DBCtls70;ip4000v7;Rave60VCL;Rave60CLX;madBasic_;madDisAsm_;CLXIB;ibxpress;VCLIB;IOCore;IOIBX</Compiler></Compiler><Parameters><Parameters Name="DebugSourceDirs">..\Source\Core</Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Language><Language Name="RootDir">C:\Program Files\Borland\Delphi7\Bin\</Language></Language><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">3081</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">TestIO.dpr</Source></Source></Delphi.Personality></BorlandProject></BorlandProject>
+<BorlandProject><Delphi.Personality><Compiler><Compiler Name="UsePackages">False</Compiler><Compiler Name="Packages">vcl;rtl;vclx;indy;inet;xmlrtl;vclie;inetdbbde;inetdbxpress;dbrtl;dsnap;vcldb;soaprtl;VclSmp;dbexpress;dbxcds;inetdb;bdertl;vcldbx;webdsnap;adortl;vclactnband;vclshlctrls;CS30Logging70;Rz30Ctls70;Rz30DBCtls70;ip4000v7;Rave60VCL;Rave60CLX;madBasic_;madDisAsm_;CLXIB;ibxpress;VCLIB;IOCore;IOIBX</Compiler></Compiler><Parameters><Parameters Name="DebugSourceDirs">..\Source\Core</Parameters><Parameters Name="UseLauncher">False</Parameters><Parameters Name="LoadAllSymbols">True</Parameters><Parameters Name="LoadUnspecifiedSymbols">False</Parameters></Parameters><Language><Language Name="RootDir">C:\Program Files\Borland\Delphi7\Bin\</Language></Language><VersionInfo><VersionInfo Name="IncludeVerInfo">False</VersionInfo><VersionInfo Name="AutoIncBuild">False</VersionInfo><VersionInfo Name="MajorVer">1</VersionInfo><VersionInfo Name="MinorVer">0</VersionInfo><VersionInfo Name="Release">0</VersionInfo><VersionInfo Name="Build">0</VersionInfo><VersionInfo Name="Debug">False</VersionInfo><VersionInfo Name="PreRelease">False</VersionInfo><VersionInfo Name="Special">False</VersionInfo><VersionInfo Name="Private">False</VersionInfo><VersionInfo Name="DLL">False</VersionInfo><VersionInfo Name="Locale">3081</VersionInfo><VersionInfo Name="CodePage">1252</VersionInfo></VersionInfo><VersionInfoKeys><VersionInfoKeys Name="CompanyName"></VersionInfoKeys><VersionInfoKeys Name="FileDescription"></VersionInfoKeys><VersionInfoKeys Name="FileVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="InternalName"></VersionInfoKeys><VersionInfoKeys Name="LegalCopyright"></VersionInfoKeys><VersionInfoKeys Name="LegalTrademarks"></VersionInfoKeys><VersionInfoKeys Name="OriginalFilename"></VersionInfoKeys><VersionInfoKeys Name="ProductName"></VersionInfoKeys><VersionInfoKeys Name="ProductVersion">1.0.0.0</VersionInfoKeys><VersionInfoKeys Name="Comments"></VersionInfoKeys></VersionInfoKeys><Source><Source Name="MainSource">TestIO.dpr</Source></Source></Delphi.Personality> <ModelSupport>False</ModelSupport>
+</BorlandProject></BorlandProject>
</ProjectExtensions>
<Import Project="$(MSBuildBinPath)\Borland.Delphi.Targets" />
<ItemGroup>
Modified: trunk/Tests/TestIO_D2009.mdr
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO_D2009.mdrt
===================================================================
(Binary files differ)
Modified: trunk/Tests/TestIO_D2009.mdx
===================================================================
--- trunk/Tests/TestIO_D2009.mdx 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestIO_D2009.mdx 2009-08-16 16:59:53 UTC (rev 830)
@@ -230,7 +230,7 @@
<AttributeType>atCurrency</AttributeType>
<IsIndexed>FALSE</IsIndexed>
<IsRequired>FALSE</IsRequired>
- <ValidCharsString>,.09?</ValidCharsString>
+ <ValidCharsString>,.0..9€</ValidCharsString>
</TInstantAttributeMetadata>
<TInstantAttributeMetadata>
<Name>Employed</Name>
Modified: trunk/Tests/TestIO_D2009.mdxt
===================================================================
--- trunk/Tests/TestIO_D2009.mdxt 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestIO_D2009.mdxt 2009-08-16 16:59:53 UTC (rev 830)
@@ -214,7 +214,7 @@
<AttributeType>atCurrency</AttributeType>
<IsIndexed>FALSE</IsIndexed>
<IsRequired>FALSE</IsRequired>
- <ValidCharsString>,.09?</ValidCharsString>
+ <ValidCharsString>,.0..9€</ValidCharsString>
</TInstantAttributeMetadata>
<TInstantAttributeMetadata>
<Name>Employed</Name>
Modified: trunk/Tests/TestInstantAttributeMetadata.pas
===================================================================
--- trunk/Tests/TestInstantAttributeMetadata.pas 2009-08-16 06:01:49 UTC (rev 829)
+++ trunk/Tests/TestInstantAttributeMetadata.pas 2009-08-16 16:59:53 UTC (rev 830)
@@ -41,6 +41,8 @@
// Extended test methods for class TTestCase
TTestCaseEx = class(TTestCase)
+ private
+ FTempAttr: TInstantAttribute;
public
class procedure AssertException(const AMessage: string;
AExceptionClass: ExceptClass;
@@ -85,6 +87,7 @@
private
FConn: TInstantMockConnector;
FInstantAttributeMetadata: TInstantAttributeMetadata;
+ procedure SetInvalidValueInTempAttr;
public
procedure SetUp; override;
procedure TearDown; override;
@@ -95,6 +98,7 @@
procedure TestCheckCategory;
procedure TestCheckIsIndexed;
procedure TestIsAttributeClass;
+ procedure TestAttributeValidation;
end;
// Test methods for class TInstantAttributeMetadatas
@@ -235,7 +239,7 @@
FInstantAttributeMetadata.StorageName := 'StorageName';
FInstantAttributeMetadata.StorageKind := skEmbedded;
FInstantAttributeMetadata.ExternalStorageName := 'ExternalStorageName';
- FInstantAttributeMetadata.ValidChars := ['a'..'z'];
+ FInstantAttributeMetadata.ValidCharsString := 'a..y0..9\x80 ';
end;
procedure TestTInstantAttributeMetadata.TearDown;
@@ -266,7 +270,7 @@
vSource.StorageName := 'StorageName';
vSource.StorageKind := skEmbedded;
vSource.ExternalStorageName := 'ExternalStorageName';
- vSource.ValidChars := ['a'..'z'];
+ vSource.ValidCharsString := 'a..z';
vDest.Assign(vSource);
vStr := GetEnumName(TypeInfo(TInstantAttributeType),
@@ -286,7 +290,7 @@
AssertEquals('StorageKind incorrect', 'skEmbedded', vStr);
AssertEquals('ExternalStorageName incorrect', 'ExternalStorageName',
vDest.ExternalStorageName);
- AssertTrue('ValidChars incorrect', 'i' in vDest.ValidChars);
+ AssertEquals('ValidChars incorrect', 'a..z', vDest.ValidCharsString);
finally
vSource.Free;
vDest.Free;
@@ -323,11 +327,14 @@
try
vReturnValue := FInstantAttributeMetadata.CreateAttribute(vObject)
as TInstantAttribute;
- AssertNotNull('vReturnValue', vReturnValue);
- AssertEquals('AsString', 'Default', vReturnValue.AsString);
- AssertNotNull('Metadata ', vReturnValue.Metadata);
- AssertEquals('Classname', 'TInstantString', vReturnValue.ClassName);
- vReturnValue.Free;
+ try
+ AssertNotNull('vReturnValue', vReturnValue);
+ AssertEquals('AsString', 'Default', vReturnValue.AsString);
+ AssertNotNull('Metadata ', vReturnValue.Metadata);
+ AssertEquals('Classname', 'TInstantString', vReturnValue.ClassName);
+ finally
+ vReturnValue.Free;
+ end;
finally
vObject.Free;
end;
@@ -343,6 +350,32 @@
AssertTrue('IsAttributeClass error for TInstantMetadata!', vReturnValue);
end;
+procedure TestTInstantAttributeMetadata.TestAttributeValidation;
+var
+ vObject: TInstantObject;
+begin
+ vObject := TInstantObject.Create(FConn);
+ try
+ FTempAttr := FInstantAttributeMetadata.CreateAttribute(vObject)
+ as TInstantAttribute;
+ try
+ FTempAttr.AsString := 'only valid chars';
+ AssertException(EInstantValidationError, SetInvalidValueInTempAttr);
+ AssertEquals('AsString', 'only valid chars', FTempAttr.AsString);
+ finally
+ FreeAndNil(FTempAttr);
+ end;
+ finally
+ vObject.Free;
+ end;
+end;
+
+procedure TestTInstantAttributeMetadata.SetInvalidValueInTempAttr;
+begin
+ Assert(Assigned(FTempAttr));
+ FTempAttr.AsString := 'char z not allowed';
+end;
+
{ TestTInstantAttributeMetadatas }
procedure TestTInstantAttributeMetadatas.SetUp;
Modified: trunk...
[truncated message content] |
|
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);
|
|
From: <dav...@us...> - 2009-08-16 05:23:25
|
Revision: 828
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=828&view=rev
Author: davidvtaylor
Date: 2009-08-16 05:23:17 +0000 (Sun, 16 Aug 2009)
Log Message:
-----------
Revise IDE menu handling to make menu entries visible to GExperts and IDE menu customization dialogs
- Install custom TAction instances into the IDE ActionList
- Add Ctrl-Shift-B shortcut to DatabaseBuilder menu entry
- Add logic to disable action event handlers when design package is unloaded
Modified Paths:
--------------
trunk/Source/Design/InstantModelExpert.pas
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2009-08-15 10:38:20 UTC (rev 827)
+++ trunk/Source/Design/InstantModelExpert.pas 2009-08-16 05:23:17 UTC (rev 828)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Nando Dessena, Steven Mitchell, Brian Andersen
+ * Nando Dessena, Steven Mitchell, Brian Andersen, David Taylor
*
* ***** END LICENSE BLOCK ***** *)
@@ -41,7 +41,7 @@
uses
Classes, ToolsAPI, InstantOTA, Menus, ImgList, ExtCtrls, Forms,
InstantDesignResources, InstantModelExplorer, InstantCode,
- InstantConsts;
+ InstantConsts, ActnList;
type
TIOMetaDataCheckState = (mcNeverChecked, mcCheckError, mcCheckCorrect);
@@ -165,10 +165,13 @@
InstantConnectionManager, Dialogs;
const
+ SIOIdeMenuCategory = 'InstantObjects';
SBuilderItemCaption = 'InstantObjects Database &Builder...';
- SBuilderItemName = 'InstantBuilderItem';
+ SBuilderItemName = 'InstantBuilderItem'; // Do not localize
SExplorerItemCaption = 'InstantObjects &Model Explorer';
- SExplorerItemName = 'InstantExplorerItem';
+ SExplorerItemName = 'InstantExplorerItem'; // Do not localize
+ SExplorerItemActionName = 'InstantExplorerItemAction'; // Do not localize
+ SBuilderItemActionName = 'InstantBuilderItemAction'; // Do not localize
SModelCompiler = 'Model Compiler';
SResFileExt = '.mdr';
UpdateInterval = 500;
@@ -186,6 +189,81 @@
InstantCodeReaderIdle := ReaderIdle;
end;
+function FindOrCreateMenuAction(AName, ACaption: string;
+ AEventHandler: TNotifyEvent; AImageIndex : integer = -1;
+ AShortCut: TShortCut = 0): TContainedAction;
+var
+ IdeMainForm: TCustomForm;
+ IdeActionList: TCustomActionList;
+ NTAServices: INTAServices;
+ NewAction: TAction;
+ I: integer;
+begin
+ // Get the IDE's action list
+ NTAServices := BorlandIDEServices as INTAServices;
+ Assert(Assigned(NTAServices));
+ IdeActionList := NTAServices.ActionList;
+ Assert(Assigned(IdeActionList));
+
+ // Search for an existing IDE action
+ Result := nil;
+ for I := 0 to IdeActionList.ActionCount-1 do
+ begin
+ if (not SameText(IdeActionList.Actions[I].Name, AName)) then
+ continue;
+ Result := IdeActionList.Actions[I];
+ // Reconnect/enable the event handler (package reload)
+ Result.OnExecute := AEventHandler;
+ if (Result is TCustomAction) then
+ TCustomAction(Result).Enabled := true;
+ break;
+ end;
+
+ // Create a new action if not found
+ if (not assigned(Result)) then
+ begin
+ // Get the IDE's main form
+ Assert(Assigned(Application));
+ IdeMainForm := Application.FindComponent('AppBuilder') as TCustomForm;
+
+ // Create and initialize the action
+ NewAction := TAction.Create(IdeMainForm);
+ NewAction.ActionList := IdeActionList;
+ NewAction.Name := AName;
+ NewAction.Caption := ACaption;
+ NewAction.Category := SIOIdeMenuCategory;
+ NewAction.ImageIndex := AImageIndex;
+ NewAction.ShortCut := AShortCut;
+ NewAction.OnExecute := AEventHandler;
+ Result := NewAction;
+ end;
+end;
+
+// Searches for an IDE action matching the given name and
+// diables its OnExecute event handlers This avoids an AV
+// if the expert is unloaded (e.g. during a package rebuild)
+procedure DisableMenuAction(AName: string);
+var
+ IdeActionList: TCustomActionList;
+ NTAServices: INTAServices;
+ I: integer;
+begin
+ // Get the IDE's action list
+ NTAServices := BorlandIDEServices as INTAServices;
+ Assert(Assigned(NTAServices));
+ IdeActionList := NTAServices.ActionList;
+ Assert(Assigned(IdeActionList));
+
+ // Search for and diable IDE action
+ for I := 0 to IdeActionList.ActionCount-1 do
+ begin
+ if (not SameText(IdeActionList.Actions[I].Name, AName)) then
+ continue;
+ IdeActionList.Actions[I].OnExecute := nil;
+ break;
+ end;
+end;
+
function FindText(const SubStr, Str: string;
var Pos, Line, Column: Integer): Boolean;
var
@@ -464,13 +542,13 @@
procedure CreateBuilderMenuItem;
begin
FBuilderItem := TReferencedMenuItem.Create(nil, FBuilderItem);
- with FBuilderItem do
- begin
- Name := SBuilderItemName;
- Caption := SBuilderItemCaption;
- Action := Explorer.BuildDatabaseAction;
- ImageIndex := FToolImageOffset + 1;
- end;
+ FBuilderItem.Name := SBuilderItemName;
+ FBuilderItem.Action := FindOrCreateMenuAction(
+ SBuilderItemActionName,
+ SBuilderItemCaption,
+ BuilderItemClick,
+ FToolImageOffset + 1,
+ Menus.ShortCut(Word('B'), [ssCtrl, ssShift]));
end;
var
@@ -496,14 +574,14 @@
if Assigned(Menu) then
begin
FExplorerItem := TMenuItem.Create(nil);
- with FExplorerItem do
- begin
- Name := SExplorerItemName;
- Caption := SExplorerItemCaption;
- ShortCut := Menus.ShortCut(Word('M'), [ssCtrl, ssShift]);
- ImageIndex := FToolImageOffset;
- OnClick := ExplorerItemClick;
- end;
+ FExplorerItem.Name := SExplorerItemName;
+ FExplorerItem.Action := FindOrCreateMenuAction(
+ SExplorerItemActionName,
+ SExplorerItemCaption,
+ ExplorerItemClick,
+ FToolImageOffset,
+ Menus.ShortCut(Word('M'), [ssCtrl, ssShift]));
+
{$IFDEF D9+}
Item := ItemByName(Menu, 'ViewStructureItem');
{$ELSE}
@@ -681,6 +759,8 @@
destructor TInstantModelExpert.Destroy;
begin
+ DisableMenuAction(SBuilderItemActionName);
+ DisableMenuAction(SExplorerItemActionName);
Application.OnIdle := FSaveApplicationIdle;
DetachMenus;
FUpdateTimer.Free;
|
|
From: <na...@us...> - 2009-08-15 10:38:29
|
Revision: 827
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=827&view=rev
Author: nandod
Date: 2009-08-15 10:38:20 +0000 (Sat, 15 Aug 2009)
Log Message:
-----------
* D2009: fixed reading embedded objects in binary format. Retructured embedded object I/O in D2007 and D2009.
* Added SQL statement logging for write as well as read statements.
* Optimized XML output.
Modified Paths:
--------------
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantPersistence.pas
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2009-08-14 19:28:40 UTC (rev 826)
+++ trunk/Source/Core/InstantBrokers.pas 2009-08-15 10:38:20 UTC (rev 827)
@@ -267,6 +267,11 @@
procedure InternalStoreMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo); virtual;
+ function CreateEmbeddedObjectInputStream(const AConnector: TInstantConnector;
+ const AField: TField): TStream;
+ function CreateEmbeddedObjectOutputStream(const AConnector: TInstantConnector): TStream;
+ procedure AssignEmbeddedObjectStreamToField(const AConnector: TInstantConnector;
+ const AStream: TStream; const AField: TField);
public
constructor Create(ABroker: TInstantCustomRelationalBroker);
procedure DisposeMap(AObject: TInstantObject; Map: TInstantAttributeMap;
@@ -389,8 +394,8 @@
procedure WriteReferences(Attribute: TInstantReferences); virtual;
procedure WriteString(Attribute: TInstantString); virtual;
property DataSet: TDataset read GetDataSet write SetDataSet;
- property NavigationalLinkResolvers: TObjectList read
- GetNavigationalLinkResolvers;
+ property NavigationalLinkResolvers: TObjectList
+ read GetNavigationalLinkResolvers;
public
constructor Create(ABroker: TInstantNavigationalBroker;
const ATableName: string);
@@ -488,6 +493,8 @@
procedure RemovePersistentIdParam(Params: TParams);
function TranslateError(AObject: TInstantObject;
E: Exception): Exception; virtual;
+ procedure AddEmbeddedObjectOutputParam(const AConnector: TInstantConnector;
+ const AParams: TParams; const AParamName: string; const AStream: TStream);
public
constructor Create(ABroker: TInstantSQLBroker; AMap: TInstantAttributeMap);
property Broker: TInstantSQLBroker read GetBroker;
@@ -1430,7 +1437,7 @@
CachedStatement: TInstantStatement;
begin
{$IFDEF IO_STATEMENT_LOGGING}
- InstantLogStatement(InstantLogStatementBefore, AStatement, AParams);
+ InstantLogStatement(InstantLogStatementSelect, AStatement, AParams);
{$ENDIF}
Result := nil;
if FStatementCacheCapacity <> 0 then
@@ -1739,6 +1746,58 @@
FBroker := ABroker;
end;
+function TInstantCustomResolver.CreateEmbeddedObjectInputStream(
+ const AConnector: TInstantConnector; const AField: TField): TStream;
+{$IFDEF D12+}
+var
+ LEncoding: TEncoding;
+{$ENDIF}
+begin
+ Assert(Assigned(AConnector));
+ Assert(Assigned(AField));
+
+ {$IFDEF D12+}
+ if AConnector.BlobStreamFormat = sfBinary then
+ Result := TBytesStream.Create(AField.AsBytes)
+ else
+ begin
+ TEncoding.GetBufferEncoding(AField.AsBytes, LEncoding);
+ Result := TInstantStringStream.Create(LEncoding.GetString(AField.AsBytes));
+ end;
+ {$ELSE}
+ Result := TInstantStringStream.Create(AField.AsString);
+ {$ENDIF}
+end;
+
+function TInstantCustomResolver.CreateEmbeddedObjectOutputStream(
+ const AConnector: TInstantConnector): TStream;
+begin
+ Assert(Assigned(AConnector));
+
+ {$IFDEF D12+}
+ if AConnector.BlobStreamFormat = sfBinary then
+ Result := TBytesStream.Create
+ else
+ Result := TStringStream.Create('', TEncoding.UTF8);
+ {$ELSE}
+ Result := TStringStream.Create('');
+ {$ENDIF}
+end;
+
+procedure TInstantCustomResolver.AssignEmbeddedObjectStreamToField(
+ const AConnector: TInstantConnector; const AStream: TStream; const AField: TField);
+begin
+ Assert(Assigned(AConnector));
+ Assert(Assigned(AStream));
+ Assert(Assigned(AField));
+ Assert(AField is TBlobField);
+
+ if AConnector.BlobStreamFormat = sfBinary then
+ TBlobField(AField).LoadFromStream(AStream)
+ else
+ AField.AsString := (AStream as TStringStream).DataString;
+end;
+
procedure TInstantCustomResolver.DisposeMap(AObject: TInstantObject;
Map: TInstantAttributeMap; ConflictAction: TInstantConflictAction;
Info: PInstantOperationInfo);
@@ -2329,7 +2388,7 @@
procedure TInstantNavigationalResolver.ReadPart(Attribute: TInstantPart);
var
Field: TField;
- Stream: TInstantStringStream;
+ Stream: TStream;
PartClassName: string;
ObjID: string;
begin
@@ -2356,7 +2415,7 @@
Field := FieldByName(Metadata.FieldName);
if not FieldHasObjects(Field) then
Exit;
- Stream := TInstantStringStream.Create(Field.AsString);
+ Stream := CreateEmbeddedObjectInputStream(Connector, Field);
try
LoadObjectFromStream(Stream);
finally
@@ -2369,7 +2428,7 @@
procedure TInstantNavigationalResolver.ReadParts(Attribute: TInstantParts);
var
Field: TField;
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2386,7 +2445,7 @@
Field := FieldByName(Metadata.FieldName);
if not FieldHasObjects(Field) then
Exit;
- Stream := TInstantStringStream.Create(Field.AsString);
+ Stream := CreateEmbeddedObjectInputStream(Connector, Field);
try
LoadObjectsFromStream(Stream);
finally
@@ -2413,7 +2472,7 @@
Attribute: TInstantReferences);
var
Field: TField;
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2430,7 +2489,7 @@
Field := FieldByName(Metadata.FieldName);
if not FieldHasObjects(Field) then
Exit;
- Stream := TInstantStringStream.Create(Field.AsString);
+ Stream := CreateEmbeddedObjectInputStream(Connector, Field);
try
LoadReferencesFromStream(Stream);
finally
@@ -2611,7 +2670,7 @@
procedure TInstantNavigationalResolver.WritePart(Attribute: TInstantPart);
var
Field: TField;
- Stream: TStringStream;
+ Stream: TStream;
begin
with Attribute do
begin
@@ -2622,16 +2681,15 @@
Value.ClassName;
FieldByName(Metadata.FieldName + InstantIdFieldName).AsString :=
Value.Id;
-// Value.ObjectStore.StoreObject(Value, caIgnore);
StoreObject(Value, caIgnore);
end
else
begin
Field := FieldByName(Metadata.FieldName);
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector);
try
SaveObjectToStream(Stream);
- Field.AsString := Stream.DataString;
+ AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field);
finally
Stream.Free;
end;
@@ -2642,7 +2700,7 @@
procedure TInstantNavigationalResolver.WriteParts(Attribute: TInstantParts);
var
Field: TField;
- Stream: TStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2663,10 +2721,10 @@
else
begin
Field := FieldByName(Metadata.FieldName);
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector);
try
SaveObjectsToStream(Stream);
- Field.AsString := Stream.DataString;
+ AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field);
finally
Stream.Free;
end;
@@ -2689,7 +2747,7 @@
Attribute: TInstantReferences);
var
Field: TField;
- Stream: TStringStream;
+ Stream: TStream;
LinkDatasetResolver: TInstantNavigationalLinkResolver;
begin
with Attribute do
@@ -2709,10 +2767,10 @@
else
begin
Field := FieldByName(Metadata.FieldName);
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Attribute.Connector);
try
SaveReferencesToStream(Stream);
- Field.AsString := Stream.DataString;
+ AssignEmbeddedObjectStreamToField(Attribute.Connector, Stream, Field);
finally
Stream.Free;
end;
@@ -2745,6 +2803,7 @@
var
FieldName: string;
+ (* No longer used. To be removed when things stabilize with D2009.
procedure AddBlobParam(const AFieldName, Value: string);
var
Param: TParam;
@@ -2762,6 +2821,7 @@
if Value <> '' then
Param.AsMemo := Value
end;
+ *)
procedure AddBlobAttributeParam;
var
@@ -2864,7 +2924,7 @@
procedure AddPartAttributeParam;
var
- Stream: TStringStream;
+ Stream: TStream;
Part: TInstantPart;
begin
if Attribute.Metadata.StorageKind = skExternal then
@@ -2876,13 +2936,10 @@
end
else
begin
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Broker.Connector);
try
(Attribute as TInstantPart).SaveObjectToStream(Stream);
- if Broker.Connector.BlobStreamFormat = sfBinary then
- AddBlobParam(FieldName, Stream.DataString)
- else
- AddMemoParam(FieldName, Stream.DataString);
+ AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream);
finally
Stream.Free;
end;
@@ -2891,15 +2948,12 @@
procedure AddPartsAttributeParam;
var
- Stream: TStringStream;
+ Stream: TStream;
begin
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Broker.Connector);
try
(Attribute as TInstantParts).SaveObjectsToStream(Stream);
- if Broker.Connector.BlobStreamFormat = sfBinary then
- AddBlobParam(FieldName, Stream.DataString)
- else
- AddMemoParam(FieldName, Stream.DataString);
+ AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream);
finally
Stream.Free;
end;
@@ -2917,15 +2971,12 @@
procedure AddReferencesAttributeParam;
var
- Stream: TStringStream;
+ Stream: TStream;
begin
- Stream := TStringStream.Create('');
+ Stream := CreateEmbeddedObjectOutputStream(Broker.Connector);
try
(Attribute as TInstantReferences).SaveReferencesToStream(Stream);
- if Broker.Connector.BlobStreamFormat = sfBinary then
- AddBlobParam(FieldName, Stream.DataString)
- else
- AddMemoParam(FieldName, Stream.DataString);
+ AddEmbeddedObjectOutputParam(Broker.Connector, Params, FieldName, Stream);
finally
Stream.Free;
end;
@@ -3008,6 +3059,37 @@
AddIntegerParam(Params, ConcurrencyParamName, AUpdateCount);
end;
+procedure TInstantSQLResolver.AddEmbeddedObjectOutputParam(
+ const AConnector: TInstantConnector; const AParams: TParams;
+ const AParamName: string; const AStream: TStream);
+var
+ LParam: TParam;
+begin
+ Assert(Assigned(AConnector));
+ Assert(Assigned(AParams));
+ Assert(AParamName <> '');
+ Assert(Assigned(AStream));
+
+ // Look in TInstantCustomResolver.CreateEmbeddedObjectOutputStream
+ // to see the stream type. Change there need to be propagated here.
+ if AConnector.BlobStreamFormat = sfBinary then
+ begin
+ LParam := AddParam(AParams, AParamName, ftBlob);
+ if AStream.Size > 0 then
+ {$IFDEF D12+}
+ LParam.AsBytes := (AStream as TBytesStream).Bytes;
+ {$ELSE}
+ LParam.AsMemo := (AStream as TStringStream).DataString;
+ {$ENDIF}
+ end
+ else
+ begin
+ LParam := AddParam(AParams, AParamName, ftMemo);
+ if AStream.Size > 0 then
+ LParam.AsMemo := (AStream as TStringStream).DataString;
+ end;
+end;
+
procedure TInstantSQLResolver.AddIdParam(Params: TParams;
const ParamName, Value: string);
var
@@ -3062,6 +3144,9 @@
TransError: Exception;
begin
try
+ {$IFDEF IO_STATEMENT_LOGGING}
+ InstantLogStatement(InstantLogStatementExecute, AStatement, AParams);
+ {$ENDIF}
Result := Broker.Execute(AStatement, AParams);
Info.Success := Result >= 1;
Info.Conflict := not (Info.Success or (ConflictAction = caIgnore));
@@ -3557,7 +3642,7 @@
procedure ReadPartAttribute;
var
- Stream: TInstantStringStream;
+ Stream: TStream;
LPartClassName: string;
LPartId: string;
begin
@@ -3583,8 +3668,9 @@
end
else
begin
- Stream := TInstantStringStream.Create(ReadBlobField(DataSet,
- AFieldName));
+ Stream := CreateEmbeddedObjectInputStream(
+ (Attribute as TInstantPart).Connector,
+ DataSet.FieldByName(AFieldName));
try
if Stream.Size = 0 then
(Attribute as TInstantPart).Reset
@@ -3598,7 +3684,7 @@
procedure ReadPartsAttribute;
var
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkResolver: TInstantSQLLinkResolver;
begin
if AttributeMetadata.StorageKind = skExternal then
@@ -3618,7 +3704,9 @@
end
else
begin
- Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName));
+ Stream := CreateEmbeddedObjectInputStream(
+ (Attribute as TInstantParts).Connector,
+ DataSet.FieldByName(AFieldName));
try
if Stream.Size = 0 then
(Attribute as TInstantParts).Reset
@@ -3639,7 +3727,7 @@
procedure ReadReferencesAttribute;
var
- Stream: TInstantStringStream;
+ Stream: TStream;
LinkResolver: TInstantSQLLinkResolver;
begin
if AttributeMetadata.StorageKind = skExternal then
@@ -3659,7 +3747,9 @@
end
else
begin
- Stream := TInstantStringStream.Create(ReadBlobField(DataSet, AFieldName));
+ Stream := CreateEmbeddedObjectInputStream(
+ (Attribute as TInstantReferences).Connector,
+ DataSet.FieldByName(AFieldName));
try
if Stream.Size = 0 then
(Attribute as TInstantReferences).Reset
@@ -3728,7 +3818,7 @@
function TInstantSQLResolver.ReadBlobField(DataSet: TDataSet;
const FieldName: string): string;
begin
- Result := DataSet.FieldByName(FieldName).AsString
+ Result := DataSet.FieldByName(FieldName).AsString;
end;
function TInstantSQLResolver.ReadBooleanField(DataSet: TDataSet;
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-14 19:28:40 UTC (rev 826)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-15 10:38:20 UTC (rev 827)
@@ -1465,7 +1465,9 @@
I: Integer;
Esc: string;
C: Char;
+ LString: string;
begin
+ LString := '';
for I := 1 to Length(Data) do
begin
C := Data[I];
@@ -1484,11 +1486,12 @@
Esc := 'gt';
end;
Esc := Format(EscStr, [Esc]);
- WriteString(Esc);
+ LString := LString + EscStr;
end
else
- WriteString(C);
+ LString := LString + C;
end;
+ WriteString(LString);
FLastToken := xtData;
end;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-14 19:28:40 UTC (rev 826)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-15 10:38:20 UTC (rev 827)
@@ -446,8 +446,8 @@
function GetStream: TMemoryStream;
property Stream: TMemoryStream read GetStream;
protected
- function GetValue: AnsiString; virtual;
- procedure SetValue(const AValue: AnsiString); virtual;
+ function GetValue: string; virtual;
+ procedure SetValue(const AValue: string); virtual;
class function AttributeType: TInstantAttributeType; override;
function GetAsString: string; override;
function GetAsVariant: Variant; override;
@@ -472,7 +472,7 @@
function WriteBuffer(const Buffer; Position, Count: Integer): Integer;
property Size: Integer read GetSize;
published
- property Value: AnsiString read GetValue write SetValue;
+ property Value: string read GetValue write SetValue;
end;
TInstantMemo = class(TInstantBlob)
@@ -3485,12 +3485,15 @@
Result := FStream;
end;
-function TInstantBlob.GetValue: AnsiString;
+function TInstantBlob.GetValue: string;
+var
+ LValue: AnsiString;
begin
if Size > 0 then
begin
- SetLength(Result, Size div SizeOf(AnsiChar));
- Read(Result[1], 0, Size);
+ SetLength(LValue, Size div SizeOf(AnsiChar));
+ Read(LValue[1], 0, Size);
+ Result := string(LValue);
end
else
Result := '';
@@ -3568,15 +3571,17 @@
end;
end;
-procedure TInstantBlob.SetValue(const AValue: AnsiString);
+procedure TInstantBlob.SetValue(const AValue: string);
var
L: Integer;
+ LValue: AnsiString;
begin
- L := Length(AValue) * SizeOf(AnsiChar);
+ LValue := AnsiString(AValue);
+ L := Length(LValue) * SizeOf(AnsiChar);
if L > 0 then
begin
Stream.Clear;
- WriteBuffer(AValue[1], 0, L);
+ WriteBuffer(LValue[1], 0, L);
Stream.Size := L;
end
else
@@ -4433,9 +4438,11 @@
begin
MemoryStream := TMemoryStream.Create;
try
- //CB: I don't know why MS-SQL via ADO or via DBX returns a stream with wrong size (+1)
- //so I've changed this test adding -1 (for other brokers this is not a problem)
- while AStream.Position < AStream.Size -1 do
+ // After reading the last object, the XML stream may still contain a few
+ // bytes for the final line break (in case the XML cose is beautified),
+ // so we go ahead and read another object ony if there's more bytes in the
+ // buffer.
+ while AStream.Position < AStream.Size - (Length(sLineBreak) * SizeOf(Char)) do
begin
MemoryStream.Clear;
InstantObjectTextToBinary(AStream, MemoryStream);
|
|
From: <na...@us...> - 2009-08-14 19:28:51
|
Revision: 826
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=826&view=rev
Author: nandod
Date: 2009-08-14 19:28:40 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
* XML I/O formatting and indentation rewritted. The former implementation broke a few tests.
* Changed a few calls to WriteStr to WriteUTF8Str in order to avoid warnings and better support unicode identifiers; added TInstantWriter.WriteUTF8Str for D<2009.
Modified Paths:
--------------
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantMetadata.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Tests/TestIO.mdx
trunk/Tests/TestIO.mdxt
trunk/Tests/TestIO_D2009.mdx
trunk/Tests/TestIO_D2009.mdxt
trunk/Tests/TestInstantClasses.pas
trunk/Tests/TestMinimalModel.pas
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-14 09:20:30 UTC (rev 825)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-14 19:28:40 UTC (rev 826)
@@ -200,6 +200,7 @@
procedure WriteProperties(AObject: TPersistent);
{$IFNDEF UNICODE}
procedure WriteString(const Value: string);
+ procedure WriteUTF8Str(const Value: string); inline;
{$ENDIF}
procedure WriteValue(Value: TValueType);
property Stream: TStream read FStream;
@@ -262,27 +263,29 @@
end;
{$ENDIF}
+ TInstantXMLToken = (xtNone, xtStartTag, xtEndTag, xtAnyTag, xtData);
+
TInstantXMLProducer = class(TObject)
private
FStream: TStream;
FTagStack: TStringList;
FWriter: TAbstractWriter;
- FCurrentIndentationSize: Integer;
+ FIndentationSize: Integer;
+ FLastToken: TInstantXMLToken;
function GetCurrentTag: string;
function GetEof: Boolean;
function GetPosition: Integer;
function GetTagStack: TStringList;
function GetWriter: TAbstractWriter;
procedure SetPosition(Value: Integer);
+ protected
+ function IsPrettyXMLEnabled: Boolean;
procedure WriteString(const S: string);
- protected
property TagStack: TStringList read GetTagStack;
property Writer: TAbstractWriter read GetWriter;
- public
- procedure Indent;
- procedure Unindent;
procedure WriteIndentation;
procedure WriteLineBreak;
+ public
constructor Create(Stream: TStream);
destructor Destroy; override;
procedure WriteEscapedData(const Data: string);
@@ -295,8 +298,6 @@
property Stream: TStream read FStream;
end;
- TInstantXMLToken = (xtTag, xtData);
-
TInstantXMLProcessor = class(TObject)
private
FReader: TAbstractReader;
@@ -310,6 +311,7 @@
protected
procedure CheckToken(AToken: TInstantXMLToken);
function PeekChar: Char;
+ function PeekCharSkippingBlanks: Char;
function ReadChar: Char;
procedure SkipBlanks;
property Reader: TAbstractReader read GetReader;
@@ -1073,7 +1075,7 @@
procedure TInstantWriter.WriteObject(AObject: TPersistent);
begin
- WriteStr(AObject.ClassName);
+ WriteUTF8Str(AObject.ClassName);
if AObject is TInstantStreamable then
TInstantStreamable(AObject).WriteObject(Self)
else if AObject is TInstantCollection then
@@ -1093,6 +1095,11 @@
WriteListEnd;
end;
+procedure TInstantWriter.WriteValue(Value: TValueType);
+begin
+ inherited WriteValue(Value);
+end;
+
{$IFNDEF UNICODE}
procedure TInstantWriter.WriteString(const Value: string);
var
@@ -1110,12 +1117,22 @@
end;
Write(Pointer(Value)^, L);
end;
-{$ENDIF}
-procedure TInstantWriter.WriteValue(Value: TValueType);
+procedure TInstantWriter.WriteUTF8Str(const Value: string);
+var
+ U: UTF8String;
+ L: Integer;
begin
- inherited;
+ // Note: in versions of Delphi that don't have AnsiToUtf8, just use:
+ // WriteStr(Value);
+ // as the body for this function.
+ U := AnsiToUtf8(Value);
+ L := Length(U);
+ if L > 255 then L := 255;
+ Write(L, SizeOf(Byte));
+ Write(U[1], L);
end;
+{$ENDIF}
{ TInstantStream }
@@ -1348,26 +1365,17 @@
{ TInstantXMLProducer }
-procedure TInstantXMLProducer.Indent;
+function TInstantXMLProducer.IsPrettyXMLEnabled: Boolean;
begin
- Inc(FCurrentIndentationSize, InstantXMLIndentationSize);
+ Result := FIndentationSize > 0;
end;
-procedure TInstantXMLProducer.Unindent;
-begin
- Dec(FCurrentIndentationSize, InstantXMLIndentationSize);
- if InstantXMLIndentationSize >= 0 then
- begin
- WriteLineBreak;
- WriteIndentation;
- end;
-end;
-
-
constructor TInstantXMLProducer.Create(Stream: TStream);
begin
inherited Create;
FStream := Stream;
+ FLastToken := xtNone;
+ FIndentationSize := InstantXMLIndentationSize;
end;
destructor TInstantXMLProducer.Destroy;
@@ -1415,15 +1423,39 @@
procedure TInstantXMLProducer.WriteData(const Data: string);
begin
WriteString(Data);
+ FLastToken := xtData;
end;
+procedure TInstantXMLProducer.WriteStartTag(const Tag: string);
+begin
+ if IsPrettyXMLEnabled then
+ begin
+ if FLastToken = xtStartTag then
+ WriteLineBreak;
+ WriteIndentation;
+ end;
+ WriteString(InstantBuildStartTag(Tag));
+ TagStack.Add(Tag);
+ FLastToken := xtStartTag;
+end;
+
procedure TInstantXMLProducer.WriteEndTag;
var
- Index: Integer;
+ LTagName: string;
begin
- Index := TagStack.Count - 1;
- WriteString(InstantBuildEndTag(TagStack[Index]));
- TagStack.Delete(Index);
+ LTagName := TagStack[TagStack.Count - 1];
+ TagStack.Delete(TagStack.Count - 1);
+ if IsPrettyXMLEnabled then
+ begin
+ if FLastToken = xtStartTag then
+ WriteLineBreak;
+ if FLastToken in [xtStartTag, xtEndTag] then
+ WriteIndentation;
+ end;
+ WriteString(InstantBuildEndTag(LTagName));
+ if IsPrettyXMLEnabled then
+ WriteLineBreak;
+ FLastToken := xtEndTag;
end;
procedure TInstantXMLProducer.WriteEscapedData(const Data: string);
@@ -1453,28 +1485,13 @@
end;
Esc := Format(EscStr, [Esc]);
WriteString(Esc);
- end else//MC if C in [#32..#126] then
+ end
+ else
WriteString(C);
-(* MC
- else begin
- Esc := Format(EscStr, [Format('#%d', [Ord(C)])]);
- WriteString(Esc);
- end;
-*)
end;
+ FLastToken := xtData;
end;
-procedure TInstantXMLProducer.WriteStartTag(const Tag: string);
-begin
- if InstantXMLIndentationSize >= 0 then
- begin
- WriteLineBreak;
- WriteIndentation;
- end;
- WriteString(InstantBuildStartTag(Tag));
- TagStack.Add(Tag);
-end;
-
procedure TInstantXMLProducer.WriteLineBreak;
begin
WriteString(sLineBreak);
@@ -1482,8 +1499,7 @@
procedure TInstantXMLProducer.WriteIndentation;
begin
- if FCurrentIndentationSize > 0 then
- WriteString(DupeString(' ' , FCurrentIndentationSize));
+ WriteString(DupeString(' ' , TagStack.Count * FIndentationSize));
end;
procedure TInstantXMLProducer.WriteString(const S: string);
@@ -1534,8 +1550,8 @@
function TInstantXMLProcessor.GetToken: TInstantXMLToken;
begin
- if PeekChar = InstantTagStart then
- Result := xtTag
+ if PeekCharSkippingBlanks = InstantTagStart then
+ Result := xtAnyTag
else
Result := xtData;
end;
@@ -1552,6 +1568,19 @@
end;
end;
+function TInstantXMLProcessor.PeekCharSkippingBlanks: Char;
+var
+ Pos: Integer;
+begin
+ Pos := Position;
+ try
+ SkipBlanks;
+ Result := ReadChar;
+ finally
+ Position := Pos;
+ end;
+end;
+
function TInstantXMLProcessor.PeekTag: string;
var
Pos: Integer;
@@ -1645,7 +1674,7 @@
Pos := Position;
try
SkipBlanks;
- CheckToken(xtTag);
+ CheckToken(xtAnyTag);
except
Position := Pos;
raise;
@@ -1687,7 +1716,7 @@
EndTag := InstantBuildEndTag(TagName);
Level := 1;
repeat
- if Token = xtTag then
+ if Token = xtAnyTag then
begin
TagName := ReadTag;
if SameText(TagName, StartTag) then
@@ -1789,7 +1818,6 @@
Result := Reader.Stream;
end;
-
function TInstantBinaryToTextConverter.GetOutput: TStream;
begin
Result := Producer.Stream;
@@ -1800,7 +1828,6 @@
PushObjectClass(FindClass(Reader.ReadStr));
try
Producer.WriteStartTag(ObjectClassName);
- Producer.Indent;
if ObjectClass.InheritsFrom(TInstantStreamable) then
TInstantStreamableClass(ObjectClass).ConvertToText(Self)
else if ObjectClass.InheritsFrom(TInstantCollection) then
@@ -1808,7 +1835,6 @@
else if ObjectClass.InheritsFrom(TInstantCollectionItem) then
TInstantCollectionItemClass(ObjectClass).ConvertToText(Self);
Reader.ReadListEnd;
- Producer.Unindent;
Producer.WriteEndTag;
finally
PopObjectClass;
@@ -1878,7 +1904,6 @@
end;
begin
- Producer.Indent;
while not Reader.EndOfList do
begin
Producer.WriteStartTag(Reader.ReadStr);
@@ -1886,7 +1911,6 @@
Producer.WriteEndTag;
end;
Reader.ReadListEnd;
- Producer.Unindent;
end;
{ TInstantToTextToBinaryConverter }
@@ -1934,7 +1958,7 @@
begin
PropName := Processor.ReadTagName;
ValueStr := Processor.ReadData;
- Writer.WriteStr(PropName);
+ Writer.WriteUTF8Str(PropName);
case GetTypeInfo(PropInfo)^.Kind of //PropInfo^.PropType^^.Kind of
tkInteger:
Writer.WriteInteger(StrToInt(ValueStr));
@@ -1966,7 +1990,7 @@
try
InstantStrToList(ValueStr, S, [',']);
for I := 0 to Pred(S.Count) do
- Writer.WriteStr(S[I]);
+ Writer.WriteUTF8Str(S[I]);
finally
S.Free;
end;
@@ -2012,7 +2036,7 @@
begin
PushObjectClass(FindClass(Processor.ReadTagName));
try
- Writer.WriteStr(ObjectClassName);
+ Writer.WriteUTF8Str(ObjectClassName);
if ObjectClass.InheritsFrom(TInstantStreamable) then
TInstantStreamableClass(ObjectClass).ConvertToBinary(Self)
else if ObjectClass.InheritsFrom(TInstantCollection) then
Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas 2009-08-14 09:20:30 UTC (rev 825)
+++ trunk/Source/Core/InstantConsts.pas 2009-08-14 19:28:40 UTC (rev 826)
@@ -79,7 +79,7 @@
{$ENDIF}
var
- InstantXMLIndentationSize: Integer = 2;
+ InstantXMLIndentationSize: Byte = 2;
resourcestring
SAccessError = 'Cannot access attribute %s(''%s'') as type: %s';
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2009-08-14 09:20:30 UTC (rev 825)
+++ trunk/Source/Core/InstantMetadata.pas 2009-08-14 19:28:40 UTC (rev 826)
@@ -623,8 +623,8 @@
with Converter do
begin
ConvertProperties(InstantBuildStartTag(InstantAttributeMetadatasTagName));
- Processor.ReadTag;
- if (Processor.Token = xtTag) and not SameText(Processor.PeekTag,
+ Assert(Processor.ReadTagName = InstantAttributeMetadatasTagName);
+ if (Processor.Token = xtAnyTag) and not SameText(Processor.PeekTag,
InstantBuildEndTag(InstantAttributeMetadatasTagName)) then
Convert;
Processor.ReadTag;
@@ -1942,28 +1942,5 @@
inherited Items[Index] := Value;
end;
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
end.
+
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-14 09:20:30 UTC (rev 825)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-14 19:28:40 UTC (rev 826)
@@ -2265,8 +2265,8 @@
begin
with Writer do
begin
- WriteStr(ObjectClassName);
- WriteStr(ObjectId);
+ WriteUTF8Str(ObjectClassName);
+ WriteUTF8Str(ObjectId);
WriteListEnd;
WriteListEnd;
end;
@@ -2277,8 +2277,8 @@
inherited;
Writer.WriteStr('');
Writer.WriteStr('');
- Writer.WriteStr(ObjectClassName);
- Writer.WriteStr(ObjectId);
+ Writer.WriteUTF8Str(ObjectClassName);
+ Writer.WriteUTF8Str(ObjectId);
end;
{ TInstantAttribute }
@@ -2550,7 +2550,7 @@
procedure TInstantAttribute.WriteName(Writer: TInstantWriter);
begin
- Writer.WriteStr(Name);
+ Writer.WriteUTF8Str(Name);
end;
{ TInstantSimple }
@@ -5522,7 +5522,7 @@
with Converter do
begin
AttributeName := Processor.ReadTagName;
- Writer.WriteStr(AttributeName);
+ Writer.WriteUTF8Str(AttributeName);
case AttributeMetadata.AttributeType of
atInteger:
Writer.WriteInteger(StrToInt(Processor.ReadData));
@@ -5599,11 +5599,11 @@
if Processor.PeekTagName = InstantIdFieldName then
begin
Processor.ReadTag;
- if (Processor.Token = xtTag) and SameText(Processor.ReadTagName,
+ if (Processor.Token = xtAnyTag) and SameText(Processor.ReadTagName,
InstantBuildEndTag(InstantIdFieldName)) then
Writer.WriteStr('')
else begin
- Writer.WriteStr(Processor.ReadData);
+ Writer.WriteUTF8Str(Processor.ReadData);
Processor.ReadTag;
end;
end else
@@ -5642,9 +5642,7 @@
vaIdent:
begin
Reader.ReadIdent;
- Producer.Indent;
Convert;
- Producer.Unindent;
end;
vaFalse:
begin
@@ -5669,11 +5667,9 @@
vaCollection:
begin
Reader.ReadValue;
- Producer.Indent;
- while not Reader.EndOfList do
- Convert;
- Producer.Unindent;
- Reader.ReadListEnd;
+ while not Reader.EndOfList do
+ Convert;
+ Reader.ReadListEnd;
end;
else
raise EInstantStreamError.CreateFmt(SInvalidValueType,
@@ -6831,7 +6827,7 @@
procedure TInstantObject.WriteObject(Writer: TInstantWriter);
begin
- Writer.WriteStr(Id);
+ Writer.WriteUTF8Str(Id);
WriteAttributes(Writer);
end;
Modified: trunk/Tests/TestIO.mdx
===================================================================
--- trunk/Tests/TestIO.mdx 2009-08-14 09:20:30 UTC (rev 825)
+++ trunk/Tests/TestIO.mdx 2009-08-14 19:28:40 UTC (rev 826)
@@ -1 +1,461 @@
-<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCategory</Name><Persistence>peStored</Persistence><StorageName>Categories</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ValidCharsString>,.0..9\x82\xAC\xE2</ValidCharsString></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>EmploymentDate</Name><AttributeType>atDate</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>BirthTime</Name><AttributeType>atTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>RelatedProjectBoxes</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectBox</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
+<TInstantClassMetadatas>
+ <TInstantClassMetadata>
+ <Name>TAddress</Name>
+ <Persistence>peEmbedded</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>City</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>TRUE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Country</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCountry</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>State</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>4</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Street</Name>
+ <AttributeType>atMemo</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Zip</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>10</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TCountry</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TPhone</Name>
+ <Persistence>peEmbedded</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>20</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Number</Name>
+ <AttributeType>atString</AttributeType>
+ <EditMask>(000) 000-0000;0;_</EditMask>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>20</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TEmail</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Address</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>100</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TCategory</Name>
+ <Persistence>peStored</Persistence>
+ <StorageName>Categories</StorageName>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TContact</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Address</Name>
+ <AttributeType>atPart</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TAddress</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Category</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCategory</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>City</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>TRUE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>TRUE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>50</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Phones</Name>
+ <AttributeType>atParts</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TPhone</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Projects</Name>
+ <AttributeType>atReferences</AttributeType>
+ <ExternalStorageName>Contact_Projects</ExternalStorageName>
+ <StorageKind>skExternal</StorageKind>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TProject</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>ExternalAddress</Name>
+ <AttributeType>atPart</AttributeType>
+ <StorageKind>skExternal</StorageKind>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TExternalAddress</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>ExternalPhones</Name>
+ <AttributeType>atParts</AttributeType>
+ <ExternalStorageName>Contact_ExternalPhones</ExternalStorageName>
+ <StorageKind>skExternal</StorageKind>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TExternalPhone</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TContactFilter</Name>
+ <ParentName>TContact</ParentName>
+ <Persistence>peEmbedded</Persistence>
+ <AttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TPerson</Name>
+ <ParentName>TContact</ParentName>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>BirthDate</Name>
+ <AttributeType>atDateTime</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Emails</Name>
+ <AttributeType>atParts</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TEmail</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Employer</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCompany</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Picture</Name>
+ <AttributeType>atBlob</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Salary</Name>
+ <AttributeType>atCurrency</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ValidCharsString>,.0..9\x82\xAC\xE2</ValidCharsString>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Employed</Name>
+ <AttributeType>atBoolean</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>AL_hours</Name>
+ <AttributeType>atFloat</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>EmploymentDate</Name>
+ <AttributeType>atDate</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>BirthTime</Name>
+ <AttributeType>atTime</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TCompany</Name>
+ <ParentName>TContact</ParentName>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Employees</Name>
+ <AttributeType>atReferences</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TPerson</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>NoOfBranches</Name>
+ <AttributeType>atInteger</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Subsidiaries</Name>
+ <AttributeType>atReferences</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCompany</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TProject</Name>
+ <Persistence>peStored</Persistence>
+ <StorageName>Projects</StorageName>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>SubProjects</Name>
+ <AttributeType>atParts</AttributeType>
+ <ExternalStorageName>Project_SubProjects</ExternalStorageName>
+ <StorageKind>skExternal</StorageKind>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TProject</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Addresses</Name>
+ <AttributeType>atParts</AttributeType>
+ <ExternalStorageName>Project_Addresses</ExternalStorageName>
+ <StorageKind>skExternal</StorageKind>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TExternalAddress</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Manager</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TContact</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Participants</Name>
+ <AttributeType>atReferences</AttributeType>
+ <ExternalStorageName>Project_Participants</ExternalStorageName>
+ <StorageKind>skExternal</StorageKind>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TContact</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Items</Name>
+ <AttributeType>atPart</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TProjectItems</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TExternalAddress</Name>
+ <Persistence>peStored</Persistence>
+ <StorageName>ExternalAddresses</StorageName>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Category</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCategory</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Site_Contact</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TPerson</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TExternalPhone</Name>
+ <Persistence>peStored</Persistence>
+ <StorageName>ExternalPhones</StorageName>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>20</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Number</Name>
+ <AttributeType>atString</AttributeType>
+ <EditMask>(000) 000-0000;0;_</EditMask>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>20</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TProjectBox</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Project</Name>
+ <AttributeType>atPart</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TProject</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>RelatedProjectBoxes</Name>
+ <AttributeType>atReferences</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TProjectBox</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TProjectItem</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Description</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>50</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Country</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCountry</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TProjectItems</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Items</Name>
+ <AttributeType>atParts</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TProjectItem</ObjectClassName>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+</TInstantClassMetadatas>
Modified: trunk/Tests/TestIO.mdxt
===================================================================
--- trunk/Tests/TestIO.mdxt 2009-08-14 09:20:30 UTC (rev 825)
+++ trunk/Tests/TestIO.mdxt 2009-08-14 19:28:40 UTC (rev 826)
@@ -1 +1,445 @@
-<TInstantClassMetadatas><TInstantClassMetadata><Name>TAddress</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>State</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>4</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Street</Name><AttributeType>atMemo</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Zip</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>10</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCountry</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPhone</Name><Persistence>peEmbedded</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TEmail</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>100</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContact</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Address</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>City</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>TRUE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Phones</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPhone</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Projects</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Contact_Projects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalAddress</Name><AttributeType>atPart</AttributeType><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>ExternalPhones</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Contact_ExternalPhones</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalPhone</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TContactFilter</Name><ParentName>TContact</ParentName><Persistence>peEmbedded</Persistence><AttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TPerson</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>BirthDate</Name><AttributeType>atDateTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Emails</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TEmail</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employer</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Picture</Name><AttributeType>atBlob</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Salary</Name><AttributeType>atCurrency</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ValidCharsString>,.0..9\x82\xAC\xE2</ValidCharsString></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Employed</Name><AttributeType>atBoolean</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>AL_hours</Name><AttributeType>atFloat</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>EmploymentDate</Name><AttributeType>atDate</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>BirthTime</Name><AttributeType>atTime</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TCompany</Name><ParentName>TContact</ParentName><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Employees</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>NoOfBranches</Name><AttributeType>atInteger</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Subsidiaries</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCompany</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProject</Name><Persistence>peStored</Persistence><StorageName>Projects</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>SubProjects</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_SubProjects</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Addresses</Name><AttributeType>atParts</AttributeType><ExternalStorageName>Project_Addresses</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TExternalAddress</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Manager</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Participants</Name><AttributeType>atReferences</AttributeType><ExternalStorageName>Project_Participants</ExternalStorageName><StorageKind>skExternal</StorageKind><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TContact</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItems</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalAddress</Name><Persistence>peStored</Persistence><StorageName>ExternalAddresses</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>30</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Category</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCategory</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Site_Contact</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TPerson</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TExternalPhone</Name><Persistence>peStored</Persistence><StorageName>ExternalPhones</StorageName><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Name</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Number</Name><AttributeType>atString</AttributeType><EditMask>(000) 000-0000;0;_</EditMask><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>20</Size></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectBox</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Project</Name><AttributeType>atPart</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProject</ObjectClassName></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>RelatedProjectBoxes</Name><AttributeType>atReferences</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectBox</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItem</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Description</Name><AttributeType>atString</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><Size>50</Size></TInstantAttributeMetadata><TInstantAttributeMetadata><Name>Country</Name><AttributeType>atReference</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TCountry</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata><TInstantClassMetadata><Name>TProjectItems</Name><Persistence>peStored</Persistence><AttributeMetadatas><TInstantAttributeMetadatas><TInstantAttributeMetadata><Name>Items</Name><AttributeType>atParts</AttributeType><IsIndexed>FALSE</IsIndexed><IsRequired>FALSE</IsRequired><ObjectClassName>TProjectItem</ObjectClassName></TInstantAttributeMetadata></TInstantAttributeMetadatas></AttributeMetadatas></TInstantClassMetadata></TInstantClassMetadatas>
\ No newline at end of file
+<TInstantClassMetadatas>
+ <TInstantClassMetadata>
+ <Name>TAddress</Name>
+ <Persistence>peEmbedded</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>City</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>TRUE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Country</Name>
+ <AttributeType>atReference</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <ObjectClassName>TCountry</ObjectClassName>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>State</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>4</Size>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Street</Name>
+ <AttributeType>atMemo</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ </TInstantAttributeMetadata>
+ <TInstantAttributeMetadata>
+ <Name>Zip</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>10</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TCountry</Name>
+ <Persistence>peStored</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMetadatas>
+ <TInstantAttributeMetadata>
+ <Name>Name</Name>
+ <AttributeType>atString</AttributeType>
+ <IsIndexed>FALSE</IsIndexed>
+ <IsRequired>FALSE</IsRequired>
+ <Size>30</Size>
+ </TInstantAttributeMetadata>
+ </TInstantAttributeMetadatas>
+ </AttributeMetadatas>
+ </TInstantClassMetadata>
+ <TInstantClassMetadata>
+ <Name>TPhone</Name>
+ <Persistence>peEmbedded</Persistence>
+ <AttributeMetadatas>
+ <TInstantAttributeMeta...
[truncated message content] |
|
From: <dav...@us...> - 2009-08-14 09:20:40
|
Revision: 825
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=825&view=rev
Author: davidvtaylor
Date: 2009-08-14 09:20:30 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
Revert rev 824 changes in rev 823 corrected the issue
Revision Links:
--------------
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=824&view=rev
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=823&view=rev
Modified Paths:
--------------
trunk/Source/Core/InstantCode.pas
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2009-08-14 08:30:21 UTC (rev 824)
+++ trunk/Source/Core/InstantCode.pas 2009-08-14 09:20:30 UTC (rev 825)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
- * Uberto Barbini, Joao Morais, Riceball Lee, Brian Andersen, David Taylor
+ * Uberto Barbini, Joao Morais, Riceball Lee, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -8880,22 +8880,15 @@
var
Section: TInstantCodeInitializationSection;
- Origin: TInstantCodePos;
Pos: TInstantCodePos;
begin
Section := Module.InitializationSection;
if not Section.IsFiled then
begin
CursorPos := Module.ImplementationSection.EndPos;
- Origin := CursorPos;
InsertMode := imAfter;
InsertObjectText(Section);
-
- // Set position of newly added Initialization section
- Section.StartPos := Origin;
- Section.EndPos := CursorPos;
end;
-
CursorPos := Section.StartPos;
SkipLine;
if FindText(RegisterProcName) then
|
|
From: <dav...@us...> - 2009-08-14 08:30:30
|
Revision: 824
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=824&view=rev
Author: davidvtaylor
Date: 2009-08-14 08:30:21 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
Fix for "ModelExplorer can cannot insert InstantRegisterClasses on an "empty" unit" under D2009
- Added logic to explicitly set the StartPos and EndPos of the newly added InitializationSection.
Note: The design of the original logic is flawed and fails to properly initialize the position of newly inserted Code Sections. The code worked under previous versions of Delphi, but apparently largely by accident. A related coding error in TInstantCodeModifier.InsertObjectText corrected in Rev 815 appears to have masked this defect.
Revision Links:
--------------
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=815&view=rev
Modified Paths:
--------------
trunk/Source/Core/InstantCode.pas
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2009-08-14 07:22:59 UTC (rev 823)
+++ trunk/Source/Core/InstantCode.pas 2009-08-14 08:30:21 UTC (rev 824)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
- * Uberto Barbini, Joao Morais, Riceball Lee, Brian Andersen
+ * Uberto Barbini, Joao Morais, Riceball Lee, Brian Andersen, David Taylor
*
* ***** END LICENSE BLOCK ***** *)
@@ -8880,15 +8880,22 @@
var
Section: TInstantCodeInitializationSection;
+ Origin: TInstantCodePos;
Pos: TInstantCodePos;
begin
Section := Module.InitializationSection;
if not Section.IsFiled then
begin
CursorPos := Module.ImplementationSection.EndPos;
+ Origin := CursorPos;
InsertMode := imAfter;
InsertObjectText(Section);
+
+ // Set position of newly added Initialization section
+ Section.StartPos := Origin;
+ Section.EndPos := CursorPos;
end;
+
CursorPos := Section.StartPos;
SkipLine;
if FindText(RegisterProcName) then
|
|
From: <na...@us...> - 2009-08-14 07:23:07
|
Revision: 823
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=823&view=rev
Author: nandod
Date: 2009-08-14 07:22:59 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
* D2009: Fixed error "implementation expected" when adding the first class to an otherwise empty model unit at design time.
Modified Paths:
--------------
trunk/Source/Core/InstantCode.pas
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2009-08-14 07:18:46 UTC (rev 822)
+++ trunk/Source/Core/InstantCode.pas 2009-08-14 07:22:59 UTC (rev 823)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell,
+ * Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
* Uberto Barbini, Joao Morais, Riceball Lee, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -6520,7 +6520,7 @@
function TInstantCodeWriter.GetStreamPos: Int64;
begin
- Result := inherited GetStreamPos + Origin.Offset;
+ Result := inherited GetStreamPos + (Origin.Offset * SizeOf(Char));
end;
procedure TInstantCodeWriter.Indent;
@@ -6536,7 +6536,7 @@
procedure TInstantCodeWriter.SetStreamPos(Value: Int64);
begin
- inherited SetStreamPos(Value - Origin.Offset);
+ inherited SetStreamPos(Value - (Origin.Offset * SizeOf(Char)));
end;
procedure TInstantCodeWriter.Unindent;
@@ -8631,6 +8631,7 @@
try
Writer := TInstantCodeWriter.Create(Stream);
try
+ Writer.Origin := CursorPos;
while IndentLevel > 0 do
begin
Writer.Indent;
|
|
From: <na...@us...> - 2009-08-14 07:18:55
|
Revision: 822
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=822&view=rev
Author: nandod
Date: 2009-08-14 07:18:46 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
* svn properties set.
- Removed ZeosDBO package from core project groups.
Modified Paths:
--------------
trunk/Source/PackageGroups/D7/DesignTimePackages.bpg
trunk/Source/PackageGroups/D7/RunTimePackages.bpg
Property Changed:
----------------
trunk/Demos/PrimerCross/
trunk/Source/Brokers/ADO/D2009/
trunk/Source/Brokers/BDE/D2009/
trunk/Source/Brokers/DBX/D2009/
trunk/Source/Brokers/IBX/D2009/
trunk/Source/Brokers/XML/D2009/
trunk/Source/Catalogs/IBFb/D2009/
trunk/Source/Catalogs/MSSql/D2009/
trunk/Source/Catalogs/MySQL/D2009/
Property changes on: trunk/Demos/PrimerCross
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.~*
*.ddp
*.exe
__history
*.identcache
*.local
*.dsk
*.MB
XMLDB
+ *.dcu
*.~*
*.ddp
*.exe
__history
*.identcache
*.local
*.dsk
*.MB
XMLDB
PrimerExternal_D2009.xml
Property changes on: trunk/Source/Brokers/ADO/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/BDE/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/DBX/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/IBX/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Brokers/XML/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
__history
*.local
+ *.dcu
__history
*.local
*.identcache
Property changes on: trunk/Source/Catalogs/IBFb/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Catalogs/MSSql/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Property changes on: trunk/Source/Catalogs/MySQL/D2009
___________________________________________________________________
Modified: svn:ignore
- *.dcu
*.local
+ *.dcu
*.local
*.identcache
Modified: trunk/Source/PackageGroups/D7/DesignTimePackages.bpg
===================================================================
--- trunk/Source/PackageGroups/D7/DesignTimePackages.bpg 2009-08-14 07:15:58 UTC (rev 821)
+++ trunk/Source/PackageGroups/D7/DesignTimePackages.bpg 2009-08-14 07:18:46 UTC (rev 822)
@@ -10,7 +10,7 @@
BRCC = $(ROOT)\bin\brcc32.exe $**
#------------------------------------------------------------------------------
PROJECTS = dclIOCore_D7.bpl dclIOADO_D7.bpl dclIOBDE_D7.bpl dclIODBX_D7.bpl \
- dclIOIBX_D7.bpl dclIOXML_D7.bpl DclIOZeosDBO_D7.bpl
+ dclIOIBX_D7.bpl dclIOXML_D7.bpl
#------------------------------------------------------------------------------
default: $(PROJECTS)
#------------------------------------------------------------------------------
@@ -33,7 +33,3 @@
dclIOXML_D7.bpl: ..\..\Brokers\XML\D7\dclIOXML.dpk
$(DCC)
-DclIOZeosDBO_D7.bpl: ..\..\Brokers\ZeosDBO\D7\DclIOZeosDBO.dpk
- $(DCC)
-
-
Modified: trunk/Source/PackageGroups/D7/RunTimePackages.bpg
===================================================================
--- trunk/Source/PackageGroups/D7/RunTimePackages.bpg 2009-08-14 07:15:58 UTC (rev 821)
+++ trunk/Source/PackageGroups/D7/RunTimePackages.bpg 2009-08-14 07:18:46 UTC (rev 822)
@@ -11,7 +11,7 @@
#------------------------------------------------------------------------------
PROJECTS = IOCore_D7.bpl IOMSSqlCatalog_D7.bpl IOIBFbCatalog_D7.bpl \
IOMySQLCatalog_D7.bpl IOADO_D7.bpl IOBDE_D7.bpl IODBX_D7.bpl IOIBX_D7.bpl \
- IOXML_D7.bpl IOZeosDBO_D7.bpl
+ IOXML_D7.bpl
#------------------------------------------------------------------------------
default: $(PROJECTS)
#------------------------------------------------------------------------------
@@ -43,7 +43,3 @@
IOMySQLCatalog_D7.bpl: ..\..\Catalogs\MySQL\D7\IOMySQLCatalog.dpk
$(DCC)
-IOZeosDBO_D7.bpl: ..\..\Brokers\ZeosDBO\D7\IOZeosDBO.dpk
- $(DCC)
-
-
|
|
From: <na...@us...> - 2009-08-14 07:16:13
|
Revision: 821
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=821&view=rev
Author: nandod
Date: 2009-08-14 07:15:58 +0000 (Fri, 14 Aug 2009)
Log Message:
-----------
* All XML output is now formatted and indented for better displaying, comparing, etc.
* D2009: Fixed transliteration problems with XML container blobs.
* Small optimization for InstantGetPropName.
Modified Paths:
--------------
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantConsts.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantRtti.pas
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -267,6 +267,7 @@
FStream: TStream;
FTagStack: TStringList;
FWriter: TAbstractWriter;
+ FCurrentIndentationSize: Integer;
function GetCurrentTag: string;
function GetEof: Boolean;
function GetPosition: Integer;
@@ -278,6 +279,10 @@
property TagStack: TStringList read GetTagStack;
property Writer: TAbstractWriter read GetWriter;
public
+ procedure Indent;
+ procedure Unindent;
+ procedure WriteIndentation;
+ procedure WriteLineBreak;
constructor Create(Stream: TStream);
destructor Destroy; override;
procedure WriteEscapedData(const Data: string);
@@ -452,7 +457,7 @@
implementation
uses
- TypInfo, InstantUtils, InstantRtti;
+ TypInfo, StrUtils, InstantUtils, InstantRtti;
const
ResourceHeader : packed array[0..31] of Byte = ($00,$00,$00,$00,$20,$00,$00,
@@ -1343,6 +1348,22 @@
{ TInstantXMLProducer }
+procedure TInstantXMLProducer.Indent;
+begin
+ Inc(FCurrentIndentationSize, InstantXMLIndentationSize);
+end;
+
+procedure TInstantXMLProducer.Unindent;
+begin
+ Dec(FCurrentIndentationSize, InstantXMLIndentationSize);
+ if InstantXMLIndentationSize >= 0 then
+ begin
+ WriteLineBreak;
+ WriteIndentation;
+ end;
+end;
+
+
constructor TInstantXMLProducer.Create(Stream: TStream);
begin
inherited Create;
@@ -1445,10 +1466,26 @@
procedure TInstantXMLProducer.WriteStartTag(const Tag: string);
begin
+ if InstantXMLIndentationSize >= 0 then
+ begin
+ WriteLineBreak;
+ WriteIndentation;
+ end;
WriteString(InstantBuildStartTag(Tag));
TagStack.Add(Tag);
end;
+procedure TInstantXMLProducer.WriteLineBreak;
+begin
+ WriteString(sLineBreak);
+end;
+
+procedure TInstantXMLProducer.WriteIndentation;
+begin
+ if FCurrentIndentationSize > 0 then
+ WriteString(DupeString(' ' , FCurrentIndentationSize));
+end;
+
procedure TInstantXMLProducer.WriteString(const S: string);
var
U: UTF8String;
@@ -1763,6 +1800,7 @@
PushObjectClass(FindClass(Reader.ReadStr));
try
Producer.WriteStartTag(ObjectClassName);
+ Producer.Indent;
if ObjectClass.InheritsFrom(TInstantStreamable) then
TInstantStreamableClass(ObjectClass).ConvertToText(Self)
else if ObjectClass.InheritsFrom(TInstantCollection) then
@@ -1770,6 +1808,7 @@
else if ObjectClass.InheritsFrom(TInstantCollectionItem) then
TInstantCollectionItemClass(ObjectClass).ConvertToText(Self);
Reader.ReadListEnd;
+ Producer.Unindent;
Producer.WriteEndTag;
finally
PopObjectClass;
@@ -1839,6 +1878,7 @@
end;
begin
+ Producer.Indent;
while not Reader.EndOfList do
begin
Producer.WriteStartTag(Reader.ReadStr);
@@ -1846,6 +1886,7 @@
Producer.WriteEndTag;
end;
Reader.ReadListEnd;
+ Producer.Unindent;
end;
{ TInstantToTextToBinaryConverter }
Modified: trunk/Source/Core/InstantConsts.pas
===================================================================
--- trunk/Source/Core/InstantConsts.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantConsts.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -70,12 +70,17 @@
InstantSequenceNoFieldName = 'SequenceNo';
InstantChildClassFieldName = 'ChildClass';
InstantLogStatementBefore = 'Before: ';
+ InstantLogStatementSelect = 'Select: ';
+ InstantLogStatementExecute = 'Execute: ';
{$IFNDEF D6+}
const
sLineBreak = #13#10;
{$ENDIF}
+var
+ InstantXMLIndentationSize: Integer = 2;
+
resourcestring
SAccessError = 'Cannot access attribute %s(''%s'') as type: %s';
SAccessorClassNotFoundFor = 'Accessor class not found for class %s ';
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -3465,7 +3465,7 @@
function TInstantBlob.GetAsString: string;
begin
- Result := Value;
+ Result := string(Value);
end;
function TInstantBlob.GetAsVariant: Variant;
@@ -5226,7 +5226,7 @@
Try
XMLReferencesTag := Self.ClassName;
InstantXMLProducer.WriteStartTag(XMLReferencesTag);
- InstantXMLProducer.WriteEscapedData(sLineBreak);
+ InstantXMLProducer.WriteData(sLineBreak);
for I := 0 to Pred(Count) do
begin
InstantXMLProducer.WriteStartTag(
@@ -5235,6 +5235,7 @@
InstantXMLProducer.WriteEndTag;
end;
InstantXMLProducer.WriteEndTag;
+ InstantXMLProducer.WriteData(sLineBreak);
Finally
InstantXMLProducer.Free;
End;
@@ -5641,7 +5642,9 @@
vaIdent:
begin
Reader.ReadIdent;
+ Producer.Indent;
Convert;
+ Producer.Unindent;
end;
vaFalse:
begin
@@ -5666,8 +5669,10 @@
vaCollection:
begin
Reader.ReadValue;
+ Producer.Indent;
while not Reader.EndOfList do
Convert;
+ Producer.Unindent;
Reader.ReadListEnd;
end;
else
Modified: trunk/Source/Core/InstantRtti.pas
===================================================================
--- trunk/Source/Core/InstantRtti.pas 2009-08-11 17:45:41 UTC (rev 820)
+++ trunk/Source/Core/InstantRtti.pas 2009-08-14 07:15:58 UTC (rev 821)
@@ -78,7 +78,7 @@
procedure InstantSetProperty(AObject: TObject; PropPath: string; Value: Variant);
function InstantIsDefaultPropertyValue(Instance: TObject;
PropInfo: PPropInfo): Boolean;
-function InstantGetPropName(PropInfo: PPropInfo): string;
+function InstantGetPropName(PropInfo: PPropInfo): string; {$IFNDEF D12+}inline;{$ENDIF}
implementation
|
|
From: <wp...@us...> - 2009-08-11 17:45:50
|
Revision: 820
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=820&view=rev
Author: wp2udk
Date: 2009-08-11 17:45:41 +0000 (Tue, 11 Aug 2009)
Log Message:
-----------
* D2009: DclIOCore_D12 has only two warnings left that FileAge is deprecated.
- InstantOTA ReadEditorSource and WriteEditorSource can now read UTF8 encoded source code.
Modified Paths:
--------------
trunk/Source/Design/InstantModelExpert.pas
trunk/Source/Design/InstantOTA.pas
Modified: trunk/Source/Design/InstantModelExpert.pas
===================================================================
--- trunk/Source/Design/InstantModelExpert.pas 2009-08-10 21:21:19 UTC (rev 819)
+++ trunk/Source/Design/InstantModelExpert.pas 2009-08-11 17:45:41 UTC (rev 820)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Nando Dessena, Steven Mitchell
+ * Nando Dessena, Steven Mitchell, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -1000,7 +1000,7 @@
Editor := FIDEInterface.SourceEditor(Module);
{$IFDEF D12+}
- Source := UTF8ToUnicodeString(FIDEInterface.ReadEditorSource(Editor));
+ Source := FIDEInterface.ReadEditorSource(Editor);
Stream := TStringStream.Create(Source, TEncoding.Unicode);
{$ELSE}
Source := FIDEInterface.ReadEditorSource(Editor);
Modified: trunk/Source/Design/InstantOTA.pas
===================================================================
--- trunk/Source/Design/InstantOTA.pas 2009-08-10 21:21:19 UTC (rev 819)
+++ trunk/Source/Design/InstantOTA.pas 2009-08-11 17:45:41 UTC (rev 820)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Nando Dessena, Steven Mitchell
+ * Nando Dessena, Steven Mitchell, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -42,6 +42,13 @@
Classes, ToolsAPI, InstantTypes, Forms;
type
+{$IFDEF D12+}
+ InstantOTAString = UTF8String;
+{$ELSE}
+ InstantOTAString = string;
+{$ENDIF}
+ PInstantOTAString = ^InstantOTAString;
+
TInstantOTAIDEInterface = class;
{$IFDEF D9+}
TInstantOTAIDENotifier8 = class;
@@ -106,11 +113,11 @@
function CurrentModule: IOTAModule;
function FindModule(const Name: string): IOTAModule;
procedure GotoFilePos(const FileName: string; Line, Column: Integer);
- function ReadEditorSource(Editor: IOTASourceEditor): AnsiString;
- function ReadModuleSource(Module: IOTAModule): AnsiString;
+ function ReadEditorSource(Editor: IOTASourceEditor): string;
+ function ReadModuleSource(Module: IOTAModule): string;
procedure ShowMessages;
function SourceEditor(Module: IOTAModule): IOTASourceEditor;
- procedure WriteEditorSource(Editor: IOTASourceEditor; const Source: AnsiString;
+ procedure WriteEditorSource(Editor: IOTASourceEditor; const Source: string;
ReplaceLen: Integer; Undoable: Boolean = False);
property EditActions: IOTAEditActions read GetEditActions;
property MessageServices: IOTAMessageServices read GetMessageServices;
@@ -496,10 +503,10 @@
end;
function TInstantOTAIDEInterface.ReadEditorSource(
- Editor: IOTASourceEditor): AnsiString;
+ Editor: IOTASourceEditor): string;
var
Reader: IOTAEditReader;
- Buffer: AnsiString;
+ Buffer: InstantOTAString;
BufferLen, ReadLen, Position: Integer;
begin
if Assigned(Editor) then
@@ -511,18 +518,19 @@
repeat
SetLength(Buffer, BufferLen);
ReadLen := Reader.GetText(Position, PAnsiChar(Buffer), BufferLen);
- if ReadLen < BufferLen then
- Dec(ReadLen, 2);
+ if ReadLen < BufferLen then // ?? What does these two lines do??
+ Dec(ReadLen, 2); // ??
SetLength(Buffer, ReadLen);
- Result := Result + Buffer;
+ Result := Result + string(Buffer);
Inc(Position, ReadLen);
until ReadLen < BufferLen - 1;
end else
Result := '';
+// ShowMessage(Result);
end;
function TInstantOTAIDEInterface.ReadModuleSource(
- Module: IOTAModule): AnsiString;
+ Module: IOTAModule): string;
begin
Result := ReadEditorSource(SourceEditor(Module));
end;
@@ -585,7 +593,7 @@
end;
procedure TInstantOTAIDEInterface.WriteEditorSource(
- Editor: IOTASourceEditor; const Source: AnsiString; ReplaceLen: Integer;
+ Editor: IOTASourceEditor; const Source: string; ReplaceLen: Integer;
Undoable: Boolean);
var
Writer: IOTAEditWriter;
@@ -596,7 +604,7 @@
Writer := Editor.CreateUndoableWriter else
Writer := Editor.CreateWriter;
Writer.DeleteTo(ReplaceLen);
- Writer.Insert(PAnsiChar(Source));
+ Writer.Insert(PAnsiChar(InstantOTAString(Source)));
end;
{ TInstantOTAIDENotifier5 }
|
|
From: <wp...@us...> - 2009-08-10 21:21:26
|
Revision: 819
http://instantobjects.svn.sourceforge.net/instantobjects/revision/?rev=819&view=rev
Author: wp2udk
Date: 2009-08-10 21:21:19 +0000 (Mon, 10 Aug 2009)
Log Message:
-----------
Removal of several warnings:
- InstantCharInSet introduced: Should be used every time you need to check against sets of enumerated types.
- GetPropName introduced: Should be used every time you need to access PropInfo^.Name.
- Minor warnings are also removed
These code changes have only been tested against D2009.
Modified Paths:
--------------
trunk/Source/Core/InstantClasses.pas
trunk/Source/Core/InstantCode.pas
trunk/Source/Core/InstantCommand.pas
trunk/Source/Core/InstantExplorer.pas
trunk/Source/Core/InstantMetadata.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
trunk/Source/Core/InstantRtti.pas
trunk/Source/Core/InstantTextFiler.pas
trunk/Source/Core/InstantUtils.pas
trunk/Source/Design/InstantCommandEditor.pas
Modified: trunk/Source/Core/InstantClasses.pas
===================================================================
--- trunk/Source/Core/InstantClasses.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantClasses.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Adrea Petrelli, Marco Cant\xF9, Nando Dessena, Uberto Barbini,
- * Riceball Lee
+ * Riceball Lee, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -50,7 +50,12 @@
InstantBufferSize = 4096;
type
+{$IFDEF D12+}
+ TChars = set of AnsiChar; // Avoid WideChar reduced to byte warning
+{$ELSE}
TChars = set of Char;
+{$ENDIF}
+
{$IFDEF LINUX}
TDate = type TDateTime;
TTime = type TDateTime;
@@ -1411,7 +1416,7 @@
for I := 1 to Length(Data) do
begin
C := Data[I];
- if C in [#34, #38, #39, #60, #62] then
+ if InstantCharInSet(C, [#34, #38, #39, #60, #62]) then
begin
case C of
#34:
@@ -1659,7 +1664,7 @@
procedure TInstantXMLProcessor.SkipBlanks;
begin
- while PeekChar in [#1..#32] do
+ while InstantCharInSet(PeekChar, [#1..#32]) do
ReadChar;
end;
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantCode.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell,
- * Uberto Barbini, Joao Morais, Riceball Lee
+ * Uberto Barbini, Joao Morais, Riceball Lee, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -2689,7 +2689,7 @@
begin
Name := Reader.ReadToken;
Reader.SkipSpace;
- Result := Reader.ReadChar in [':', ','];
+ Result := InstantCharInSet(Reader.ReadChar, [':', ',']);
end;
procedure TInstantCodeSymbol.InternalRead(Reader: TInstantCodeReader);
@@ -3933,14 +3933,14 @@
if Copy(Result, i, 1) = 's' then
begin
If (i > 3) and (Copy(Result, i - 2, 3) = 'ies') and
- not (Result[i - 3] in Vowels) then
+ not (InstantCharInSet(Result[i - 3], Vowels)) then
begin
Result := Copy(Result, 1, i - 3) + 'y';
end
else If (i > 3) and (Copy(Result, i - 1, 2) = 'es') and
- (Result[i - 2] in SpChars) then
+ (InstantCharInSet(Result[i - 2], SpChars)) then
begin
- if (Result[i - 2] = 'h') and not (Result[i - 3] in ['c', 's']) then
+ if (Result[i - 2] = 'h') and not (InstantCharInSet(Result[i - 3], ['c', 's'])) then
begin
//not ch or sh
Result := Copy(Result, 1, i - 1);
@@ -5761,7 +5761,7 @@
Reader.SkipSpace;
Reader.ReadToken;
Reader.SkipSpace;
- Result := Reader.NextChar in [':', '='];
+ Result := InstantCharInSet(Reader.NextChar, [':', '=']);
finally
Reader.Position := SavePos;
end;
@@ -8690,7 +8690,7 @@
if FCode^[I] = #10 then
begin
Inc(I);
- while FCode^[I] in [' ', #9] do
+ while InstantCharInSet(FCode^[I], [' ', #9]) do
begin
Result := Result + FCode^[I];
Inc(I);
Modified: trunk/Source/Core/InstantCommand.pas
===================================================================
--- trunk/Source/Core/InstantCommand.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantCommand.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Nando Dessena, Andrea Magni
+ * Nando Dessena, Andrea Magni, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -1121,7 +1121,7 @@
begin
Token := Reader.ReadToken;
Result := IsConstantToken(Token) or InstantIsNumeric(Token) or
- ((Length(Token) > 0) and (Token[1] in ['"', '''', '[']));
+ ((Length(Token) > 0) and (InstantCharInSet(Token[1], ['"', '''', '['])));
end;
procedure TInstantIQLConstant.InternalClear;
Modified: trunk/Source/Core/InstantExplorer.pas
===================================================================
--- trunk/Source/Core/InstantExplorer.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantExplorer.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Steven Mitchell,
- * Joao Morais
+ * Joao Morais, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -561,7 +561,7 @@
Width := AParent.Width - Left - 8;
Anchors := [akLeft, akTop, akRight];
Parent := AParent;
- DataField := PropInfo.Name;
+ DataField := InstantGetPropName(PropInfo);
DataSource := ADataSource;
if not Assigned(PropInfo.SetProc) then
begin
@@ -574,7 +574,7 @@
Left := 8;
Top := ATop + 3;
Parent := AParent;
- Caption := PropInfo.Name;
+ Caption := InstantGetPropName(PropInfo);
FocusControl := Edit;
end;
Inc(ATop, Edit.Height);
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantMetadata.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -26,7 +26,7 @@
* Contributor(s):
* Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
* Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
+ * Riceball Lee, David Moorhouse, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -67,7 +67,7 @@
protected
function InternalEquals(const Other: TInstantMetadata): Boolean; virtual;
public
- function Equals(const Other: TInstantMetadata): Boolean;
+ function Equals(const Other: TInstantMetadata): Boolean; {$IFDEF D12+} reintroduce; {$ENDIF} overload;
property Collection: TInstantMetadatas read GetCollection
write SetCollection;
end;
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantPersistence.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -26,7 +26,7 @@
* Contributor(s):
* Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Steven Mitchell,
* Joao Morais, Cesar Coll, Uberto Barbini, David Taylor, Hanedi Salas,
- * Riceball Lee, David Moorhouse
+ * Riceball Lee, David Moorhouse, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -129,8 +129,8 @@
function Dereference(Connector: TInstantConnector = nil;
AOwnsInstance: Boolean = True; Retry: Boolean = False): TInstantObject;
procedure DestroyInstance;
- function Equals(const AObjectClassName, AObjectId: string): Boolean; overload;
- function Equals(AObject: TInstantObject): Boolean; overload;
+ function Equals(const AObjectClassName, AObjectId: string): Boolean; {$IFDEF D12+}reintroduce;{$ENDIF} overload;
+ function Equals(AObject: TInstantObject): Boolean; {$IFDEF D12+}reintroduce;{$ENDIF} overload;
function HasInstance: Boolean;
function HasReference: Boolean;
function IsBroken: Boolean;
@@ -1622,7 +1622,7 @@
begin
Result := True;
for I := 0 to Pred(BufferLength div SizeOf(Char)) do
- if (ValidChars <> []) and not (Buffer[I] in ValidChars + [#8, #10, #13]) then
+ if (ValidChars <> []) and not (InstantCharInSet(Buffer[I], ValidChars + [#8, #10, #13])) then
begin
Result := False;
InvalidChar := Buffer[I];
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantPresentation.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -25,7 +25,7 @@
*
* Contributor(s):
* Carlo Barazzetta, Andrea Petrelli, Nando Dessena, Joao Morais,
- * Steven Mitchell
+ * Steven Mitchell, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -1006,13 +1006,13 @@
Items.AddObject(Prefix + Names[I], Pointer(PropInfo));
if Traverse then
begin
- Path := AClass.ClassName + '.' + PropInfo.Name;
+ Path := AClass.ClassName + '.' + InstantGetPropName(PropInfo);
if Circular or (Paths.IndexOf(Path) = -1) then
begin
PathIndex := Paths.Add(Path);
try
TypeData := GetTypeData(PropInfo.PropType^);
- AddProperties(Prefix + PropInfo.Name + '.', TypeData.ClassType,
+ AddProperties(Prefix + InstantGetPropName(PropInfo) + '.', TypeData.ClassType,
Items, Paths);
finally
Paths.Delete(PathIndex);
@@ -2037,12 +2037,12 @@
Relation: string;
Index: Integer;
begin
- Relation := AClass.ClassName + '.' + PropInfo.Name;
- if BreakThorough(Prefix + PropInfo.Name) then
+ Relation := AClass.ClassName + '.' + InstantGetPropName(PropInfo);
+ if BreakThorough(Prefix + InstantGetPropName(PropInfo)) then
Exit;
if (Relations.IndexOf(Relation) = -1) or
- IncludeField(Prefix + '.' + PropInfo.Name, False) then
+ IncludeField(Prefix + '.' + InstantGetPropName(PropInfo), False) then
begin
Relations.Add(Relation);
try
@@ -2256,7 +2256,7 @@
Result := nil;
if not Assigned(PropInfo) then
Exit;
- FieldName := Prefix + PropInfo^.Name;
+ FieldName := Prefix + InstantGetPropName(PropInfo);
FieldSize := 0;
FieldAttribs := [];
TypeKind := PropInfo^.PropType^^.Kind;
Modified: trunk/Source/Core/InstantRtti.pas
===================================================================
--- trunk/Source/Core/InstantRtti.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantRtti.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -24,7 +24,8 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta, Adrea Petrelli, Uberto Barbini, Nando Dessena
+ * Carlo Barazzetta, Adrea Petrelli, Uberto Barbini, Nando Dessena,
+ * Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -77,6 +78,7 @@
procedure InstantSetProperty(AObject: TObject; PropPath: string; Value: Variant);
function InstantIsDefaultPropertyValue(Instance: TObject;
PropInfo: PPropInfo): Boolean;
+function InstantGetPropName(PropInfo: PPropInfo): string;
implementation
@@ -134,18 +136,18 @@
Value := 1;
end;
{$ENDIF}
- SetPropValue(AObject, PropInfo^.Name, Value);
+ SetPropValue(AObject, InstantGetPropName(PropInfo), Value);
end;
tkSet:
if VarToStr(Value) = '' then
- SetPropValue(AObject, PropInfo^.Name, '[]')
+ SetPropValue(AObject, InstantGetPropName(PropInfo), '[]')
else
- SetPropValue(AObject, PropInfo^.Name, Value);
+ SetPropValue(AObject, InstantGetPropName(PropInfo), Value);
else
- SetPropValue(AObject, PropInfo^.Name, Value);
+ SetPropValue(AObject, InstantGetPropName(PropInfo), Value);
end;
end;
- Result := GetPropValue(AObject, PropInfo^.Name);
+ Result := GetPropValue(AObject, InstantGetPropName(PropInfo));
end else
Result := Null;
end else
@@ -294,6 +296,15 @@
end;
end;
+function InstantGetPropName(PropInfo: PPropInfo): string;
+begin
+{$IFNDEF D12+}
+ Result := PropInfo^.Name;
+{$ELSE}
+ Result := GetPropName(PropInfo);
+{$ENDIF}
+end;
+
{ TInstantProperties }
constructor TInstantProperties.Create(AInstance: TObject);
@@ -363,7 +374,7 @@
function TInstantProperties.GetNames(Index: Integer): string;
begin
- Result := PropInfos[Index]^.Name;
+ Result := InstantGetPropName(PropInfos[Index]);
end;
function TInstantProperties.GetPropInfos(Index: Integer): PPropInfo;
Modified: trunk/Source/Core/InstantTextFiler.pas
===================================================================
--- trunk/Source/Core/InstantTextFiler.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantTextFiler.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta, Adrea Petrelli, Nando Dessena
+ * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -236,7 +236,7 @@
function TInstantTextFiler.IsSpace(Ch: Char): Boolean;
begin
- Result := Ch in [' ', #9, #10, #13];
+ Result := InstantCharInSet(Ch, [' ', #9, #10, #13]);
end;
function TInstantTextFiler.IsText(Ch: Char): Boolean;
@@ -244,7 +244,7 @@
Result := ((Ch >= 'a') and (Ch <= 'z'))
or ((Ch >= 'A') and (Ch <= 'Z'))
or ((Ch >= '0') and (Ch <= '9'))
- or (Ch in ['#', '_']);
+ or (InstantCharInSet(Ch, ['#', '_']));
end;
procedure TInstantTextFiler.Reset;
@@ -325,7 +325,7 @@
function TInstantTextReader.IsStringDelimiter(Ch: Char): Boolean;
begin
- Result := ConstAware and (Ch in ['''', '"']);
+ Result := ConstAware and (InstantCharInSet(Ch, ['''', '"']));
end;
function TInstantTextReader.NextChar: Char;
Modified: trunk/Source/Core/InstantUtils.pas
===================================================================
--- trunk/Source/Core/InstantUtils.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Core/InstantUtils.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -24,7 +24,8 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Uberto Barbini
+ * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Uberto Barbini,
+ * Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -39,7 +40,7 @@
interface
uses
- Classes, InstantClasses;
+ Classes, InstantClasses, SysUtils;
type
TInstantCompareOption = (coCaseInsensitive, coPartial);
@@ -93,6 +94,10 @@
function TimeOf(const AValue: TDateTime): TDateTime;
{$ENDIF}
+function InstantCharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean; overload;
+function InstantCharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean; overload;
+
+
implementation
uses
@@ -102,8 +107,7 @@
{$IFDEF FPC}
InstantFpcUtils,
{$ENDIF}
- {$IFDEF D6+}Variants,{$ENDIF} InstantConsts, InstantRtti,
- SysUtils;
+ {$IFDEF D6+}Variants,{$ENDIF} InstantConsts, InstantRtti;
function InstantCharSetToStr(C: TChars): string;
var
@@ -112,7 +116,7 @@
begin
Result := '';
for I := 0 to 255 do
- if Chr(I) in C then
+ if InstantCharInSet(Chr(I), C) then
S := S + Chr(I);
I := 1;
L := Length(S);
@@ -570,7 +574,7 @@
I: Integer;
begin
I := Pos;
- while (I <= Length(Str)) and not (Str[I] in Delimiters) do
+ while (I <= Length(Str)) and not (InstantCharInSet(Str[I], Delimiters)) do
Inc(I);
Result := Copy(Str, Pos, I - Pos);
if I <= Length(Str) then
@@ -637,4 +641,22 @@
end;
{$ENDIF}
+function InstantCharInSet(C: AnsiChar; const CharSet: TSysCharSet): Boolean;
+begin
+{$IFNDEF D12+}
+ Result := C in CharSet;
+{$ELSE}
+ Result := CharInSet(C, CharSet);
+{$ENDIF}
+end;
+
+function InstantCharInSet(C: WideChar; const CharSet: TSysCharSet): Boolean;
+begin
+{$IFNDEF D12+}
+ Result := (C < #$0100) and (AnsiChar(C) in CharSet);
+{$ELSE}
+ Result := CharInSet(C, CharSet);
+{$ENDIF}
+end;
+
end.
Modified: trunk/Source/Design/InstantCommandEditor.pas
===================================================================
--- trunk/Source/Design/InstantCommandEditor.pas 2009-08-06 20:58:27 UTC (rev 818)
+++ trunk/Source/Design/InstantCommandEditor.pas 2009-08-10 21:21:19 UTC (rev 819)
@@ -24,7 +24,7 @@
* the Initial Developer. All Rights Reserved.
*
* Contributor(s):
- * Carlo Barazzetta, Adrea Petrelli, Nando Dessena
+ * Carlo Barazzetta, Adrea Petrelli, Nando Dessena, Brian Andersen
*
* ***** END LICENSE BLOCK ***** *)
@@ -114,7 +114,8 @@
implementation
uses
- InstantPersistence, InstantPresentation, InstantMetadata, InstantTypes;
+ InstantPersistence, InstantPresentation, InstantMetadata, InstantTypes,
+ InstantUtils;
{$R *.dfm}
@@ -177,7 +178,7 @@
function IsSpace(Ch: Char): Boolean;
begin
- Result := Ch in [' ', #9, #10, #13];
+ Result := InstantCharInSet(Ch, [' ', #9, #10, #13]);
end;
var
|
