Menu
▾
▴
[Instantobjects-cvscommit] SF.net SVN: instantobjects: [737] trunk
|
From: <bvs...@us...> - 2006-12-11 00:17:58
|
Revision: 737
http://svn.sourceforge.net/instantobjects/revision/?rev=737&view=rev
Author: bvsimmons
Date: 2006-12-10 16:17:56 -0800 (Sun, 10 Dec 2006)
Log Message:
-----------
Support for InstantDate and InstantTime
Modified Paths:
--------------
trunk/Demos/PrimerCross/DemoData.pas
trunk/Demos/PrimerCross/Model/Model.pas
trunk/Demos/PrimerCross/ModelExternal/Model.pas
trunk/Demos/PrimerCross/PersonEdit.dfm
trunk/Demos/PrimerCross/PersonEdit.pas
trunk/Demos/PrimerCross/Primer.mdr
trunk/Demos/PrimerCross/PrimerExternal.mdr
trunk/Source/Brokers/ADO/InstantADO.pas
trunk/Source/Brokers/BDE/InstantBDE.pas
trunk/Source/Brokers/BDE/InstantBDECatalog.pas
trunk/Source/Brokers/DBX/InstantDBX.pas
trunk/Source/Brokers/IBX/InstantIBX.pas
trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas
trunk/Source/Core/InstantBrokers.pas
trunk/Source/Core/InstantCode.pas
trunk/Source/Core/InstantMetadata.pas
trunk/Source/Core/InstantPersistence.pas
trunk/Source/Core/InstantPresentation.pas
trunk/Source/Core/InstantTypes.pas
trunk/Tests/TestIO.dpr
trunk/Tests/TestIO.mdr
trunk/Tests/TestInstantDateTime.pas
trunk/Tests/TestModel.pas
Added Paths:
-----------
trunk/Docs/InstantDate-InstantTime Release Notes.txt
trunk/Tests/TestInstantDate.pas
trunk/Tests/TestInstantTime.pas
Modified: trunk/Demos/PrimerCross/DemoData.pas
===================================================================
--- trunk/Demos/PrimerCross/DemoData.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Demos/PrimerCross/DemoData.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -184,6 +184,7 @@
Gender := TGender(Random(2));
Result.Name := RandomFullName(Gender);
Result.BirthDate := Date - (20 * 365 + Random(365 * 50)); // 20 - 70 years old
+ Result.BirthTime := Random;
Result.Address := CreateRandomAddress;
// Result.Salary := 922337203685470;
Result.Salary := 500 + Random(5000);
Modified: trunk/Demos/PrimerCross/Model/Model.pas
===================================================================
--- trunk/Demos/PrimerCross/Model/Model.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Demos/PrimerCross/Model/Model.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -8,7 +8,7 @@
interface
uses
- InstantPersistence;
+ InstantPersistence, InstantTypes;
type
TAddress = class;
@@ -21,6 +21,7 @@
TPerson = class;
TPhone = class;
+
TAddress = class(TInstantObject)
{IOMETADATA City: String(30) index;
Country: Reference(TCountry);
@@ -164,25 +165,29 @@
TPerson = class(TContact)
{IOMETADATA stored;
- BirthDate: DateTime;
Emails: Parts(TEmail);
Employer: Reference(TCompany);
Picture: Graphic;
- Salary: Currency; }
- _BirthDate: TInstantDateTime;
+ Salary: Currency;
+ BirthDate: Date;
+ BirthTime: Time; }
+ _BirthDate: TInstantDate;
+ _BirthTime: TInstantTime;
_Emails: TInstantParts;
_Employer: TInstantReference;
_Picture: TInstantGraphic;
_Salary: TInstantCurrency;
private
- function GetBirthDate: TDateTime;
+ function GetBirthDate: TDate;
+ function GetBirthTime: TTime;
function GetEmailCount: Integer;
function GetEmails(Index: Integer): TEmail;
function GetEmployer: TCompany;
function GetMainEmailAddress: string;
function GetPicture: string;
function GetSalary: Currency;
- procedure SetBirthDate(Value: TDateTime);
+ procedure SetBirthDate(Value: TDate);
+ procedure SetBirthTime(Value: TTime);
procedure SetEmails(Index: Integer; Value: TEmail);
procedure SetMainEmailAddress(const Value: string);
procedure SetPicture(const Value: string);
@@ -200,7 +205,8 @@
property EmailCount: Integer read GetEmailCount;
property Emails[Index: Integer]: TEmail read GetEmails write SetEmails;
published
- property BirthDate: TDateTime read GetBirthDate write SetBirthDate;
+ property BirthDate: TDate read GetBirthDate write SetBirthDate;
+ property BirthTime: TTime read GetBirthTime write SetBirthTime;
property Employer: TCompany read GetEmployer;
property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress;
property Picture: string read GetPicture write SetPicture;
@@ -390,11 +396,16 @@
end;
end;
-function TPerson.GetBirthDate: TDateTime;
+function TPerson.GetBirthDate: TDate;
begin
Result := _BirthDate.Value;
end;
+function TPerson.GetBirthTime: TTime;
+begin
+ Result := _BirthTime.Value;
+end;
+
function TPerson.GetEmailCount: Integer;
begin
Result := _Emails.Count
@@ -443,11 +454,16 @@
Result := _Emails.Remove(Email);
end;
-procedure TPerson.SetBirthDate(Value: TDateTime);
+procedure TPerson.SetBirthDate(Value: TDate);
begin
_BirthDate.Value := Value;
end;
+procedure TPerson.SetBirthTime(Value: TTime);
+begin
+ _BirthTime.Value := Value;
+end;
+
procedure TPerson.SetEmails(Index: Integer; Value: TEmail);
begin
_Emails[Index] := Value;
Modified: trunk/Demos/PrimerCross/ModelExternal/Model.pas
===================================================================
--- trunk/Demos/PrimerCross/ModelExternal/Model.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Demos/PrimerCross/ModelExternal/Model.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -8,7 +8,7 @@
interface
uses
- InstantPersistence;
+ InstantPersistence, InstantTypes;
type
TAddress = class;
@@ -167,25 +167,29 @@
TPerson = class(TContact)
{IOMETADATA stored;
- BirthDate: DateTime;
Emails: Parts(TEmail) external 'Person_Emails';
Employer: Reference(TCompany);
Picture: Graphic;
- Salary: Currency; }
- _BirthDate: TInstantDateTime;
+ Salary: Currency;
+ BirthDate: Date;
+ BirthTime: Time; }
+ _BirthDate: TInstantDate;
+ _BirthTime: TInstantTime;
_Emails: TInstantParts;
_Employer: TInstantReference;
_Picture: TInstantGraphic;
_Salary: TInstantCurrency;
private
- function GetBirthDate: TDateTime;
+ function GetBirthDate: TDate;
+ function GetBirthTime: TTime;
function GetEmailCount: Integer;
function GetEmails(Index: Integer): TEmail;
function GetEmployer: TCompany;
function GetMainEmailAddress: string;
function GetPicture: string;
function GetSalary: Currency;
- procedure SetBirthDate(Value: TDateTime);
+ procedure SetBirthDate(Value: TDate);
+ procedure SetBirthTime(Value: TTime);
procedure SetEmails(Index: Integer; Value: TEmail);
procedure SetMainEmailAddress(const Value: string);
procedure SetPicture(const Value: string);
@@ -203,7 +207,8 @@
property EmailCount: Integer read GetEmailCount;
property Emails[Index: Integer]: TEmail read GetEmails write SetEmails;
published
- property BirthDate: TDateTime read GetBirthDate write SetBirthDate;
+ property BirthDate: TDate read GetBirthDate write SetBirthDate;
+ property BirthTime: TTime read GetBirthTime write SetBirthTime;
property Employer: TCompany read GetEmployer;
property MainEmailAddress: string read GetMainEmailAddress write SetMainEmailAddress;
property Picture: string read GetPicture write SetPicture;
@@ -393,11 +398,16 @@
end;
end;
-function TPerson.GetBirthDate: TDateTime;
+function TPerson.GetBirthDate: TDate;
begin
Result := _BirthDate.Value;
end;
+function TPerson.GetBirthTime: TTime;
+begin
+ Result := _BirthTime.Value;
+end;
+
function TPerson.GetEmailCount: Integer;
begin
Result := _Emails.Count;
@@ -446,11 +456,16 @@
Result := _Emails.Remove(Email);
end;
-procedure TPerson.SetBirthDate(Value: TDateTime);
+procedure TPerson.SetBirthDate(Value: TDate);
begin
_BirthDate.Value := Value;
end;
+procedure TPerson.SetBirthTime(Value: TTime);
+begin
+ _BirthTime.Value := Value;
+end;
+
procedure TPerson.SetEmails(Index: Integer; Value: TEmail);
begin
_Emails[Index] := Value;
Modified: trunk/Demos/PrimerCross/PersonEdit.dfm
===================================================================
--- trunk/Demos/PrimerCross/PersonEdit.dfm 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Demos/PrimerCross/PersonEdit.dfm 2006-12-11 00:17:56 UTC (rev 737)
@@ -59,7 +59,15 @@
Height = 13
Caption = 'Sa&lary'
end
- object PicturePanel: TPanel [13]
+ object Label1: TLabel [13]
+ Left = 136
+ Top = 264
+ Width = 44
+ Height = 13
+ Caption = 'BirthTime'
+ FocusControl = BirthTimeEdit
+ end
+ object PicturePanel: TPanel [14]
Left = 332
Top = 203
Width = 76
@@ -95,7 +103,7 @@
Visible = True
end>
end
- object BirthDateEdit: TDBEdit [20]
+ object BirthDateEdit: TDBEdit [21]
Left = 136
Top = 200
Width = 73
@@ -104,7 +112,7 @@
DataSource = SubjectSource
TabOrder = 7
end
- object EmployerEdit: TDBEdit [21]
+ object EmployerEdit: TDBEdit [22]
Left = 8
Top = 240
Width = 129
@@ -114,7 +122,7 @@
ReadOnly = True
TabOrder = 8
end
- object EmailsGrid: TDBGrid [22]
+ object EmailsGrid: TDBGrid [23]
Left = 240
Top = 120
Width = 169
@@ -135,7 +143,7 @@
Visible = True
end>
end
- object EmployerToolBar: TToolBar [23]
+ object EmployerToolBar: TToolBar [24]
Left = 140
Top = 237
Width = 69
@@ -175,7 +183,7 @@
OnClick = EmployerClearButtonClick
end
end
- object PictureButton: TButton [24]
+ object PictureButton: TButton [25]
Left = 240
Top = 246
Width = 81
@@ -187,7 +195,7 @@
object SalaryEdit: TDBEdit
Left = 8
Top = 280
- Width = 153
+ Width = 121
Height = 21
DataField = 'Salary'
DataSource = SubjectSource
@@ -202,6 +210,15 @@
TabOrder = 15
OnClick = ClearButtonClick
end
+ object BirthTimeEdit: TDBEdit
+ Left = 136
+ Top = 280
+ Width = 81
+ Height = 21
+ DataField = 'BirthTime'
+ DataSource = SubjectSource
+ TabOrder = 16
+ end
end
end
end
Modified: trunk/Demos/PrimerCross/PersonEdit.pas
===================================================================
--- trunk/Demos/PrimerCross/PersonEdit.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Demos/PrimerCross/PersonEdit.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -41,6 +41,8 @@
PicturePanel: TPanel;
PictureImage: TImage;
ClearButton: TButton;
+ Label1: TLabel;
+ BirthTimeEdit: TDBEdit;
procedure EmployerClearButtonClick(Sender: TObject);
procedure EmployerEditButtonClick(Sender: TObject);
procedure EmployerLookupButtonClick(Sender: TObject);
Modified: trunk/Demos/PrimerCross/Primer.mdr
===================================================================
(Binary files differ)
Modified: trunk/Demos/PrimerCross/PrimerExternal.mdr
===================================================================
(Binary files differ)
Added: trunk/Docs/InstantDate-InstantTime Release Notes.txt
===================================================================
--- trunk/Docs/InstantDate-InstantTime Release Notes.txt (rev 0)
+++ trunk/Docs/InstantDate-InstantTime Release Notes.txt 2006-12-11 00:17:56 UTC (rev 737)
@@ -0,0 +1,122 @@
+---------- InstantDate InstantTime Release Notes -----------------
+Summary of Changes for Support of InstantDate and InstantTime Data types.
+
+Requirements
+---------------------------------
+1. Must completely rebuild IO.
+2. Must add InstantTypes to Interface Uses class of the model unit(s). if you want to use the new datatypes.
+
+InstantType.pas defines:
+TDate = class(TDateTime);
+TTime = class(TDateTime);
+The Model Explorer has been modified to automatically or (auto-magically) add the Interface uses clause of your model file(s) with InstantType and the Implementation uses clause with InstantMetadata when you edit your model.
+
+Files affected :
+Core Files modified:
+---------------------------------
+InstantBrokers.pas
+InstantClasses.pas
+InstantCode.pas
+InstantMetadata.pas
+InstantPersistence.pas
+InstantPresentation.pas
+InstantTypes.pas
+
+
+Tests Files Modified (* new files)
+---------------------------------
+* TestInstantDate.pas
+TestInstantDateTime.pas
+* TestInstantTime.pas
+TestIO.dpr
+TestIO.mdr
+TestModel.pas
+
+Document files (Docs Directory)
+--------------------------------
+* InstantDateInstantTime_Releasenotes.txt (this document)
+
+Demos - PrimerCross (Birthtime attribute added to TPerson and random Birthtimes are generated)
+---------------------------------
+DemoData.pas
+PersonEdit.dfm
+PersonEdit.pas
+Primer.mdr
+PrimerExternal.mdr
+Model/model.pas
+ModelExternal/model.pas
+
+Brokers (Note: I only modified the files for the standard set of Brokers which are build in RunTimePackages.bpg).
+---------------------------------
+InstantADO.pas
+InstantBDE.pas
+InstantDBX.pas
+InstantIBX.pas
+
+Note: The following brokers will also need to be modified.
+InstantADS.pas
+InstantDBISAM.pas
+InstantFlashFiler.pas
+InstantNexusDB.pas
+InstantUIB.pas
+InstantZeosDBO.pas
+
+Catalogs
+---------------------------------
+InstantBDECatalog.pas
+InstantIBFbCatalog.pas
+InstantMSSqlCatalog.pas
+
+Note: (AFIK InstantXML.pas does not need to be modified)
+
+Note:
+All brokers and catalogs must be modified to account for the two new data types. All standard brokers have been modified to map SQL datatypes for Date and Time. The default is to use DATETIME/TIMESTAMP for Date and Time Datatypes in SQL Brokers. The update has made this modification to all of the standard brokers and catalogs, but you should double check to be sure. If you have your own customized broker/catalog or you are using one of the brokers which is not part of the standard build, you will have to make similar changes as shown in the below mapping between SQL Datatypes and InstantDatatypes:
+
+function TInstantBDECatalog.ColumnTypeToDataType(const ColumnType: TFieldType;
+ out DataType: TInstantDataType): Boolean;
+begin
+ Result := True;
+ case ColumnType of
+ ftString: DataType := dtString;
+ ftSmallint,
+ ftInteger: DataType := dtInteger;
+ ftBoolean: DataType := dtBoolean;
+ ftFloat: DataType := dtFloat;
+ ftCurrency: DataType := dtCurrency;
+ ftDate: DataType := dtDate; // <- Map Date Fields
+ ftTime: DataType := dtTime; // <-- Map Time Fields
+ ftDateTime: DataType := dtDateTime;
+ ftAutoInc: DataType := dtInteger;
+ ftBlob,
+ ftGraphic: DataType := dtBlob;
+ ftMemo: DataType := dtMemo;
+ else
+ Result := False;
+ end;
+end;
+
+function TInstantADOMSSQLBroker.DataTypeToColumnType(
+ DataType: TInstantDataType; Size: Integer): string;
+const
+ Types: array[TInstantDataType] of string = (
+ 'INTEGER',
+ 'FLOAT',
+ 'MONEY',
+ 'BIT',
+ 'VARCHAR',
+ 'TEXT',
+ 'DATETIME',
+ 'IMAGE',
+ 'DATETIME', // <- Map Date Fields
+ 'DATETIME'); // <- Map Time Fields
+begin
+ Result := Types[DataType];
+ if (DataType = dtString) and (Size > 0) then
+ Result := Result + InstantEmbrace(IntToStr(Size), '()');
+end;
+
+I haved removed the following that were contained in my uploads to the repository ng.
+
+1. ACR - Accuracer
+2. DBX - Support for ASA-SqlAnyWhere (and it's Catalog 'InstantASACatalog.pas')
+3. SDAC - Corelab SQL Server Data Access Components
Property changes on: trunk/Docs/InstantDate-InstantTime Release Notes.txt
___________________________________________________________________
Name: svn:eol-style
+ native
Modified: trunk/Source/Brokers/ADO/InstantADO.pas
===================================================================
--- trunk/Source/Brokers/ADO/InstantADO.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Brokers/ADO/InstantADO.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -107,9 +107,12 @@
function GetDataSet: TCustomADODataSet;
protected
function CreateDataSet: TDataSet; override;
+ function CreateNavigationalLinkResolver(const ATableName: string):
+ TInstantNavigationalLinkResolver; override;
function Find(const AClassName, AObjectId: string): Boolean;
function Locate(const AClassName, AObjectId: string): Boolean; override;
public
+ function FormatTableName(const ATableName: string): string; virtual;
property Broker: TInstantADOBroker read GetBroker;
property DataSet: TCustomADODataSet read GetDataSet;
end;
@@ -148,6 +151,23 @@
property Connector: TInstantADOConnector read GetConnector;
end;
+ TInstantADOLinkResolver = class(TInstantNavigationalLinkResolver)
+ private
+ function GetBroker: TInstantADOBroker;
+ function GetDataSet: TADODataSet;
+ function GetResolver: TInstantADOResolver;
+ protected
+ function CreateDataSet: TDataSet; override;
+ procedure SetDatasetParentRange(const AParentClass, AParentId: string);
+ override;
+ public
+ constructor Create(AResolver: TInstantNavigationalResolver; const ATableName:
+ string);
+ property Broker: TInstantADOBroker read GetBroker;
+ property DataSet: TADODataSet read GetDataSet;
+ property Resolver: TInstantADOResolver read GetResolver;
+ end;
+
{ MS Jet }
TInstantADOMSJetBroker = class(TInstantADOBroker)
@@ -331,7 +351,9 @@
(adVarChar, adVarWChar, adVarChar, adVarChar, adVarChar, adVarChar), // dtString
(adLongVarChar, adLongVarWChar, adLongVarChar, adVarBinary, adLongVarChar, adLongVarChar), // dtMemo
(adDate, adDate, adDBTimeStamp, adDBTimeStamp, adDate, adDate), // dtDateTime
- (adLongVarBinary, adLongVarBinary, adLongVarBinary, adVarBinary, adLongVarBinary, adLongVarBinary) // dtBlob
+ (adLongVarBinary, adLongVarBinary, adLongVarBinary, adVarBinary, adLongVarBinary, adLongVarBinary), // dtBlob
+ (adDate, adDate, adDBTimeStamp, adDBTimeStamp, adDate, adDate), // dtDate
+ (adDate, adDate, adDBTimeStamp, adDBTimeStamp, adDate, adDate) // dtTime
);
var
Column: _Column;
@@ -447,7 +469,9 @@
'VARCHAR',
'MEMO',
'DATETIME',
- 'BLOB'
+ 'BLOB',
+ 'DATE',
+ 'TIME'
);
begin
Result := Types[DataType];
@@ -467,6 +491,8 @@
Result := 'TEXT';
dtBlob:
Result := 'IMAGE';
+ dtDate, dtDateTime:
+ Result := 'DATETIME';
end;
ptOracle:
case DataType of
@@ -474,7 +500,7 @@
Result := 'CHAR(1)';
dtCurrency:
Result := 'DECIMAL(14,4)';
- dtDateTime:
+ dtDateTime, dtDate, dtTime:
Result := 'DATE';
dtBlob:
Result := 'BLOB';
@@ -485,7 +511,7 @@
case DataType of
dtCurrency:
Result := 'DECIMAL(14,4)';
- dtDateTime:
+ dtDateTime, dtDate, dtTime:
Result := 'TIMESTAMP';
dtBlob:
Result := 'BLOB (1000 K)';
@@ -795,6 +821,12 @@
end;
end;
+function TInstantADOResolver.CreateNavigationalLinkResolver(
+ const ATableName: string): TInstantNavigationalLinkResolver;
+begin
+ Result := TInstantADOLinkResolver.Create(Self, ATableName);
+end;
+
function TInstantADOResolver.Find(const AClassName,
AObjectId: string): Boolean;
var
@@ -837,6 +869,12 @@
end;
end;
+function TInstantADOResolver.FormatTableName(
+ const ATableName: string): string;
+begin
+ Result := TableName;
+end;
+
function TInstantADOResolver.GetBroker: TInstantADOBroker;
begin
Result := inherited Broker as TInstantADOBroker;
@@ -1144,7 +1182,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'IMAGE');
+ 'IMAGE',
+ 'DATETIME',
+ 'DATETIME');
begin
Result := Types[DataType];
if (DataType = dtString) and (Size > 0) then
@@ -1176,6 +1216,50 @@
{ TInstantADOMSSQLQuery }
+{ TInstantADOLinkResolver }
+
+constructor TInstantADOLinkResolver.Create(
+ AResolver: TInstantNavigationalResolver; const ATableName: string);
+begin
+ inherited Create(AResolver, ATableName);
+end;
+
+function TInstantADOLinkResolver.CreateDataSet: TDataSet;
+begin
+ Result:= TADOTable.Create(nil);
+ with TADOTable(Result) do
+ try
+ Connection := Broker.Connector.Connection;
+ TableName := Self.TableName;
+ IndexFieldNames := InstantParentClassFieldName + ';' +
+ InstantParentIdFieldName;
+ except
+ Result.Free;
+ raise;
+ end;
+end;
+
+function TInstantADOLinkResolver.GetBroker: TInstantADOBroker;
+begin
+ Result := inherited Broker as TInstantADOBroker;
+end;
+
+function TInstantADOLinkResolver.GetDataSet: TADODataSet;
+begin
+ Result := inherited DataSet as TADODataSet;
+end;
+
+function TInstantADOLinkResolver.GetResolver: TInstantADOResolver;
+begin
+ Result := inherited Resolver as TInstantADOResolver;
+end;
+
+procedure TInstantADOLinkResolver.SetDatasetParentRange(const AParentClass,
+ AParentId: string);
+begin
+// Dataset.SetRange([AParentClass, AParentId], [AParentClass, AParentId]);
+end;
+
initialization
RegisterClass(TInstantADOConnectionDef);
TInstantADOConnector.RegisterClass;
Modified: trunk/Source/Brokers/BDE/InstantBDE.pas
===================================================================
--- trunk/Source/Brokers/BDE/InstantBDE.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Brokers/BDE/InstantBDE.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -405,7 +405,7 @@
procedure CreateTable(TableMetadata: TInstantTableMetadata);
const
FieldTypes: array[TInstantDataType] of TFieldType =
- (ftInteger, ftFloat, ftBCD, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob);
+ (ftInteger, ftFloat, ftBCD, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob, ftDate, ftTime);
var
I: Integer;
Table: TTable;
@@ -758,7 +758,7 @@
procedure TInstantDBBuildBDEAddTableCommand.InternalExecute;
const
FieldTypes: array[TInstantDataType] of TFieldType =
- (ftInteger, ftFloat, ftCurrency, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob);
+ (ftInteger, ftFloat, ftCurrency, ftBoolean, ftString, ftMemo, ftDateTime, ftBlob, ftDate, ftTime);
var
I: Integer;
Table: TTable;
Modified: trunk/Source/Brokers/BDE/InstantBDECatalog.pas
===================================================================
--- trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Brokers/BDE/InstantBDECatalog.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -171,8 +171,8 @@
ftBoolean: DataType := dtBoolean;
ftFloat: DataType := dtFloat;
ftCurrency: DataType := dtCurrency;
- ftDate,
- ftTime,
+ ftDate: DataType := dtDate;
+ ftTime: DataType := dtTime;
ftDateTime: DataType := dtDateTime;
ftAutoInc: DataType := dtInteger;
ftBlob,
Modified: trunk/Source/Brokers/DBX/InstantDBX.pas
===================================================================
--- trunk/Source/Brokers/DBX/InstantDBX.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Brokers/DBX/InstantDBX.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -160,6 +160,14 @@
{ MS SQL Server }
+ TInstantDBXMSSQLSQLGenerator = class(TInstantSQLGenerator)
+ protected
+ function InternalGenerateAlterFieldSQL(OldMetadata, NewMetadata: TInstantFieldMetadata): string; override;
+ function InternalGenerateDropFieldSQL(Metadata: TInstantFieldMetadata): string; override;
+ function InternalGenerateDropIndexSQL(Metadata: TInstantIndexMetadata): string; override;
+ function EmbraceIndex(const IndexName: string): string; virtual;
+ end;
+
TInstantDBXMSSQLBroker = class(TInstantDBXBroker)
protected
function CreateCatalog(const AScheme: TInstantScheme): TInstantCatalog; override;
@@ -169,6 +177,8 @@
function GetDBMSName: string; override;
function GetSQLQuote: Char; override;
function InternalCreateQuery: TInstantQuery; override;
+ public
+ class function GeneratorClass: TInstantSQLGeneratorClass; override;
end;
TInstantDBXMSSQLResolver = class(TInstantSQLResolver)
@@ -522,7 +532,9 @@
'VARCHAR',
'BLOB SUB_TYPE 1',
'TIMESTAMP',
- 'BLOB');
+ 'BLOB',
+ 'TIMESTAMP',
+ 'TIMESTAMP');
begin
Result := Types[DataType];
end;
@@ -564,7 +576,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'IMAGE');
+ 'IMAGE',
+ 'DATETIME',
+ 'DATETIME');
begin
Result := Types[DataType];
end;
@@ -581,6 +595,11 @@
Result := TInstantDBXMSSQLResolver.Create(Self, Map);
end;
+class function TInstantDBXMSSQLBroker.GeneratorClass: TInstantSQLGeneratorClass;
+begin
+ Result := TInstantDBXMSSQLSQLGenerator;
+end;
+
function TInstantDBXMSSQLBroker.GetDBMSName: string;
begin
Result := 'MS SQL Server';
@@ -596,6 +615,39 @@
Result := TInstantDBXMSSQLQuery.Create(Connector);
end;
+{ TInstantDBXMSSQLSQLGenerator }
+
+function TInstantDBXMSSQLSQLGenerator.EmbraceIndex(
+ const IndexName: string): string;
+begin
+ Result := InstantEmbrace(IndexName, Delimiters);
+end;
+
+function TInstantDBXMSSQLSQLGenerator.InternalGenerateAlterFieldSQL(
+ OldMetadata, NewMetadata: TInstantFieldMetadata): string;
+begin
+ Result := Format('ALTER TABLE %s ALTER COLUMN %s %s',
+ [EmbraceTable(OldMetadata.TableMetadata.Name),
+ EmbraceField(OldMetadata.Name),
+ Broker.DataTypeToColumnType(NewMetadata.DataType, NewMetadata.Size)]);
+end;
+
+function TInstantDBXMSSQLSQLGenerator.InternalGenerateDropFieldSQL(
+ Metadata: TInstantFieldMetadata): string;
+begin
+ Result := Format('ALTER TABLE %s DROP COLUMN %s',
+ [EmbraceTable(Metadata.TableMetadata.Name),
+ EmbraceField(Metadata.Name)]);
+end;
+
+function TInstantDBXMSSQLSQLGenerator.InternalGenerateDropIndexSQL(
+ Metadata: TInstantIndexMetadata): string;
+begin
+ Result := Format('DROP INDEX %s.%s',
+ [EmbraceTable(Metadata.TableMetadata.Name),
+ EmbraceIndex(Metadata.Name)]);
+end;
+
{ TInstantDBXOracleBroker }
procedure TInstantDBXOracleBroker.AssignParam(SourceParam, TargetParam: TParam);
@@ -621,7 +673,9 @@
'VARCHAR',
'CLOB',
'DATE',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'DATE');
begin
Result := Types[DataType];
end;
@@ -649,7 +703,9 @@
'VARCHAR',
'CLOB (1000 K)',
'TIMESTAMP',
- 'BLOB (1000 K)');
+ 'BLOB (1000 K)',
+ 'TIMESTAMP',
+ 'TIMESTAMP');
begin
Result := Types[DataType];
end;
@@ -690,7 +746,9 @@
'VARCHAR',
'TEXT',
'DATETIME',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'TIME');
begin
Result := Types[DataType];
end;
Modified: trunk/Source/Brokers/IBX/InstantIBX.pas
===================================================================
--- trunk/Source/Brokers/IBX/InstantIBX.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Brokers/IBX/InstantIBX.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -426,7 +426,9 @@
'VARCHAR',
'BLOB SUB_TYPE 1',
'TIMESTAMP',
- 'BLOB');
+ 'BLOB',
+ 'DATE',
+ 'TIME');
begin
Result := Types[DataType];
if (DataType = dtString) and (Size > 0) then
Modified: trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas
===================================================================
--- trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Catalogs/MSSql/InstantMSSqlCatalog.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -167,6 +167,8 @@
FieldMetadata := TableMetadata.FieldMetadatas.Add;
FieldMetadata.Name := Fields.FieldByName('COLUMN_NAME').AsString;
FieldMetadata.DataType := FieldDataType;
+ if FieldDataType = dtDateTime then
+ FieldMetadata.AlternateDataTypes := [dtDate, dtTime];
FieldMetadata.Options := [];
if Fields.FieldByName('COLUMN_NULLABLE').AsInteger <> 1 then
FieldMetadata.Options := FieldMetadata.Options + [foRequired];
@@ -387,6 +389,8 @@
ExternalPartAttributeClass varchar 17 0 129 167 32 32 NULL 1
ExternalPartAttributeId varchar 18 0 129 167 32 32 NULL 1
EmbeddedReferencesAtttribute image 19 0 128 34 16 NULL NULL 1
+DateAttr datetime 8 0 135 61 16 23 3 1
+TimeAttr datetime 8 0 135 61 16 23 3 1
*)
end.
Modified: trunk/Source/Core/InstantBrokers.pas
===================================================================
--- trunk/Source/Core/InstantBrokers.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Core/InstantBrokers.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -316,6 +316,8 @@
procedure ClearBlob(Attribute: TInstantBlob); virtual;
procedure ClearBoolean(Attribute: TInstantBoolean); virtual;
procedure ClearDateTime(Attribute: TInstantDateTime); virtual;
+ procedure ClearDate(Attribute: TInstantDate); virtual;
+ procedure ClearTime(Attribute: TInstantTime); virtual;
procedure ClearInteger(Attribute: TInstantInteger); virtual;
procedure ClearFloat(Attribute: TInstantFloat); virtual;
procedure ClearCurrency(Attribute: TInstantCurrency); virtual;
@@ -356,6 +358,8 @@
procedure ReadBlob(Attribute: TInstantBlob); virtual;
procedure ReadBoolean(Attribute: TInstantBoolean); virtual;
procedure ReadDateTime(Attribute: TInstantDateTime); virtual;
+ procedure ReadDate(Attribute: TInstantDate); virtual;
+ procedure ReadTime(Attribute: TInstantTime); virtual;
procedure ReadInteger(Attribute: TInstantInteger); virtual;
procedure ReadFloat(Attribute: TInstantFloat); virtual;
procedure ReadCurrency(Attribute: TInstantCurrency); virtual;
@@ -373,6 +377,8 @@
procedure WriteBlob(Attribute: TInstantBlob); virtual;
procedure WriteBoolean(Attribute: TInstantBoolean); virtual;
procedure WriteDateTime(Attribute: TInstantDateTime); virtual;
+ procedure WriteDate(Attribute: TInstantDate); virtual;
+ procedure WriteTime(Attribute: TInstantTime); virtual;
procedure WriteFloat(Attribute: TInstantFloat); virtual;
procedure WriteCurrency(Attribute: TInstantCurrency); virtual;
procedure WriteInteger(Attribute: TInstantInteger); virtual;
@@ -464,6 +470,10 @@
Boolean; virtual;
function ReadDateTimeField(DataSet: TDataSet; const FieldName: string):
TDateTime; virtual;
+ function ReadDateField(DataSet: TDataSet; const FieldName: string):
+ TDateTime; virtual;
+ function ReadTimeField(DataSet: TDataSet; const FieldName: string):
+ TDateTime; virtual;
function ReadFloatField(DataSet: TDataSet; const FieldName: string): Double;
virtual;
function ReadCurrencyField(DataSet: TDataSet; const FieldName: string):
@@ -969,6 +979,7 @@
{$IFDEF D6+}
Variants,
{$ENDIF}
+ DateUtils,
TypInfo, InstantUtils, InstantRtti;
const
@@ -1719,6 +1730,10 @@
ClearString(Attribute as TInstantString);
atDateTime:
ClearDateTime(Attribute as TInstantDateTime);
+ atDate:
+ ClearDate(Attribute as TInstantDate);
+ atTime:
+ ClearTime(Attribute as TInstantTime);
atBlob:
ClearBlob(Attribute as TInstantBlob);
atGraphic:
@@ -1753,6 +1768,14 @@
begin
end;
+procedure TInstantNavigationalResolver.ClearDate(Attribute: TInstantDate);
+begin
+end;
+
+procedure TInstantNavigationalResolver.ClearTime(Attribute: TInstantTime);
+begin
+end;
+
procedure TInstantNavigationalResolver.ClearFloat(Attribute: TInstantFloat);
begin
end;
@@ -2083,6 +2106,10 @@
ReadString(Attribute as TInstantString);
atDateTime:
ReadDateTime(Attribute as TInstantDateTime);
+ atDate:
+ ReadDate(Attribute as TInstantDate);
+ atTime:
+ ReadTime(Attribute as TInstantTime);
atBlob:
ReadBlob(Attribute as TInstantBlob);
atGraphic:
@@ -2126,6 +2153,20 @@
Value := FieldByName(Metadata.FieldName).AsDateTime;
end;
+procedure TInstantNavigationalResolver.ReadDate(
+ Attribute: TInstantDate);
+begin
+ with Attribute do
+ Value := DateOf(FieldByName(Metadata.FieldName).AsDateTime);
+end;
+
+procedure TInstantNavigationalResolver.ReadTime(
+ Attribute: TInstantTime);
+begin
+ with Attribute do
+ Value := TimeOf(FieldByName(Metadata.FieldName).AsDateTime);
+end;
+
procedure TInstantNavigationalResolver.ReadFloat(Attribute: TInstantFloat);
begin
with Attribute do
@@ -2320,6 +2361,10 @@
WriteString(Attribute as TInstantString);
atDateTime:
WriteDateTime(Attribute as TInstantDateTime);
+ atDate:
+ WriteDate(Attribute as TInstantDate);
+ atTime:
+ WriteTime(Attribute as TInstantTime);
atBlob:
WriteBlob(Attribute as TInstantBlob);
atGraphic:
@@ -2367,6 +2412,20 @@
FieldByName(Metadata.FieldName).AsDateTime := Value;
end;
+procedure TInstantNavigationalResolver.WriteDate(
+ Attribute: TInstantDate);
+begin
+ with Attribute do
+ FieldByName(Metadata.FieldName).AsDateTime := Value;
+end;
+
+procedure TInstantNavigationalResolver.WriteTime(
+ Attribute: TInstantTime);
+begin
+ with Attribute do
+ FieldByName(Metadata.FieldName).AsDateTime := Value;
+end;
+
procedure TInstantNavigationalResolver.WriteFloat(Attribute: TInstantFloat);
begin
with Attribute do
@@ -2553,6 +2612,18 @@
(Attribute as TInstantDateTime).Value;
end;
+ procedure AddDateAttributeParam;
+ begin
+ AddParam(Params, FieldName, ftDate).AsDateTime :=
+ (Attribute as TInstantDate).Value;
+ end;
+
+ procedure AddTimeAttributeParam;
+ begin
+ AddParam(Params, FieldName, ftTime).AsDateTime :=
+ (Attribute as TInstantTime).Value;
+ end;
+
procedure AddFloatAttributeParam;
begin
AddParam(Params, FieldName, ftFloat).AsFloat :=
@@ -2664,6 +2735,10 @@
AddBooleanAttributeParam;
atDateTime:
AddDateTimeAttributeParam;
+ atDate:
+ AddDateAttributeParam;
+ atTime:
+ AddTimeAttributeParam;
atFloat:
AddFloatAttributeParam;
atCurrency:
@@ -3236,6 +3311,18 @@
ReadDateTimeField(DataSet, AFieldName);
end;
+ procedure ReadDateAttribute;
+ begin
+ (Attribute as TInstantDate).Value :=
+ ReadDateField(DataSet, AFieldName);
+ end;
+
+ procedure ReadTimeAttribute;
+ begin
+ (Attribute as TInstantTime).Value :=
+ ReadTimeField(DataSet, AFieldName);
+ end;
+
procedure ReadFloatAttribute;
begin
(Attribute as TInstantFloat).Value := ReadFloatField(DataSet, AFieldName);
@@ -3398,6 +3485,10 @@
ReadStringAttribute;
atDateTime:
ReadDateTimeAttribute;
+ atDate:
+ ReadDateAttribute;
+ atTime:
+ ReadTimeAttribute;
atBlob, atGraphic:
ReadBlobAttribute;
atMemo:
@@ -3448,6 +3539,18 @@
Result := DataSet.FieldByName(FieldName).AsDateTime;
end;
+function TInstantSQLResolver.ReadDateField(DataSet: TDataSet;
+ const FieldName: string): TDateTime;
+begin
+ Result := DateOf(DataSet.FieldByName(FieldName).AsDateTime);
+end;
+
+function TInstantSQLResolver.ReadTimeField(DataSet: TDataSet;
+ const FieldName: string): TDateTime;
+begin
+ Result := TimeOf(DataSet.FieldByName(FieldName).AsDateTime);
+end;
+
function TInstantSQLResolver.ReadFloatField(DataSet: TDataSet;
const FieldName: string): Double;
begin
Modified: trunk/Source/Core/InstantCode.pas
===================================================================
--- trunk/Source/Core/InstantCode.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Core/InstantCode.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -889,6 +889,9 @@
procedure SetName(const Value: string); override;
procedure VisibilityFilter(Sender: TInstantCodeObject;
var Include: Boolean; Arg: Pointer);
+ procedure AddUses(const AUnitNames: array of string; Scope:
+ TInstantCodeScope; var Source: string; ChangeInfo:
+ TInstantCodeClassChangeInfo);
property SubClassList: TList read GetSubClassList;
public
constructor Create(AOwner: TInstantCodeObject); override;
@@ -1241,15 +1244,15 @@
procedure SetModuleTypeName(const Value: string);
protected
function GetModule: TInstantCodeModule; override;
- procedure InsertType(AType: TInstantCodeType);
procedure InternalRead(Reader: TInstantCodeReader); override;
procedure InternalWrite(Writer: TInstantCodeWriter); override;
- procedure RemoveType(AType: TInstantCodeType);
public
constructor Create(AOwner: TInstantCodeObject); override;
destructor Destroy; override;
function FindClass(const Name: string): TInstantCodeClass;
function FindType(const Name: string): TInstantCodeType;
+ procedure InsertType(AType: TInstantCodeType);
+ procedure RemoveType(AType: TInstantCodeType);
procedure LoadFromFile(const FileName: string; Scope: TInstantCodeScope);
procedure LoadFromStream(Stream: TStream; Scope: TInstantCodeScope);
procedure LoadFromString(const Str: string; Scope: TInstantCodeScope);
@@ -1413,7 +1416,7 @@
function AddMethod(AClass: TInstantCodeClass; Template: TInstantCodeMethod): TInstantCodeMethod;
function AddProc(Template: TInstantCodeProc): TInstantCodeProc;
function AddProperty(AClass: TInstantCodeClass; Template: TInstantCodeProperty): TInstantCodeProperty;
- procedure AddUses(const AUnitName: string; Scope: TInstantCodeScope);
+ procedure AddUses(const AUnitNames: array of string; Scope: TInstantCodeScope = scInterface);
procedure ChangeAttribute(AClass: TInstantCodeClass; Name: string;
Template: TInstantCodeAttribute);
procedure ChangeClass(ChangeInfo: TInstantCodeClassChangeInfo; NewClass: TInstantCodeClass);
@@ -1570,6 +1573,10 @@
Result := 'string';
atDateTime:
Result := 'TDateTime';
+ atDate:
+ Result := 'TDate';
+ atTime:
+ Result := 'TTime';
else
Result := '';
end;
@@ -1592,8 +1599,9 @@
'', // atPart
'', // atReference
'', // atParts,
- '' // atReferences
- );
+ '', // atReferences
+ 'TDate',
+ 'TTime');
begin
for Result := Low(Result) to High(Result) do
if SameText(PropType, TypeNames[Result]) then
@@ -1615,6 +1623,8 @@
AddObject('String', TStringTypeProcessor.Create);
AddObject('Memo', TStringTypeProcessor.Create);
AddObject('DateTime', TDateTimeTypeProcessor.Create);
+ AddObject('Date', TDateTimeTypeProcessor.Create);
+ AddObject('Time', TDateTimeTypeProcessor.Create);
AddObject('Part', TPartTypeProcessor.Create);
AddObject('Reference', TObjectTypeProcessor.Create);
AddObject('Parts', TContainerTypeProcessor.Create);
@@ -4813,6 +4823,24 @@
Result := TInstantCodeProperty(AddMember(TInstantCodeProperty, Visibility));
end;
+procedure TInstantCodeClass.AddUses(const AUnitNames: array of string;
+ Scope: TInstantCodeScope; var Source: string;
+ ChangeInfo: TInstantCodeClassChangeInfo);
+var
+ Modifier: TInstantCodeModifier;
+begin
+ if Assigned(ChangeInfo.Modifier) then
+ Modifier := ChangeInfo.Modifier
+ else
+ Modifier := TInstantCodeModifier.Create(Source, Self.Project);
+ try
+ Modifier.AddUses(AUnitNames, Scope);
+ finally
+ if not Assigned(ChangeInfo.Modifier) then
+ Modifier.Free;
+ end;
+end;
+
procedure TInstantCodeClass.ApplyToSource(var Source: string;
ChangeInfo: TInstantCodeClassChangeInfo);
var
@@ -4825,7 +4853,6 @@
Modifier := TInstantCodeModifier.Create(Source, Self.Project);
try
with Modifier do
- begin
case ChangeInfo.ChangeType of
ctNew:
AddClass(Self);
@@ -4834,12 +4861,13 @@
ctDelete:
DeleteClass(Self);
end;
- AddUses('InstantPersistence', scInterface);
- end;
finally
if not Assigned(ChangeInfo.Modifier) then
Modifier.Free;
end;
+ AddUses(['InstantPersistence', 'InstantTypes'],
+ scInterface, Source, ChangeInfo);
+ AddUses(['InstantMetadata'], scImplementation, Source, ChangeInfo);
end;
procedure TInstantCodeClass.AssignAttributes(List: TList);
@@ -7488,33 +7516,56 @@
Result.Setter := AddMethod(AClass, Template.Setter);
end;
-procedure TInstantCodeModifier.AddUses(const AUnitName: string;
- Scope: TInstantCodeScope);
+procedure TInstantCodeModifier.AddUses(const AUnitNames: array of string; Scope: TInstantCodeScope);
var
Section: TInstantCodeSection;
UsesClause: TInstantCodeUsesClause;
+ iNames: Integer;
+ sStr: string;
begin
+ { check for an empty array }
+ if Length(AUnitNames) = 0 then
+ Exit;
+
with Module do
if Scope = scInterface then
Section := InterfaceSection else
Section := ImplementationSection;
with Section do
begin
+ sStr := '';
UsesClause := FindUsesClause;
if Assigned(UsesClause) then
begin
- if Assigned(UsesClause.Find(AUnitName)) then
- Exit;
- InsertMode := imBefore;
- CursorPos := UsesClause.EndPos;
- MoveCursor(-1);
- InsertText(', ' + AUnitName, True);
- end else
+ { check an existing uses clause and add missing units }
+ for iNames := Low(AUnitNames) to High(AUnitNames) do
+ { build the required string first }
+ if (AUnitNames[iNames] <> '') and
+ not Assigned(UsesClause.Find(AUnitNames[iNames])) then
+ sStr := sStr + ', ' + AUnitNames[iNames];
+ if sStr <> '' then
+ begin
+ InsertMode := imBefore;
+ CursorPos := UsesClause.EndPos;
+ MoveCursor(-1);
+ InsertText(sStr, True);
+ end;
+ end
+ else
begin
+ { uses clause was not found, add all units }
InsertMode := imAfter;
CursorPos := StartPos;
SkipLine;
- InsertText(CRLF + 'uses' + CRLF + ' ' + AUnitName + ';' + CRLF);
+ for iNames := Low(AUnitNames) to High(AUnitNames) do
+ begin
+ if AUnitNames[iNames] <> '' then
+ if sStr = '' then
+ sStr := ' ' + AUnitNames[iNames]
+ else
+ sStr := sStr + ', ' + AUnitNames[iNames];
+ end;
+ InsertText(CRLF + 'uses' + CRLF + sStr + ';' + CRLF)
end;
end;
end;
Modified: trunk/Source/Core/InstantMetadata.pas
===================================================================
--- trunk/Source/Core/InstantMetadata.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Core/InstantMetadata.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -538,9 +538,9 @@
const
AttributeClasses: array[TInstantAttributeType] of TInstantAttributeClass = (
nil, TInstantInteger, TInstantFloat, TInstantCurrency, TInstantBoolean,
- TInstantString, TInstantDateTime, TInstantBlob, TInstantMemo,
+ TInstantString, TInstantDateTime, TInstantBlob, TInstantMemo,
TInstantGraphic, TInstantPart, TInstantReference, TInstantParts,
- TInstantReferences);
+ TInstantReferences, TInstantDate, TInstantTime);
{ TInstantMetadata }
Modified: trunk/Source/Core/InstantPersistence.pas
===================================================================
--- trunk/Source/Core/InstantPersistence.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Core/InstantPersistence.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -169,6 +169,8 @@
function GetAsBoolean: Boolean; virtual;
function GetAsCurrency: Currency; virtual;
function GetAsDateTime: TDateTime; virtual;
+ function GetAsDate: TDateTime; virtual;
+ function GetAsTime: TDateTime; virtual;
function GetAsFloat: Double; virtual;
function GetAsInteger: Integer; virtual;
function GetAsObject: TInstantObject; virtual;
@@ -184,6 +186,8 @@
procedure SetAsBoolean(AValue: Boolean); virtual;
procedure SetAsCurrency(AValue: Currency); virtual;
procedure SetAsDateTime(AValue: TDateTime); virtual;
+ procedure SetAsDate(AValue: TDateTime); virtual;
+ procedure SetAsTime(AValue: TDateTime); virtual;
procedure SetAsFloat(AValue: Double); virtual;
procedure SetAsInteger(AValue: Integer); virtual;
procedure SetAsObject(AValue: TInstantObject); virtual;
@@ -203,6 +207,8 @@
property AsBoolean: Boolean read GetAsBoolean write SetAsBoolean;
property AsCurrency: Currency read GetAsCurrency write SetAsCurrency;
property AsDateTime: TDateTime read GetAsDateTime write SetAsDateTime;
+ property AsDate: TDateTime read GetAsDate write SetAsDate;
+ property AsTime: TDateTime read GetAsTime write SetAsTime;
property AsFloat: Double read GetAsFloat write SetAsFloat;
property AsInteger: Integer read GetAsInteger write SetAsInteger;
property AsObject: TInstantObject read GetAsObject write SetAsObject;
@@ -377,7 +383,7 @@
property Value: string read GetValue write SetValue;
end;
- TInstantDateTime = class(TInstantSimple)
+ TInstantCustomDateTime = class(TInstantSimple)
private
FValue: TDateTime;
function DefaultValue: TDateTime;
@@ -403,6 +409,32 @@
property Value: TDateTime read GetValue write SetValue;
end;
+ TInstantDateTime = class(TInstantCustomDateTime)
+ protected
+ class function AttributeType: TInstantAttributeType; override;
+ function GetAsDate: TDateTime; override;
+ function GetAsTime: TDateTime; override;
+ procedure SetAsDate(AValue: TDateTime); override;
+ procedure SetAsTime(AValue: TDateTime); override;
+ end;
+
+ TInstantDate = class(TInstantCustomDateTime)
+ protected
+ class function AttributeType: TInstantAttributeType; override;
+ function GetAsDate: TDateTime; override;
+ procedure SetValue(AValue: TDateTime); override;
+ procedure SetAsDate(AValue: TDateTime); override;
+ end;
+
+ TInstantTime = class(TInstantCustomDateTime)
+ protected
+ class function AttributeType: TInstantAttributeType; override;
+ function GetAsString: string; override;
+ function GetAsTime: TDateTime; override;
+ procedure SetValue(AValue: TDateTime); override;
+ procedure SetAsTime(AValue: TDateTime); override;
+ end;
+
TInstantBlob = class(TInstantSimple)
private
FStream: TMemoryStream;
@@ -1542,7 +1574,7 @@
const
InstantDataTypeStrings: array[TInstantDataType] of string =
- ('Integer', 'Float', 'Currency', 'Boolean', 'String', 'Memo', 'DateTime', 'Blob');
+ ('Integer', 'Float', 'Currency', 'Boolean', 'String', 'Memo', 'DateTime', 'Blob', 'Date', 'Time');
procedure AssignInstantDataTypeStrings(Strings: TStrings);
@@ -1569,6 +1601,7 @@
{$ELSE}
Mask,
{$ENDIF}
+ DateUtils,
InstantUtils, {InstantRtti, }InstantDesignHook, InstantCode;
var
@@ -1643,7 +1676,9 @@
dtBlob, //atPart
dtString, //atReference
dtBlob, //atParts
- dtBlob); //atReferences
+ dtBlob, //atReferences
+ dtDate, //atDate
+ dtTime); //atTime
DataTypesXML: array[TInstantAttributeType] of TInstantDataType = (
dtString, //atUnknown
@@ -1659,7 +1694,9 @@
dtMemo, //atPart
dtString, //atReference
dtMemo, //atParts
- dtMemo); //atReferences
+ dtMemo, //atReferences
+ dtDate, //atDate
+ dtTime); //atTime
begin
if BlobStreamFormat = sfBinary then
Result := DataTypesBinary[AttributeType]
@@ -1677,6 +1714,8 @@
dtString: Result := ftString;
dtMemo: Result := ftMemo;
dtDateTime: Result := ftDateTime;
+ dtDate: Result := ftDate;
+ dtTime: Result := ftTime;
dtBlob: Result := ftBlob;
else
raise EInstantError.CreateFmt(SUnsupportedDataType,
@@ -2292,6 +2331,16 @@
raise AccessError('DateTime');
end;
+function TInstantAttribute.GetAsDate: TDateTime;
+begin
+ raise AccessError('Date');
+end;
+
+function TInstantAttribute.GetAsTime: TDateTime;
+begin
+ raise AccessError('Time');
+end;
+
function TInstantAttribute.GetAsFloat: Double;
begin
raise AccessError('Float');
@@ -2417,6 +2466,16 @@
raise AccessError('DateTime');
end;
+procedure TInstantAttribute.SetAsDate(AValue: TDateTime);
+begin
+ raise AccessError('Date');
+end;
+
+procedure TInstantAttribute.SetAsTime(AValue: TDateTime);
+begin
+ raise AccessError('Time');
+end;
+
procedure TInstantAttribute.SetAsFloat(AValue: Double);
begin
raise AccessError('Float');
@@ -3194,20 +3253,15 @@
{ TInstantDateTime }
-procedure TInstantDateTime.Assign(Source: TPersistent);
+procedure TInstantCustomDateTime.Assign(Source: TPersistent);
begin
inherited;
- if Source is TInstantDateTime then
- Value := TInstantDateTime(Source).Value
+ if Source is TInstantCustomDateTime then
+ Value := TInstantCustomDateTime(Source).Value
end;
-class function TInstantDateTime.AttributeType: TInstantAttributeType;
+function TInstantCustomDateTime.DefaultValue: TDateTime;
begin
- Result := atDateTime;
-end;
-
-function TInstantDateTime.DefaultValue: TDateTime;
-begin
if Assigned(Metadata) and (Metadata.DefaultValue <> '') then
if SameText(Metadata.DefaultValue, InstantNowString) then
Result := Now
@@ -3226,22 +3280,22 @@
Result := 0;
end;
-function TInstantDateTime.GetAsDateTime: TDateTime;
+function TInstantCustomDateTime.GetAsDateTime: TDateTime;
begin
Result := Value;
end;
-function TInstantDateTime.GetAsString: string;
+function TInstantCustomDateTime.GetAsString: string;
begin
Result := DateTimeToStr(Value);
end;
-function TInstantDateTime.GetAsVariant: Variant;
+function TInstantCustomDateTime.GetAsVariant: Variant;
begin
Result := Value;
end;
-function TInstantDateTime.GetDisplayText: string;
+function TInstantCustomDateTime.GetDisplayText: string;
begin
if AsDateTime = 0 then
Result := ''
@@ -3253,28 +3307,28 @@
end
end;
-function TInstantDateTime.GetIsDefault: Boolean;
+function TInstantCustomDateTime.GetIsDefault: Boolean;
begin
Result := Value = DefaultValue;
end;
-function TInstantDateTime.GetValue: TDateTime;
+function TInstantCustomDateTime.GetValue: TDateTime;
begin
Result := FValue;
end;
-procedure TInstantDateTime.Initialize;
+procedure TInstantCustomDateTime.Initialize;
begin
FValue := DefaultValue;
end;
-procedure TInstantDateTime.ReadObject(Reader: TInstantReader);
+procedure TInstantCustomDateTime.ReadObject(Reader: TInstantReader);
begin
ReadName(Reader);
Value := Reader.ReadDate;
end;
-procedure TInstantDateTime.Reset;
+procedure TInstantCustomDateTime.Reset;
begin
if Assigned(Metadata) then
Initialize
@@ -3283,12 +3337,12 @@
Changed;
end;
-procedure TInstantDateTime.SetAsDateTime(AValue: TDateTime);
+procedure TInstantCustomDateTime.SetAsDateTime(AValue: TDateTime);
begin
Value := AValue;
end;
-procedure TInstantDateTime.SetAsString(const AValue: string);
+procedure TInstantCustomDateTime.SetAsString(const AValue: string);
begin
try
Value := StrToDateTime(AValue)
@@ -3298,7 +3352,7 @@
end;
end;
-procedure TInstantDateTime.SetAsVariant(AValue: Variant);
+procedure TInstantCustomDateTime.SetAsVariant(AValue: Variant);
begin
try
Value := AValue;
@@ -3308,7 +3362,7 @@
end;
end;
-procedure TInstantDateTime.SetValue(AValue: TDateTime);
+procedure TInstantCustomDateTime.SetValue(AValue: TDateTime);
begin
if AValue <> FValue then
begin
@@ -3317,12 +3371,39 @@
end;
end;
-procedure TInstantDateTime.WriteObject(Writer: TInstantWriter);
+procedure TInstantCustomDateTime.WriteObject(Writer: TInstantWriter);
begin
WriteName(Writer);
Writer.WriteDate(Value);
end;
+{ TInstantDateTime }
+
+class function TInstantDateTime.AttributeType: TInstantAttributeType;
+begin
+ Result := atDateTime;
+end;
+
+function TInstantDateTime.GetAsDate: TDateTime;
+begin
+ Result := DateOf(Value);
+end;
+
+function TInstantDateTime.GetAsTime: TDateTime;
+begin
+ Result := TimeOf(Value);
+end;
+
+procedure TInstantDateTime.SetAsDate(AValue: TDateTime);
+begin
+ Value := DateOf(AValue);
+end;
+
+procedure TInstantDateTime.SetAsTime(AValue: TDateTime);
+begin
+ Value := TimeOf(AValue);
+end;
+
{ TInstantBlob }
procedure TInstantBlob.Assign(Source: TPersistent);
@@ -5407,7 +5488,7 @@
Writer.WriteBoolean(SameText(Processor.ReadData, InstantTrueString));
atString, atMemo:
Writer.WriteString(Processor.ReadData);
- atDateTime:
+ atDateTime, atDate, atTime:
Writer.WriteDate(InstantStrToDateTime(Processor.ReadData));
atBlob, atGraphic:
begin
@@ -8820,7 +8901,63 @@
inherited Items[Index] := Value;
end;
+{ TInstantDate }
+class function TInstantDate.AttributeType: TInstantAttributeType;
+begin
+ Result := atDate;
+end;
+
+function TInstantDate.GetAsDate: TDateTime;
+begin
+ Result := Value;
+end;
+
+procedure TInstantDate.SetAsDate(AValue: TDateTime);
+begin
+ Value := DateOf(AValue);
+end;
+
+procedure TInstantDate.SetValue(AValue: TDateTime);
+begin
+ if AValue <> FValue then
+ begin
+ FValue := DateOf(AValue);
+ Changed;
+ end;
+end;
+
+{ TInstantTime }
+
+class function TInstantTime.AttributeType: TInstantAttributeType;
+begin
+ Result := atTime;
+end;
+
+function TInstantTime.GetAsTime: TDateTime;
+begin
+ Result := Value;
+end;
+
+function TInstantTime.GetAsString: string;
+begin
+ Result := TimeToStr(Value);
+end;
+
+procedure TInstantTime.SetAsTime(AValue: TDateTime);
+begin
+ Value := TimeOf(AValue);
+end;
+
+procedure TInstantTime.SetValue(AValue: TDateTime);
+begin
+ if AValue <> FValue then
+ begin
+ FValue := TimeOf(AValue);
+ Changed;
+ end;
+end;
+
initialization
RegisterClasses([TInstantClassMetadatas, TInstantClassMetadata,
TInstantAttributeMetadatas, TInstantAttributeMetadata,
Modified: trunk/Source/Core/InstantPresentation.pas
===================================================================
--- trunk/Source/Core/InstantPresentation.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Core/InstantPresentation.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -769,7 +769,8 @@
const
FieldTypes: array[TInstantAttributeType] of TFieldType = (
ftUnknown, ftInteger, ftFloat, ftBCD, ftBoolean, ftString, ftDateTime,
- ftBlob, ftMemo, ftBlob, ftInteger, ftInteger, ftDataSet, ftDataSet);
+ ftBlob, ftMemo, ftBlob, ftInteger, ftInteger, ftDataSet, ftDataSet,
+ ftDate, ftTime);
begin
Result := FieldTypes[AttributeType];
end;
@@ -2162,6 +2163,7 @@
ATypeInfo : PTypeInfo;
begin
ATypeInfo := PropInfo.PropType^;
+
if GetTypeData(PropInfo^.PropType^).FloatType = ftCurr then
Result := DB.ftBcd
else
@@ -2172,7 +2174,7 @@
Result := DB.ftDate
else if ATypeInfo = TypeInfo(TTime) then
Result := DB.ftTime
-*)
+*)
else
Result := DB.ftFloat;
end;
@@ -2225,7 +2227,12 @@
tkInteger:
FieldType := ftInteger;
tkFloat:
- FieldType := FloatFieldType;
+ if PropInfo^.PropType^^.Name = 'TTime' then
+ FieldType := DB.ftTime
+ else if PropInfo^.PropType^^.Name = 'TDate' then
+ FieldType := DB.ftDate
+ else
+ FieldType := FloatFieldType;
tkClass:
FieldType := ftInteger;
tkSet:
Modified: trunk/Source/Core/InstantTypes.pas
===================================================================
--- trunk/Source/Core/InstantTypes.pas 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Source/Core/InstantTypes.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -44,7 +44,7 @@
TInstantStorageKind = (skEmbedded, skExternal);
TInstantAttributeType = (atUnknown, atInteger, atFloat, atCurrency, atBoolean,
atString, atDateTime, atBlob, atMemo, atGraphic,
- atPart, atReference, atParts, atReferences);
+ atPart, atReference, atParts, atReferences, atDate, atTime);
TInstantAttributeCategory = (acUnknown, acSimple, acElement, acContainer);
TInstantGraphicFileFormat = (gffUnknown, gffBmp, gffTiff, gffJpeg, gffPng,
@@ -53,7 +53,7 @@
TInstantPersistence = (peEmbedded, peStored);
TInstantDataType = (dtInteger, dtFloat, dtCurrency, dtBoolean, dtString,
- dtMemo, dtDateTime, dtBlob);
+ dtMemo, dtDateTime, dtBlob, dtDate, dtTime);
TInstantDataTypes = set of TInstantDataType;
TInstantFieldOption = (foRequired, foIndexed);
TInstantFieldOptions = set of TInstantFieldOption;
@@ -81,6 +81,9 @@
TInstantWarningEvent = procedure (const Sender: TObject;
const AWarningText: string) of object;
+ TTime = type TDateTime;
+ TDate = type TDateTime;
+
implementation
end.
Modified: trunk/Tests/TestIO.dpr
===================================================================
--- trunk/Tests/TestIO.dpr 2006-12-10 05:19:12 UTC (rev 736)
+++ trunk/Tests/TestIO.dpr 2006-12-11 00:17:56 UTC (rev 737)
@@ -38,6 +38,8 @@
TestInstantInteger in 'TestInstantInteger.pas',
TestInstantString in 'TestInstantString.pas',
TestInstantDateTime in 'TestInstantDateTime.pas',
+ TestInstantDate in 'TestInstantDate.pas',
+ TestInstantTime in 'TestInstantTime.pas',
TestInstantBoolean in 'TestInstantBoolean.pas',
TestInstantFloat in 'TestInstantFloat.pas',
TestInstantCurrency in 'TestInstantCurrency.pas',
Modified: trunk/Tests/TestIO.mdr
===================================================================
(Binary files differ)
Added: trunk/Tests/TestInstantDate.pas
===================================================================
--- trunk/Tests/TestInstantDate.pas (rev 0)
+++ trunk/Tests/TestInstantDate.pas 2006-12-11 00:17:56 UTC (rev 737)
@@ -0,0 +1,323 @@
+(*
+ * InstantObjects Test Suite
+ * TestInstantDate
+ *)
+
+(* ***** 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: InstantObjects Test Suite/TestInstantDate
+ *
+ * The Initial Developer of the Original Code is: Steven Mitchell
+ *
+ * Portions created by the Initial Developer are Copyright (C) 2005
+ * the Initial Developer. All Rights Reserved.
+ *
+ * Contributor(s):
+ *
+ *
+ * ***** END LICENSE BLOCK ***** *)
+
+unit TestInstantDate;
+
+interface
+
+uses fpcunit, InstantPersistence, InstantMock, TestModel;
+
+type
+
+ // Test methods for class TInstantDate
+ TestTInstantDate = class(TTestCase)
+ private
+ FConn: TInstantMockConnector;
+ FInstantDate: TInstantDate;
+ FOwner: TPerson;
+ public
+ procedure SetUp; override;
+ procedure TearDown; override;
+ published
+ procedure TestAsBoolean;
+ procedure TestAsCurrency;
+ procedure TestAsDate;
+ procedure TestAsDateTime;
+ procedure TestAsTime;
+ procedure TestAsFloat;
+ procedure TestAsInteger;
+ procedure TestAsObject;
+ procedure TestAssign;
+ procedure TestAsString;
+ procedure TestAsVariant;
+ procedure TestDisplayText;
+ procedure TestIsDefault;
+ procedure TestReset;
+ procedure TestValue;
+ end;
+
+implementation
+
+uses SysUtils, testregistry, InstantClasses;
+
+procedure TestTInstantDate.SetUp;
+begin
+ FConn := TInstantMockConnector.Create(nil);
+ FConn.BrokerClass := TInstantMockBroker;
+
+ if InstantModel.ClassMetadatas.Count > 0 then
+ InstantModel.ClassMetadatas.Clear;
+ InstantModel.LoadFromResFile(ChangeFileExt(ParamStr(0), '.mdr'));
+
+ FOwner := TPerson.Create(FConn);
+ FInstantDate := FOwner._EmploymentDate;
+ FInstantDate.Value := 100;
+end;
+
+procedure TestTInstantDate.TearDown;
+begin
+ FInstantDate := nil;
+ FreeAndNil(FOwner);
+ InstantModel.ClassMetadatas.Clear;
+ ...
[truncated message content] |
