1
0
mirror of synced 2024-11-25 12:13:08 +01:00

Added: date / time of generation in Delphi unit header

Added: settings file
Added: support for renaming enumeration members using a hints file
Fixed: case-insensitive check for reserved Delphi words
Fixed: setter for IsNil
This commit is contained in:
Mark van Renswoude 2008-04-22 13:36:55 +00:00
parent 727a5dca46
commit e4903fdb7b
11 changed files with 892 additions and 62 deletions

Binary file not shown.

View File

@ -11,6 +11,8 @@ uses
Forms, Forms,
Mask, Mask,
StdCtrls, StdCtrls,
XMLDOM,
XMLIntf,
cxButtonEdit, cxButtonEdit,
cxContainer, cxContainer,
@ -18,7 +20,10 @@ uses
cxEdit, cxEdit,
cxLookAndFeels, cxLookAndFeels,
cxMaskEdit, cxMaskEdit,
cxTextEdit; cxTextEdit,
DataBindingHintsXML,
XMLDataBindingGenerator;
type type
@ -53,8 +58,17 @@ type
procedure feFilePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure feFilePropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure deFolderPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer); procedure feSchemaPropertiesButtonClick(Sender: TObject; AButtonIndex: Integer);
procedure feSchemaPropertiesChange(Sender: TObject);
private private
FHints: IXMLDataBindingHints;
FHintsXPath: IDOMNodeSelect;
procedure PostProcessItem(Sender: TObject; Item: TXMLDataBindingItem);
procedure GetFileName(Sender: TObject; const SchemaName: String; var Path, FileName: String); procedure GetFileName(Sender: TObject; const SchemaName: String; var Path, FileName: String);
function GetSettingsFileName(const AFileName: String): String;
procedure LoadSettings(const AFileName: String);
procedure SaveSettings(const AFileName: String);
end; end;
@ -64,10 +78,17 @@ uses
SysUtils, SysUtils,
Windows, Windows,
X2UtNamedFormat,
X2UtTempFile, X2UtTempFile,
DelphiXMLDataBindingGenerator, DataBindingSettingsXML,
XMLDataBindingGenerator; DelphiXMLDataBindingGenerator;
const
XPathHintEnumerationMember = '//Enumerations' +
'/Enumeration[@Name=''%<Enumeration>:s'']' +
'/Member[@Name=''%<Member>:s'']/text()';
{$R *.dfm} {$R *.dfm}
@ -87,9 +108,12 @@ begin
if FileExists(schemaFile) then if FileExists(schemaFile) then
begin begin
feSchema.Text := schemaFile;
feFile.Text := ChangeFileExt(schemaFile, '.pas'); feFile.Text := ChangeFileExt(schemaFile, '.pas');
deFolder.Text := ExtractFilePath(schemaFile); deFolder.Text := ExtractFilePath(schemaFile);
{ Set schema last, the Change event will attempt to load the
settings file and overwrite the file / folder. }
feSchema.Text := schemaFile;
end; end;
end; end;
end; end;
@ -105,6 +129,9 @@ end;
procedure TMainForm.btnGenerateClick(Sender: TObject); procedure TMainForm.btnGenerateClick(Sender: TObject);
var
hintsFile: String;
begin begin
if not FileExists(feSchema.Text) then if not FileExists(feSchema.Text) then
begin begin
@ -115,6 +142,14 @@ begin
Exit; Exit;
end; end;
hintsFile := ChangeFileExt(feSchema.Text, '.hints.xml');
if FileExists(hintsFile) then
begin
FHints := LoadDataBindingHints(hintsFile);
FHintsXPath := (FHints.OwnerDocument.DocumentElement.DOMNode as IDOMNodeSelect);
end;
try
with TDelphiXMLDataBindingGenerator.Create() do with TDelphiXMLDataBindingGenerator.Create() do
try try
if rbFile.Checked then if rbFile.Checked then
@ -127,13 +162,20 @@ begin
OutputPath := deFolder.Text; OutputPath := deFolder.Text;
end; end;
OnPostProcessItem := PostProcessItem;
OnGetFileName := GetFileName; OnGetFileName := GetFileName;
Execute(feSchema.Text); Execute(feSchema.Text);
SaveSettings(feSchema.Text);
ShowMessage('The data binding has been generated.'); ShowMessage('The data binding has been generated.');
finally finally
Free(); Free();
end; end;
finally
FHints := nil;
FHintsXPath := nil;
end;
end; end;
@ -143,6 +185,29 @@ begin
end; end;
procedure TMainForm.PostProcessItem(Sender: TObject; Item: TXMLDataBindingItem);
var
member: TXMLDataBindingEnumerationMember;
hint: IDOMNode;
begin
if not Assigned(FHintsXPath) then
Exit;
if Item.ItemType = itEnumerationMember then
begin
{ Check if a hint for a new name is available }
member := TXMLDataBindingEnumerationMember(Item);
hint := FHintsXPath.selectNode(NamedFormat(XPathHintEnumerationMember,
['Enumeration', member.Enumeration.Name,
'Member', member.Name]));
if Assigned(hint) and (Length(hint.nodeValue) > 0) then
Item.TranslatedName := hint.nodeValue;
end;
end;
procedure TMainForm.GetFileName(Sender: TObject; const SchemaName: String; var Path, FileName: String); procedure TMainForm.GetFileName(Sender: TObject; const SchemaName: String; var Path, FileName: String);
begin begin
FileName := ChangeFileExt(edtFolderPrefix.Text + FileName, FileName := ChangeFileExt(edtFolderPrefix.Text + FileName,
@ -174,4 +239,90 @@ begin
feSchema.Text := dlgSchema.FileName; feSchema.Text := dlgSchema.FileName;
end; end;
procedure TMainForm.feSchemaPropertiesChange(Sender: TObject);
begin
if FileExists(feSchema.Text) then
LoadSettings(feSchema.Text);
end;
function TMainForm.GetSettingsFileName(const AFileName: String): String;
begin
Result := ChangeFileExt(AFileName, '.settings.xml');
end;
procedure TMainForm.LoadSettings(const AFileName: String);
var
fileName: String;
settings: IXMLDataBindingSettings;
outputSingle: IXMLOutputSingle;
outputMultiple: IXMLOutputMultiple;
begin
fileName := GetSettingsFileName(AFileName);
if FileExists(fileName) then
begin
settings := LoadDataBindingSettings(fileName);
if settings.HasOutput then
begin
case settings.Output.OutputType of
OutputType_Single:
begin
outputSingle := settings.Output.OutputSingle;
rbFile.Checked := True;
feFile.Text := outputSingle.FileName;
end;
OutputType_Multiple:
begin
outputMultiple := settings.Output.OutputMultiple;
rbFolder.Checked := True;
deFolder.Text := outputMultiple.Path;
edtFolderPrefix.Text := outputMultiple.Prefix;
edtFolderPostfix.Text := outputMultiple.Postfix;
end;
end;
end;
end;
end;
procedure TMainForm.SaveSettings(const AFileName: String);
var
fileName: String;
settings: IXMLDataBindingSettings;
outputSingle: IXMLOutputSingle;
outputMultiple: IXMLOutputMultiple;
begin
fileName := GetSettingsFileName(AFileName);
if FileExists(fileName) then
settings := LoadDataBindingSettings(fileName)
else
settings := NewDataBindingSettings();
settings.Output.ChildNodes.Clear;
if rbFile.Checked then
begin
settings.Output.OutputType := OutputType_Single;
outputSingle := settings.Output.OutputSingle;
outputSingle.FileName := feFile.Text;
end else
begin
settings.Output.OutputType := OutputType_Multiple;
outputMultiple := settings.Output.OutputMultiple;
outputMultiple.Path := deFolder.Text;
outputMultiple.Prefix := edtFolderPrefix.Text;
outputMultiple.Postfix := edtFolderPostfix.Text;
end;
settings.OwnerDocument.SaveToFile(fileName);
end;
end. end.

View File

@ -0,0 +1,241 @@
{
X2Software XML Data Binding Wizard
Generated from: P:\test\XMLDataBinding\XSD\DataBindingHints.xsd
}
unit DataBindingHintsXML;
interface
uses
Classes,
XMLDoc,
XMLIntf;
type
{ Forward declarations for DataBindingHints }
IXMLDataBindingHints = interface;
IXMLEnumerations = interface;
IXMLEnumeration = interface;
IXMLMember = interface;
{ Interfaces for DataBindingHints }
{
Contains hints and mappings for the data binding output
}
IXMLDataBindingHints = interface(IXMLNode)
['{DA83EE96-932F-45FB-A7B4-9BF68E10A082}']
function GetHasEnumerations: Boolean;
function GetEnumerations: IXMLEnumerations;
property HasEnumerations: Boolean read GetHasEnumerations;
property Enumerations: IXMLEnumerations read GetEnumerations;
end;
IXMLEnumerations = interface(IXMLNodeCollection)
['{5DD6B71B-6E29-46C0-B900-59445CF98597}']
function Get_Enumeration(Index: Integer): IXMLEnumeration;
function Add: IXMLEnumeration;
function Insert(Index: Integer): IXMLEnumeration;
property Enumeration[Index: Integer]: IXMLEnumeration read Get_Enumeration; default;
end;
IXMLEnumeration = interface(IXMLNodeCollection)
['{DA297C8A-C7A8-4BC6-8969-0939B67A584F}']
function Get_Member(Index: Integer): IXMLMember;
function Add: IXMLMember;
function Insert(Index: Integer): IXMLMember;
property Member[Index: Integer]: IXMLMember read Get_Member; default;
function GetName: WideString;
procedure SetName(const Value: WideString);
property Name: WideString read GetName write SetName;
end;
IXMLMember = interface(IXMLNode)
['{BE7BEDE3-0609-437C-A699-3FB67263E88D}']
function GetName: WideString;
procedure SetName(const Value: WideString);
property Name: WideString read GetName write SetName;
end;
{ Classes for DataBindingHints }
TXMLDataBindingHints = class(TXMLNode, IXMLDataBindingHints)
public
procedure AfterConstruction; override;
protected
function GetHasEnumerations: Boolean;
function GetEnumerations: IXMLEnumerations;
end;
TXMLEnumerations = class(TXMLNodeCollection, IXMLEnumerations)
public
procedure AfterConstruction; override;
protected
function Get_Enumeration(Index: Integer): IXMLEnumeration;
function Add: IXMLEnumeration;
function Insert(Index: Integer): IXMLEnumeration;
end;
TXMLEnumeration = class(TXMLNodeCollection, IXMLEnumeration)
public
procedure AfterConstruction; override;
protected
function Get_Member(Index: Integer): IXMLMember;
function Add: IXMLMember;
function Insert(Index: Integer): IXMLMember;
function GetName: WideString;
procedure SetName(const Value: WideString);
end;
TXMLMember = class(TXMLNode, IXMLMember)
protected
function GetName: WideString;
procedure SetName(const Value: WideString);
end;
{ Document functions }
function GetDataBindingHints(ADocument: IXMLDocument): IXMLDataBindingHints;
function LoadDataBindingHints(const AFileName: String): IXMLDataBindingHints;
function LoadDataBindingHintsFromStream(AStream: TStream): IXMLDataBindingHints;
function NewDataBindingHints: IXMLDataBindingHints;
const
XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
TargetNamespace = '';
implementation
uses
SysUtils;
{ Document functions }
function GetDataBindingHints(ADocument: IXMLDocument): IXMLDataBindingHints;
begin
Result := ADocument.GetDocBinding('DataBindingHints', TXMLDataBindingHints, TargetNamespace) as IXMLDataBindingHints
end;
function LoadDataBindingHints(const AFileName: String): IXMLDataBindingHints;
begin
Result := LoadXMLDocument(AFileName).GetDocBinding('DataBindingHints', TXMLDataBindingHints, TargetNamespace) as IXMLDataBindingHints
end;
function LoadDataBindingHintsFromStream(AStream: TStream): IXMLDataBindingHints;
var
doc: IXMLDocument;
begin
doc := NewXMLDocument;
doc.LoadFromStream(AStream);
Result := GetDataBindingHints(doc);
end;
function NewDataBindingHints: IXMLDataBindingHints;
begin
Result := NewXMLDocument.GetDocBinding('DataBindingHints', TXMLDataBindingHints, TargetNamespace) as IXMLDataBindingHints
end;
{ Implementation for DataBindingHints }
procedure TXMLDataBindingHints.AfterConstruction;
begin
RegisterChildNode('Enumerations', TXMLEnumerations);
inherited;
end;
function TXMLDataBindingHints.GetHasEnumerations: Boolean;
begin
Result := Assigned(ChildNodes.FindNode('Enumerations'));
end;
function TXMLDataBindingHints.GetEnumerations: IXMLEnumerations;
begin
Result := (ChildNodes['Enumerations'] as IXMLEnumerations);
end;
procedure TXMLEnumerations.AfterConstruction;
begin
RegisterChildNode('Enumeration', TXMLEnumeration);
ItemTag := 'Enumeration';
ItemInterface := IXMLEnumeration;
inherited;
end;
function TXMLEnumerations.Get_Enumeration(Index: Integer): IXMLEnumeration;
begin
Result := (List[Index] as IXMLEnumeration);
end;
function TXMLEnumerations.Add: IXMLEnumeration;
begin
Result := (AddItem(-1) as IXMLEnumeration);
end;
function TXMLEnumerations.Insert(Index: Integer): IXMLEnumeration;
begin
Result := (AddItem(Index) as IXMLEnumeration);
end;
procedure TXMLEnumeration.AfterConstruction;
begin
RegisterChildNode('Member', TXMLMember);
ItemTag := 'Member';
ItemInterface := IXMLMember;
inherited;
end;
function TXMLEnumeration.Get_Member(Index: Integer): IXMLMember;
begin
Result := (List[Index] as IXMLMember);
end;
function TXMLEnumeration.Add: IXMLMember;
begin
Result := (AddItem(-1) as IXMLMember);
end;
function TXMLEnumeration.Insert(Index: Integer): IXMLMember;
begin
Result := (AddItem(Index) as IXMLMember);
end;
function TXMLEnumeration.GetName: WideString;
begin
Result := AttributeNodes['Name'].Text;
end;
procedure TXMLEnumeration.SetName(const Value: WideString);
begin
SetAttribute('Name', Value);
end;
function TXMLMember.GetName: WideString;
begin
Result := AttributeNodes['Name'].Text;
end;
procedure TXMLMember.SetName(const Value: WideString);
begin
SetAttribute('Name', Value);
end;
end.

View File

@ -0,0 +1,308 @@
{
X2Software XML Data Binding Wizard
Generated from: P:\test\XMLDataBinding\XSD\DataBindingSettings.xsd
}
unit DataBindingSettingsXML;
interface
uses
Classes,
XMLDoc,
XMLIntf;
type
{ Forward declarations for DataBindingSettings }
IXMLDataBindingSettings = interface;
IXMLDataBindingOutput = interface;
TXMLOutputType = (OutputType_Single,
OutputType_Multiple);
IXMLOutputSingle = interface;
IXMLOutputMultiple = interface;
{ Interfaces for DataBindingSettings }
{
Contains the settings and hints for the Delphi XML Data Binding.
}
IXMLDataBindingSettings = interface(IXMLNode)
['{2F402DC3-E73C-487E-A921-357A99CF717F}']
function GetHasOutput: Boolean;
function GetOutput: IXMLDataBindingOutput;
property HasOutput: Boolean read GetHasOutput;
property Output: IXMLDataBindingOutput read GetOutput;
end;
{
Contains the user-defined output settings last used
}
IXMLDataBindingOutput = interface(IXMLNode)
['{812D7883-4F30-4B28-AA38-B107A99C90EC}']
function GetOutputTypeText: WideString;
function GetOutputType: TXMLOutputType;
function GetHasOutputSingle: Boolean;
function GetOutputSingle: IXMLOutputSingle;
function GetHasOutputMultiple: Boolean;
function GetOutputMultiple: IXMLOutputMultiple;
procedure SetOutputTypeText(const Value: WideString);
procedure SetOutputType(const Value: TXMLOutputType);
property OutputTypeText: WideString read GetOutputTypeText write SetOutputTypeText;
property OutputType: TXMLOutputType read GetOutputType write SetOutputType;
property HasOutputSingle: Boolean read GetHasOutputSingle;
property OutputSingle: IXMLOutputSingle read GetOutputSingle;
property HasOutputMultiple: Boolean read GetHasOutputMultiple;
property OutputMultiple: IXMLOutputMultiple read GetOutputMultiple;
end;
IXMLOutputSingle = interface(IXMLNode)
['{025F89C0-0036-44DD-B0FC-833D572B668E}']
function GetFileName: WideString;
procedure SetFileName(const Value: WideString);
property FileName: WideString read GetFileName write SetFileName;
end;
IXMLOutputMultiple = interface(IXMLNode)
['{ABF68B77-E356-42DC-9166-72AA956EDA8E}']
function GetPath: WideString;
function GetPrefix: WideString;
function GetPostfix: WideString;
procedure SetPath(const Value: WideString);
procedure SetPrefix(const Value: WideString);
procedure SetPostfix(const Value: WideString);
property Path: WideString read GetPath write SetPath;
property Prefix: WideString read GetPrefix write SetPrefix;
property Postfix: WideString read GetPostfix write SetPostfix;
end;
{ Classes for DataBindingSettings }
TXMLDataBindingSettings = class(TXMLNode, IXMLDataBindingSettings)
public
procedure AfterConstruction; override;
protected
function GetHasOutput: Boolean;
function GetOutput: IXMLDataBindingOutput;
end;
TXMLDataBindingOutput = class(TXMLNode, IXMLDataBindingOutput)
public
procedure AfterConstruction; override;
protected
function GetOutputTypeText: WideString;
function GetOutputType: TXMLOutputType;
function GetHasOutputSingle: Boolean;
function GetOutputSingle: IXMLOutputSingle;
function GetHasOutputMultiple: Boolean;
function GetOutputMultiple: IXMLOutputMultiple;
procedure SetOutputTypeText(const Value: WideString);
procedure SetOutputType(const Value: TXMLOutputType);
end;
TXMLOutputSingle = class(TXMLNode, IXMLOutputSingle)
protected
function GetFileName: WideString;
procedure SetFileName(const Value: WideString);
end;
TXMLOutputMultiple = class(TXMLNode, IXMLOutputMultiple)
protected
function GetPath: WideString;
function GetPrefix: WideString;
function GetPostfix: WideString;
procedure SetPath(const Value: WideString);
procedure SetPrefix(const Value: WideString);
procedure SetPostfix(const Value: WideString);
end;
{ Document functions }
function GetDataBindingSettings(ADocument: IXMLDocument): IXMLDataBindingSettings;
function LoadDataBindingSettings(const AFileName: String): IXMLDataBindingSettings;
function LoadDataBindingSettingsFromStream(AStream: TStream): IXMLDataBindingSettings;
function NewDataBindingSettings: IXMLDataBindingSettings;
const
XMLSchemaInstanceURI = 'http://www.w3.org/2001/XMLSchema-instance';
TargetNamespace = '';
const
OutputTypeValues: array[TXMLOutputType] of WideString =
(
'Single',
'Multiple'
);
{ Enumeration conversion helpers }
function StringToOutputType(const AValue: WideString): TXMLOutputType;
implementation
uses
SysUtils;
{ Document functions }
function GetDataBindingSettings(ADocument: IXMLDocument): IXMLDataBindingSettings;
begin
Result := ADocument.GetDocBinding('DataBindingSettings', TXMLDataBindingSettings, TargetNamespace) as IXMLDataBindingSettings
end;
function LoadDataBindingSettings(const AFileName: String): IXMLDataBindingSettings;
begin
Result := LoadXMLDocument(AFileName).GetDocBinding('DataBindingSettings', TXMLDataBindingSettings, TargetNamespace) as IXMLDataBindingSettings
end;
function LoadDataBindingSettingsFromStream(AStream: TStream): IXMLDataBindingSettings;
var
doc: IXMLDocument;
begin
doc := NewXMLDocument;
doc.LoadFromStream(AStream);
Result := GetDataBindingSettings(doc);
end;
function NewDataBindingSettings: IXMLDataBindingSettings;
begin
Result := NewXMLDocument.GetDocBinding('DataBindingSettings', TXMLDataBindingSettings, TargetNamespace) as IXMLDataBindingSettings
end;
{ Enumeration conversion helpers }
function StringToOutputType(const AValue: WideString): TXMLOutputType;
var
enumValue: TXMLOutputType;
begin
Result := TXMLOutputType(-1);
for enumValue := Low(TXMLOutputType) to High(TXMLOutputType) do
if OutputTypeValues[enumValue] = AValue then
begin
Result := enumValue;
break;
end;
end;
{ Implementation for DataBindingSettings }
procedure TXMLDataBindingSettings.AfterConstruction;
begin
RegisterChildNode('Output', TXMLDataBindingOutput);
inherited;
end;
function TXMLDataBindingSettings.GetHasOutput: Boolean;
begin
Result := Assigned(ChildNodes.FindNode('Output'));
end;
function TXMLDataBindingSettings.GetOutput: IXMLDataBindingOutput;
begin
Result := (ChildNodes['Output'] as IXMLDataBindingOutput);
end;
procedure TXMLDataBindingOutput.AfterConstruction;
begin
RegisterChildNode('OutputSingle', TXMLOutputSingle);
RegisterChildNode('OutputMultiple', TXMLOutputMultiple);
inherited;
end;
function TXMLDataBindingOutput.GetOutputTypeText: WideString;
begin
Result := ChildNodes['OutputType'].NodeValue;
end;
function TXMLDataBindingOutput.GetOutputType: TXMLOutputType;
begin
Result := StringToOutputType(GetOutputTypeText);
end;
function TXMLDataBindingOutput.GetHasOutputSingle: Boolean;
begin
Result := Assigned(ChildNodes.FindNode('OutputSingle'));
end;
function TXMLDataBindingOutput.GetOutputSingle: IXMLOutputSingle;
begin
Result := (ChildNodes['OutputSingle'] as IXMLOutputSingle);
end;
function TXMLDataBindingOutput.GetHasOutputMultiple: Boolean;
begin
Result := Assigned(ChildNodes.FindNode('OutputMultiple'));
end;
function TXMLDataBindingOutput.GetOutputMultiple: IXMLOutputMultiple;
begin
Result := (ChildNodes['OutputMultiple'] as IXMLOutputMultiple);
end;
procedure TXMLDataBindingOutput.SetOutputTypeText(const Value: WideString);
begin
ChildNodes['OutputType'].NodeValue := Value;
end;
procedure TXMLDataBindingOutput.SetOutputType(const Value: TXMLOutputType);
begin
ChildNodes['OutputType'].NodeValue := OutputTypeValues[Value];
end;
function TXMLOutputSingle.GetFileName: WideString;
begin
Result := ChildNodes['FileName'].Text;
end;
procedure TXMLOutputSingle.SetFileName(const Value: WideString);
begin
ChildNodes['FileName'].NodeValue := Value;
end;
function TXMLOutputMultiple.GetPath: WideString;
begin
Result := ChildNodes['Path'].Text;
end;
function TXMLOutputMultiple.GetPrefix: WideString;
begin
Result := ChildNodes['Prefix'].Text;
end;
function TXMLOutputMultiple.GetPostfix: WideString;
begin
Result := ChildNodes['Postfix'].Text;
end;
procedure TXMLOutputMultiple.SetPath(const Value: WideString);
begin
ChildNodes['Path'].NodeValue := Value;
end;
procedure TXMLOutputMultiple.SetPrefix(const Value: WideString);
begin
ChildNodes['Prefix'].NodeValue := Value;
end;
procedure TXMLOutputMultiple.SetPostfix(const Value: WideString);
begin
ChildNodes['Postfix'].NodeValue := Value;
end;
end.

View File

@ -343,7 +343,7 @@ begin
{ Check for reserved words } { Check for reserved words }
for wordIndex := Low(ReservedWords) to High(ReservedWords) do for wordIndex := Low(ReservedWords) to High(ReservedWords) do
begin begin
if Result = ReservedWords[wordIndex] then if SameText(Result, ReservedWords[wordIndex]) then
begin begin
Result := '_' + Result; Result := '_' + Result;
Break; Break;
@ -368,7 +368,8 @@ procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper;
begin begin
AStream.WriteNamedFmt(UnitHeader, AStream.WriteNamedFmt(UnitHeader,
['SourceFileName', ASourceFileName, ['SourceFileName', ASourceFileName,
'UnitName', ChangeFileExt(ExtractFileName(AFileName), '')]); 'UnitName', ChangeFileExt(ExtractFileName(AFileName), ''),
'DateTime', DateTimeToStr(Now)]);
end; end;
@ -569,9 +570,11 @@ var
typeMapping: TTypeMapping; typeMapping: TTypeMapping;
conversion: TTypeConversion; conversion: TTypeConversion;
hasHelpers: Boolean; hasHelpers: Boolean;
hasNillable: Boolean;
begin begin
usedConversions := []; usedConversions := [];
hasNillable := False;
{ Determine which conversions are used } { Determine which conversions are used }
for schemaIndex := Pred(ASchemaList.Count) downto 0 do for schemaIndex := Pred(ASchemaList.Count) downto 0 do
@ -591,6 +594,9 @@ begin
propertyItem := TXMLDataBindingSimpleProperty(interfaceItem.Properties[propertyIndex]); propertyItem := TXMLDataBindingSimpleProperty(interfaceItem.Properties[propertyIndex]);
if GetDataTypeMapping(propertyItem.DataType, typeMapping) then if GetDataTypeMapping(propertyItem.DataType, typeMapping) then
Include(usedConversions, typeMapping.Conversion); Include(usedConversions, typeMapping.Conversion);
if propertyItem.IsNillable then
hasNillable := True;
end; end;
end; end;
end; end;
@ -614,6 +620,9 @@ begin
if hasHelpers then if hasHelpers then
AStream.WriteLn(); AStream.WriteLn();
if hasNillable then
AStream.Write(NilElementHelpers);
end; end;
@ -815,7 +824,7 @@ begin
begin begin
WritePrototype; WritePrototype;
AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', TXML%<Name>:s);', AStream.WriteLnNamedFmt(' RegisterChildNode(''%<SourceName>:s'', TXML%<Name>:s);',
['SourceName', itemProperty.Item.Name, ['SourceName', propertyItem.Name,
'Name', itemProperty.Item.TranslatedName]); 'Name', itemProperty.Item.TranslatedName]);
end; end;
end; end;
@ -1085,14 +1094,11 @@ begin
to check if an item is present, no need to write a HasX method. } to check if an item is present, no need to write a HasX method. }
// #ToDo3 (MvR) 14-4-2008: move first check to XMLDataBindingGenerator ? // #ToDo3 (MvR) 14-4-2008: move first check to XMLDataBindingGenerator ?
writeOptional := False; writeOptional := False;
writeNil := False; writeNil := AProperty.IsNillable;
if AMember in [dxmPropertyGet, dxmPropertyDeclaration] then if AMember in [dxmPropertyGet, dxmPropertyDeclaration] then
begin
writeOptional := not Assigned(AProperty.Collection) and writeOptional := not Assigned(AProperty.Collection) and
AProperty.IsOptional; AProperty.IsOptional;
writeNil := AProperty.IsNillable;
end;
dataTypeName := ''; dataTypeName := '';
@ -1164,6 +1170,9 @@ begin
begin begin
WriteNewLine; WriteNewLine;
if writeNil then
sourceCode.Add(PropertyIntfMethodSetNil);
if writeTextProp then if writeTextProp then
sourceCode.Add(PropertyIntfMethodSetText); sourceCode.Add(PropertyIntfMethodSetText);
@ -1178,17 +1187,20 @@ begin
if writeOptional then if writeOptional then
sourceCode.Add(PropertyInterfaceOptional); sourceCode.Add(PropertyInterfaceOptional);
if writeNil then
sourceCode.Add(PropertyInterfaceNil);
if AProperty.IsReadOnly then if AProperty.IsReadOnly then
begin begin
if writeNil then
sourceCode.Add(PropertyInterfaceNilReadOnly);
if writeTextProp then if writeTextProp then
sourceCode.Add(PropertyInterfaceTextReadOnly); sourceCode.Add(PropertyInterfaceTextReadOnly);
sourceCode.Add(PropertyInterfaceReadOnly); sourceCode.Add(PropertyInterfaceReadOnly);
end else end else
begin begin
if writeNil then
sourceCode.Add(PropertyInterfaceNil);
if writeTextProp then if writeTextProp then
sourceCode.Add(PropertyInterfaceText); sourceCode.Add(PropertyInterfaceText);
@ -1262,6 +1274,9 @@ begin
begin begin
WriteNewLine; WriteNewLine;
if writeNil then
sourceCode.Add(PropertyImplMethodSetNil);
if writeTextProp then if writeTextProp then
sourceCode.Add(PropertyImplMethodSetText); sourceCode.Add(PropertyImplMethodSetText);

View File

@ -12,7 +12,9 @@ const
CrLf = #13#10; CrLf = #13#10;
UnitHeader = '{' + CrLf + UnitHeader = '{' + CrLf +
' X2Software XML Data Binding Wizard' + CrLf + ' X2Software XML Data Binding' + CrLf +
'' + CrLf +
' Generated on: %<DateTime>:s' + CrLf +
' Generated from: %<SourceFileName>:s' + CrLf + ' Generated from: %<SourceFileName>:s' + CrLf +
'}' + CrLf + '}' + CrLf +
'unit %<UnitName>:s;' + CrLf + 'unit %<UnitName>:s;' + CrLf +
@ -73,14 +75,16 @@ const
PropertyIntfMethodGetOptional = ' function GetHas%<PropertyName>:s: Boolean;'; PropertyIntfMethodGetOptional = ' function GetHas%<PropertyName>:s: Boolean;';
PropertyIntfMethodGetNil = ' function GetIs%<PropertyName>:sNil: Boolean;'; PropertyIntfMethodGetNil = ' function Get%<PropertyName>:sIsNil: Boolean;';
PropertyIntfMethodGetText = ' function Get%<PropertyName>:sText: WideString;'; PropertyIntfMethodGetText = ' function Get%<PropertyName>:sText: WideString;';
PropertyIntfMethodGet = ' function Get%<PropertyName>:s: %<DataType>:s;'; PropertyIntfMethodGet = ' function Get%<PropertyName>:s: %<DataType>:s;';
PropertyIntfMethodSetNil = ' procedure Set%<PropertyName>:sIsNil(const Value: Boolean);';
PropertyIntfMethodSetText = ' procedure Set%<PropertyName>:sText(const Value: WideString);'; PropertyIntfMethodSetText = ' procedure Set%<PropertyName>:sText(const Value: WideString);';
PropertyIntfMethodSet = ' procedure Set%<PropertyName>:s(const Value: %<DataType>:s);'; PropertyIntfMethodSet = ' procedure Set%<PropertyName>:s(const Value: %<DataType>:s);';
PropertyInterfaceOptional = ' property Has%<PropertyName>:s: Boolean read GetHas%<PropertyName>:s;'; PropertyInterfaceOptional = ' property Has%<PropertyName>:s: Boolean read GetHas%<PropertyName>:s;';
PropertyInterfaceNil = ' property Is%<PropertyName>:sNil: Boolean read GetIs%<PropertyName>:sNil;'; PropertyInterfaceNilReadOnly = ' property %<PropertyName>:sIsNil: Boolean read Get%<PropertyName>:sIsNil;';
PropertyInterfaceNil = ' property %<PropertyName>:sIsNil: Boolean read Get%<PropertyName>:sIsNil write Set%<PropertyName>:sIsNil;';
PropertyInterfaceTextReadOnly = ' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText;'; PropertyInterfaceTextReadOnly = ' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText;';
PropertyInterfaceReadOnly = ' property %<PropertyName>:s: %<DataType>:s read Get%<PropertyName>:s;'; PropertyInterfaceReadOnly = ' property %<PropertyName>:s: %<DataType>:s read Get%<PropertyName>:s;';
PropertyInterfaceText = ' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText write Set%<PropertyName>:sText;'; PropertyInterfaceText = ' property %<PropertyName>:sText: WideString read Get%<PropertyName>:sText write Set%<PropertyName>:sText;';
@ -92,14 +96,14 @@ const
'end;' + CrLf + 'end;' + CrLf +
'' + CrLf; '' + CrLf;
PropertyImplMethodGetNil = 'function TXML%<Name>:s.GetIs%<PropertyName>:sNil: Boolean;' + CrLf + PropertyImplMethodGetNil = 'function TXML%<Name>:s.Get%<PropertyName>:sIsNil: Boolean;' + CrLf +
'var' + CrLf +
' childNode: IXMLNode;' + CrLf +
'' + CrLf +
'begin' + CrLf + 'begin' + CrLf +
' childNode := ChildNodes[''%<PropertySourceName>:s''];' + CrLf + ' Result := GetNodeIsNil(ChildNodes[''%<PropertySourceName>:s'']);' + CrLf +
' Result := childNode.HasAttribute(''nil'', XMLSchemaInstanceURI) and' + CrLf + 'end;' + CrLf +
' StrToBoolDef(childNode.GetAttributeNS(''nil'', XMLSchemaInstanceURI), False);' + CrLf + '' + CrLf;
PropertyImplMethodSetNil = 'procedure TXML%<Name>:s.Set%<PropertyName>:sIsNil(const Value: Boolean);' + CrLf +
'begin' + CrLf +
' SetNodeIsNil(ChildNodes[''%<PropertySourceName>:s''], Value);' + CrLf +
'end;' + CrLf + 'end;' + CrLf +
'' + CrLf; '' + CrLf;
@ -147,18 +151,18 @@ const
// #ToDo1 (MvR) 9-3-2008: document / node / etc // #ToDo1 (MvR) 9-3-2008: document / node / etc
// #ToDo1 (MvR) 9-3-2008: WideString etc ? // #ToDo1 (MvR) 9-3-2008: WideString etc ?
ReservedWords: array[0..111] of String = ReservedWords: array[0..106] of String =
( (
'absolute', 'abstract', 'and', 'array', 'as', 'asm', 'absolute', 'abstract', 'and', 'array', 'as', 'asm',
'assembler', 'automated', 'begin', 'case', 'cdecl', 'class', 'assembler', {'automated', }'begin', 'case', 'cdecl', 'class',
'const', 'constructor', 'contains', 'default', 'deprecated', 'const', 'constructor', {'contains', }'default', 'deprecated',
'destructor', 'dispid', 'dispinterface', 'div', 'do', 'destructor', 'dispid', 'dispinterface', 'div', 'do',
'downto', 'dynamic', 'else', 'end', 'except', 'export', 'downto', 'dynamic', 'else', 'end', 'except', 'export',
'exports', 'external', 'far', 'file', 'final', 'finalization', 'exports', 'external', 'far', {'file', 'final', }'finalization',
'finally', 'for', 'forward', 'function', 'goto', 'if', 'finally', 'for', 'forward', 'function', 'goto', 'if',
'implementation', 'implements', 'in', 'index', 'inherited', 'implementation', 'implements', 'in', 'index', 'inherited',
'initialization', 'inline', 'interface', 'is', 'label', 'initialization', 'inline', 'interface', 'is', 'label',
'library', 'local', 'message', 'mod', 'name', 'near', 'library', 'local', 'message', 'mod', {'name', }'near',
'nil', 'nodefault', 'not', 'object', 'of', 'or', 'out', 'nil', 'nodefault', 'not', 'object', 'of', 'or', 'out',
'overload', 'override', 'package', 'packed', 'pascal', 'overload', 'override', 'package', 'packed', 'pascal',
'platform', 'private', 'procedure', 'program', 'property', 'platform', 'private', 'procedure', 'program', 'property',
@ -334,6 +338,25 @@ const
); );
NilElementHelpers = '{ Nillable element helpers }' + CrLf +
'function GetNodeIsNil(ANode: IXMLNode): Boolean;' + CrLf +
'begin' + CrLf +
' Result := ANode.HasAttribute(''nil'', XMLSchemaInstanceURI) and' + CrLf +
' StrToBoolDef(ANode.GetAttributeNS(''nil'', XMLSchemaInstanceURI), False);' + CrLf +
'end;' + CrLf +
'' + CrLf +
'procedure SetNodeIsNil(ANode: IXMLNode; ASetNil: Boolean);' + CrLf +
'begin' + CrLf +
' if ASetNil then' + CrLf +
' begin' + CrLf +
' ANode.ChildNodes.Clear;' + CrLf +
' ANode.SetAttributeNS(''nil'', XMLSchemaInstanceURI, ''true'');' + CrLf +
' end else' + CrLf +
' ANode.AttributeNodes.Delete(''nil'', XMLSchemaInstanceURI);' + CrLf +
'end;' + CrLf +
'' + CrLf;
implementation implementation
end. end.

View File

@ -28,6 +28,7 @@ type
TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object; TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object;
TXMLDataBindingPostProcessItemEvent = procedure(Sender: TObject; Item: TXMLDataBindingItem) of object;
TXMLDataBindingGenerator = class(TObject) TXMLDataBindingGenerator = class(TObject)
@ -39,6 +40,8 @@ type
FSchemas: TObjectList; FSchemas: TObjectList;
FOnPostProcessItem: TXMLDataBindingPostProcessItemEvent;
function GetSchemaCount(): Integer; function GetSchemaCount(): Integer;
function GetSchemas(Index: Integer): TXMLDataBindingSchema; function GetSchemas(Index: Integer): TXMLDataBindingSchema;
protected protected
@ -83,6 +86,8 @@ type
property SourceFileName: String read FSourceFileName write FSourceFileName; property SourceFileName: String read FSourceFileName write FSourceFileName;
property SchemaCount: Integer read GetSchemaCount; property SchemaCount: Integer read GetSchemaCount;
property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas; property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas;
protected
procedure DoPostProcessItem(AItem: TXMLDataBindingItem);
public public
constructor Create(); constructor Create();
destructor Destroy(); override; destructor Destroy(); override;
@ -93,6 +98,8 @@ type
property IncludePaths: TStrings read FIncludePaths; property IncludePaths: TStrings read FIncludePaths;
property OutputType: TXMLDataBindingOutputType read FOutputType write FOutputType; property OutputType: TXMLDataBindingOutputType read FOutputType write FOutputType;
property OutputPath: String read FOutputPath write FOutputPath; property OutputPath: String read FOutputPath write FOutputPath;
property OnPostProcessItem: TXMLDataBindingPostProcessItemEvent read FOnPostProcessItem write FOnPostProcessItem;
end; end;
@ -160,7 +167,6 @@ type
protected protected
function GetItemType(): TXMLDataBindingItemType; virtual; abstract; function GetItemType(): TXMLDataBindingItemType; virtual; abstract;
procedure SetName(const Value: String); procedure SetName(const Value: String);
procedure SetTranslatedName(const Value: string);
property SchemaItem: IXMLSchemaItem read FSchemaItem; property SchemaItem: IXMLSchemaItem read FSchemaItem;
public public
@ -173,7 +179,7 @@ type
property HasDocumentation: Boolean read GetHasDocumentation; property HasDocumentation: Boolean read GetHasDocumentation;
property ItemType: TXMLDataBindingItemType read GetItemType; property ItemType: TXMLDataBindingItemType read GetItemType;
property Name: String read FName; property Name: String read FName;
property TranslatedName: String read FTranslatedName; property TranslatedName: String read FTranslatedName write FTranslatedName;
property CollectionItem: TXMLDataBindingProperty read FCollectionItem write FCollectionItem; property CollectionItem: TXMLDataBindingProperty read FCollectionItem write FCollectionItem;
property IsCollection: Boolean read GetIsCollection; property IsCollection: Boolean read GetIsCollection;
@ -611,8 +617,8 @@ begin
ASchema.AddItem(interfaceItem); ASchema.AddItem(interfaceItem);
for elementIndex := 0 to Pred(complexType.ElementDefs.Count) do for elementIndex := 0 to Pred(complexType.ElementDefList.Count) do
ProcessChildElement(ASchema, complexType.ElementDefs[elementIndex], interfaceItem); ProcessChildElement(ASchema, complexType.ElementDefList[elementIndex], interfaceItem);
end; end;
end; end;
@ -681,12 +687,12 @@ end;
function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem;
var var
elementIndex: Integer;
attributeIndex: Integer; attributeIndex: Integer;
enumerationObject: TXMLDataBindingEnumeration; enumerationObject: TXMLDataBindingEnumeration;
interfaceObject: TXMLDataBindingInterface; interfaceObject: TXMLDataBindingInterface;
complexAliasItem: TXMLDataBindingComplexTypeAliasItem; complexAliasItem: TXMLDataBindingComplexTypeAliasItem;
simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem;
elementIndex: Integer;
begin begin
Result := nil; Result := nil;
@ -1161,7 +1167,8 @@ var
begin begin
{ Translate name } { Translate name }
AItem.SetTranslatedName(TranslateItemName(AItem)); AItem.TranslatedName := TranslateItemName(AItem);
DoPostProcessItem(AItem);
{ Extract collections } { Extract collections }
@ -1252,6 +1259,13 @@ begin
end; end;
procedure TXMLDataBindingGenerator.DoPostProcessItem(AItem: TXMLDataBindingItem);
begin
if Assigned(FOnPostProcessItem) then
FOnPostProcessItem(Self, AItem);
end;
{ TXMLDataBindingGeneratorItem } { TXMLDataBindingGeneratorItem }
constructor TXMLDataBindingGeneratorItem.Create(AOwner: TXMLDataBindingGenerator); constructor TXMLDataBindingGeneratorItem.Create(AOwner: TXMLDataBindingGenerator);
begin begin
@ -1405,12 +1419,6 @@ begin
end; end;
procedure TXMLDataBindingItem.SetTranslatedName(const Value: string);
begin
FTranslatedName := Value;
end;
{ TXMLDataBindingInterface } { TXMLDataBindingInterface }
constructor TXMLDataBindingInterface.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); constructor TXMLDataBindingInterface.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String);
begin begin

View File

@ -8,7 +8,9 @@ uses
XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas',
DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas', DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.pas',
XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas', XMLDataBindingHelpers in 'Units\XMLDataBindingHelpers.pas',
DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas'; DelphiXMLDataBindingResources in 'Units\DelphiXMLDataBindingResources.pas',
DataBindingSettingsXML in 'Units\DataBindingSettingsXML.pas',
DataBindingHintsXML in 'Units\DataBindingHintsXML.pas';
{$R *.res} {$R *.res}

View File

@ -100,7 +100,7 @@ Conditionals=
DebugSourceDirs= DebugSourceDirs=
UsePackages=0 UsePackages=0
[Parameters] [Parameters]
RunParams="Z:\SAM\Mitsubishi\Copernica\Koppelingbeschijving.xsd" "C:\Temp\Koppelingbeschrijving.pas" RunParams="P:\test\XMLDataBinding\XSD\DataBindingSettings.xsd" "P:\test\XMLDataBinding\Units\DataBindingSettingsXML.pas"
HostApplication= HostApplication=
Launcher= Launcher=
UseLauncher=0 UseLauncher=0

34
XSD/DataBindingHints.xsd Normal file
View File

@ -0,0 +1,34 @@
<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
<xs:element name="DataBindingHints">
<xs:annotation>
<xs:documentation>Contains hints and mappings for the data binding output</xs:documentation>
</xs:annotation>
<xs:complexType>
<xs:sequence>
<xs:element name="Enumerations" minOccurs="0">
<xs:complexType>
<xs:sequence>
<xs:element name="Enumeration" minOccurs="0" maxOccurs="unbounded">
<xs:complexType>
<xs:sequence>
<xs:element name="Member" minOccurs="0" maxOccurs="unbounded">
<xs:complexType>
<xs:simpleContent>
<xs:extension base="xs:string">
<xs:attribute name="Name" type="xs:string" use="required"/>
</xs:extension>
</xs:simpleContent>
</xs:complexType>
</xs:element>
</xs:sequence>
<xs:attribute name="Name" type="xs:string" use="required"/>
</xs:complexType>
</xs:element>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:schema>

View File

@ -0,0 +1,48 @@
<?xml version="1.0" encoding="UTF-8"?>
<xs:schema xmlns:xs="http://www.w3.org/2001/XMLSchema" elementFormDefault="qualified" attributeFormDefault="unqualified">
<xs:element name="DataBindingSettings">
<xs:annotation>
<xs:documentation>Contains the settings and hints for the Delphi XML Data Binding.</xs:documentation>
</xs:annotation>
<xs:complexType>
<xs:sequence>
<xs:element name="Output" type="DataBindingOutput" minOccurs="0"/>
</xs:sequence>
</xs:complexType>
</xs:element>
<xs:complexType name="DataBindingOutput">
<xs:annotation>
<xs:documentation>Contains the user-defined output settings last used</xs:documentation>
</xs:annotation>
<xs:sequence>
<xs:element name="OutputType" type="DataBindingOutputType"/>
<xs:choice>
<xs:element name="OutputSingle">
<xs:complexType>
<xs:sequence>
<xs:element name="FileName" type="xs:string"/>
</xs:sequence>
</xs:complexType>
</xs:element>
<xs:element name="OutputMultiple">
<xs:complexType>
<xs:sequence>
<xs:element name="Path" type="xs:string"/>
<xs:element name="Prefix" type="xs:string"/>
<xs:element name="Postfix" type="xs:string"/>
</xs:sequence>
</xs:complexType>
</xs:element>
</xs:choice>
</xs:sequence>
</xs:complexType>
<xs:simpleType name="DataBindingOutputType">
<xs:annotation>
<xs:documentation>Determines the output type</xs:documentation>
</xs:annotation>
<xs:restriction base="xs:NMTOKEN">
<xs:enumeration value="Single"/>
<xs:enumeration value="Multiple"/>
</xs:restriction>
</xs:simpleType>
</xs:schema>