From e4903fdb7b28bc5d5b3420f987599ea8224b2027 Mon Sep 17 00:00:00 2001 From: Mark van Renswoude Date: Tue, 22 Apr 2008 13:36:55 +0000 Subject: [PATCH] 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 --- Forms/MainFrm.dfm | Bin 2840 -> 2868 bytes Forms/MainFrm.pas | 189 +++++++++++++-- Units/DataBindingHintsXML.pas | 241 ++++++++++++++++++ Units/DataBindingSettingsXML.pas | 308 ++++++++++++++++++++++++ Units/DelphiXMLDataBindingGenerator.pas | 39 ++- Units/DelphiXMLDataBindingResources.pas | 53 ++-- Units/XMLDataBindingGenerator.pas | 36 +-- X2XMLDataBinding.dpr | 4 +- X2XMLDataBindingCmdLine.dof | 2 +- XSD/DataBindingHints.xsd | 34 +++ XSD/DataBindingSettings.xsd | 48 ++++ 11 files changed, 892 insertions(+), 62 deletions(-) create mode 100644 Units/DataBindingHintsXML.pas create mode 100644 Units/DataBindingSettingsXML.pas create mode 100644 XSD/DataBindingHints.xsd create mode 100644 XSD/DataBindingSettings.xsd diff --git a/Forms/MainFrm.dfm b/Forms/MainFrm.dfm index 63fd5c798834d866f81f758544098b244bd7c2ee..38e465cabf0f847a3d03602e4ffd8869c1c0b1ba 100644 GIT binary patch delta 90 zcmbOswna?fKNmxYucN1*n}3imgMonJL;(fHuNw_hnDm4Lit-Cmi%K$6i}n2ToHG*h i(o@+b(o%zyGg5OC5t0y@%~P2SI3}xb2~B>:s'']' + + '/Member[@Name=''%:s'']/text()'; {$R *.dfm} @@ -87,9 +108,12 @@ begin if FileExists(schemaFile) then begin - feSchema.Text := schemaFile; feFile.Text := ChangeFileExt(schemaFile, '.pas'); 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; @@ -105,6 +129,9 @@ end; procedure TMainForm.btnGenerateClick(Sender: TObject); +var + hintsFile: String; + begin if not FileExists(feSchema.Text) then begin @@ -115,24 +142,39 @@ begin Exit; end; - with TDelphiXMLDataBindingGenerator.Create() do + hintsFile := ChangeFileExt(feSchema.Text, '.hints.xml'); + if FileExists(hintsFile) then + begin + FHints := LoadDataBindingHints(hintsFile); + FHintsXPath := (FHints.OwnerDocument.DocumentElement.DOMNode as IDOMNodeSelect); + end; + try - if rbFile.Checked then - begin - OutputType := otSingle; - OutputPath := feFile.Text; - end else if rbFolder.Checked then - begin - OutputType := otMultiple; - OutputPath := deFolder.Text; + with TDelphiXMLDataBindingGenerator.Create() do + try + if rbFile.Checked then + begin + OutputType := otSingle; + OutputPath := feFile.Text; + end else if rbFolder.Checked then + begin + OutputType := otMultiple; + OutputPath := deFolder.Text; + end; + + OnPostProcessItem := PostProcessItem; + OnGetFileName := GetFileName; + Execute(feSchema.Text); + + SaveSettings(feSchema.Text); + + ShowMessage('The data binding has been generated.'); + finally + Free(); end; - - OnGetFileName := GetFileName; - Execute(feSchema.Text); - - ShowMessage('The data binding has been generated.'); finally - Free(); + FHints := nil; + FHintsXPath := nil; end; end; @@ -143,6 +185,29 @@ begin 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); begin FileName := ChangeFileExt(edtFolderPrefix.Text + FileName, @@ -174,4 +239,90 @@ begin feSchema.Text := dlgSchema.FileName; 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. + + diff --git a/Units/DataBindingHintsXML.pas b/Units/DataBindingHintsXML.pas new file mode 100644 index 0000000..a31e05f --- /dev/null +++ b/Units/DataBindingHintsXML.pas @@ -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. diff --git a/Units/DataBindingSettingsXML.pas b/Units/DataBindingSettingsXML.pas new file mode 100644 index 0000000..18e2b00 --- /dev/null +++ b/Units/DataBindingSettingsXML.pas @@ -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. diff --git a/Units/DelphiXMLDataBindingGenerator.pas b/Units/DelphiXMLDataBindingGenerator.pas index cbffb14..9a6a1d0 100644 --- a/Units/DelphiXMLDataBindingGenerator.pas +++ b/Units/DelphiXMLDataBindingGenerator.pas @@ -343,7 +343,7 @@ begin { Check for reserved words } for wordIndex := Low(ReservedWords) to High(ReservedWords) do begin - if Result = ReservedWords[wordIndex] then + if SameText(Result, ReservedWords[wordIndex]) then begin Result := '_' + Result; Break; @@ -368,7 +368,8 @@ procedure TDelphiXMLDataBindingGenerator.WriteUnitHeader(AStream: TStreamHelper; begin AStream.WriteNamedFmt(UnitHeader, ['SourceFileName', ASourceFileName, - 'UnitName', ChangeFileExt(ExtractFileName(AFileName), '')]); + 'UnitName', ChangeFileExt(ExtractFileName(AFileName), ''), + 'DateTime', DateTimeToStr(Now)]); end; @@ -569,9 +570,11 @@ var typeMapping: TTypeMapping; conversion: TTypeConversion; hasHelpers: Boolean; + hasNillable: Boolean; begin usedConversions := []; + hasNillable := False; { Determine which conversions are used } for schemaIndex := Pred(ASchemaList.Count) downto 0 do @@ -591,6 +594,9 @@ begin propertyItem := TXMLDataBindingSimpleProperty(interfaceItem.Properties[propertyIndex]); if GetDataTypeMapping(propertyItem.DataType, typeMapping) then Include(usedConversions, typeMapping.Conversion); + + if propertyItem.IsNillable then + hasNillable := True; end; end; end; @@ -614,6 +620,9 @@ begin if hasHelpers then AStream.WriteLn(); + + if hasNillable then + AStream.Write(NilElementHelpers); end; @@ -815,7 +824,7 @@ begin begin WritePrototype; AStream.WriteLnNamedFmt(' RegisterChildNode(''%:s'', TXML%:s);', - ['SourceName', itemProperty.Item.Name, + ['SourceName', propertyItem.Name, 'Name', itemProperty.Item.TranslatedName]); end; end; @@ -1085,14 +1094,11 @@ begin to check if an item is present, no need to write a HasX method. } // #ToDo3 (MvR) 14-4-2008: move first check to XMLDataBindingGenerator ? writeOptional := False; - writeNil := False; + writeNil := AProperty.IsNillable; if AMember in [dxmPropertyGet, dxmPropertyDeclaration] then - begin writeOptional := not Assigned(AProperty.Collection) and AProperty.IsOptional; - writeNil := AProperty.IsNillable; - end; dataTypeName := ''; @@ -1163,7 +1169,10 @@ begin if not AProperty.IsReadOnly then begin WriteNewLine; - + + if writeNil then + sourceCode.Add(PropertyIntfMethodSetNil); + if writeTextProp then sourceCode.Add(PropertyIntfMethodSetText); @@ -1178,17 +1187,20 @@ begin if writeOptional then sourceCode.Add(PropertyInterfaceOptional); - if writeNil then - sourceCode.Add(PropertyInterfaceNil); - if AProperty.IsReadOnly then begin + if writeNil then + sourceCode.Add(PropertyInterfaceNilReadOnly); + if writeTextProp then sourceCode.Add(PropertyInterfaceTextReadOnly); sourceCode.Add(PropertyInterfaceReadOnly); end else begin + if writeNil then + sourceCode.Add(PropertyInterfaceNil); + if writeTextProp then sourceCode.Add(PropertyInterfaceText); @@ -1261,7 +1273,10 @@ begin if not AProperty.IsReadOnly then begin WriteNewLine; - + + if writeNil then + sourceCode.Add(PropertyImplMethodSetNil); + if writeTextProp then sourceCode.Add(PropertyImplMethodSetText); diff --git a/Units/DelphiXMLDataBindingResources.pas b/Units/DelphiXMLDataBindingResources.pas index 3377256..44a8448 100644 --- a/Units/DelphiXMLDataBindingResources.pas +++ b/Units/DelphiXMLDataBindingResources.pas @@ -12,7 +12,9 @@ const CrLf = #13#10; UnitHeader = '{' + CrLf + - ' X2Software XML Data Binding Wizard' + CrLf + + ' X2Software XML Data Binding' + CrLf + + '' + CrLf + + ' Generated on: %:s' + CrLf + ' Generated from: %:s' + CrLf + '}' + CrLf + 'unit %:s;' + CrLf + @@ -73,14 +75,16 @@ const PropertyIntfMethodGetOptional = ' function GetHas%:s: Boolean;'; - PropertyIntfMethodGetNil = ' function GetIs%:sNil: Boolean;'; + PropertyIntfMethodGetNil = ' function Get%:sIsNil: Boolean;'; PropertyIntfMethodGetText = ' function Get%:sText: WideString;'; PropertyIntfMethodGet = ' function Get%:s: %:s;'; + PropertyIntfMethodSetNil = ' procedure Set%:sIsNil(const Value: Boolean);'; PropertyIntfMethodSetText = ' procedure Set%:sText(const Value: WideString);'; PropertyIntfMethodSet = ' procedure Set%:s(const Value: %:s);'; PropertyInterfaceOptional = ' property Has%:s: Boolean read GetHas%:s;'; - PropertyInterfaceNil = ' property Is%:sNil: Boolean read GetIs%:sNil;'; + PropertyInterfaceNilReadOnly = ' property %:sIsNil: Boolean read Get%:sIsNil;'; + PropertyInterfaceNil = ' property %:sIsNil: Boolean read Get%:sIsNil write Set%:sIsNil;'; PropertyInterfaceTextReadOnly = ' property %:sText: WideString read Get%:sText;'; PropertyInterfaceReadOnly = ' property %:s: %:s read Get%:s;'; PropertyInterfaceText = ' property %:sText: WideString read Get%:sText write Set%:sText;'; @@ -92,16 +96,16 @@ const 'end;' + CrLf + '' + CrLf; - PropertyImplMethodGetNil = 'function TXML%:s.GetIs%:sNil: Boolean;' + CrLf + - 'var' + CrLf + - ' childNode: IXMLNode;' + CrLf + - '' + CrLf + + PropertyImplMethodGetNil = 'function TXML%:s.Get%:sIsNil: Boolean;' + CrLf + 'begin' + CrLf + - ' childNode := ChildNodes[''%:s''];' + CrLf + - ' Result := childNode.HasAttribute(''nil'', XMLSchemaInstanceURI) and' + CrLf + - ' StrToBoolDef(childNode.GetAttributeNS(''nil'', XMLSchemaInstanceURI), False);' + CrLf + + ' Result := GetNodeIsNil(ChildNodes[''%:s'']);' + CrLf + 'end;' + CrLf + '' + CrLf; + PropertyImplMethodSetNil = 'procedure TXML%:s.Set%:sIsNil(const Value: Boolean);' + CrLf + + 'begin' + CrLf + + ' SetNodeIsNil(ChildNodes[''%:s''], Value);' + CrLf + + 'end;' + CrLf + + '' + CrLf; PropertyImplMethodGetText = 'function TXML%:s.Get%:sText: WideString;' + CrLf + 'begin' + CrLf + @@ -147,18 +151,18 @@ const // #ToDo1 (MvR) 9-3-2008: document / node / 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', - 'assembler', 'automated', 'begin', 'case', 'cdecl', 'class', - 'const', 'constructor', 'contains', 'default', 'deprecated', + 'assembler', {'automated', }'begin', 'case', 'cdecl', 'class', + 'const', 'constructor', {'contains', }'default', 'deprecated', 'destructor', 'dispid', 'dispinterface', 'div', 'do', 'downto', 'dynamic', 'else', 'end', 'except', 'export', - 'exports', 'external', 'far', 'file', 'final', 'finalization', + 'exports', 'external', 'far', {'file', 'final', }'finalization', 'finally', 'for', 'forward', 'function', 'goto', 'if', 'implementation', 'implements', 'in', 'index', 'inherited', 'initialization', 'inline', 'interface', 'is', 'label', - 'library', 'local', 'message', 'mod', 'name', 'near', + 'library', 'local', 'message', 'mod', {'name', }'near', 'nil', 'nodefault', 'not', 'object', 'of', 'or', 'out', 'overload', 'override', 'package', 'packed', 'pascal', '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 end. diff --git a/Units/XMLDataBindingGenerator.pas b/Units/XMLDataBindingGenerator.pas index 6ff221c..c3d228b 100644 --- a/Units/XMLDataBindingGenerator.pas +++ b/Units/XMLDataBindingGenerator.pas @@ -28,6 +28,7 @@ type TXMLDataBindingIterateItemsProc = procedure(AItem: TXMLDataBindingItem; AData: Pointer; var AAbort: Boolean) of object; + TXMLDataBindingPostProcessItemEvent = procedure(Sender: TObject; Item: TXMLDataBindingItem) of object; TXMLDataBindingGenerator = class(TObject) @@ -39,6 +40,8 @@ type FSchemas: TObjectList; + FOnPostProcessItem: TXMLDataBindingPostProcessItemEvent; + function GetSchemaCount(): Integer; function GetSchemas(Index: Integer): TXMLDataBindingSchema; protected @@ -83,6 +86,8 @@ type property SourceFileName: String read FSourceFileName write FSourceFileName; property SchemaCount: Integer read GetSchemaCount; property Schemas[Index: Integer]: TXMLDataBindingSchema read GetSchemas; + protected + procedure DoPostProcessItem(AItem: TXMLDataBindingItem); public constructor Create(); destructor Destroy(); override; @@ -93,6 +98,8 @@ type property IncludePaths: TStrings read FIncludePaths; property OutputType: TXMLDataBindingOutputType read FOutputType write FOutputType; property OutputPath: String read FOutputPath write FOutputPath; + + property OnPostProcessItem: TXMLDataBindingPostProcessItemEvent read FOnPostProcessItem write FOnPostProcessItem; end; @@ -160,7 +167,6 @@ type protected function GetItemType(): TXMLDataBindingItemType; virtual; abstract; procedure SetName(const Value: String); - procedure SetTranslatedName(const Value: string); property SchemaItem: IXMLSchemaItem read FSchemaItem; public @@ -173,7 +179,7 @@ type property HasDocumentation: Boolean read GetHasDocumentation; property ItemType: TXMLDataBindingItemType read GetItemType; 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 IsCollection: Boolean read GetIsCollection; @@ -408,7 +414,7 @@ begin for schemaIndex := Pred(SchemaCount) downto 0 do ResolveAlias(Schemas[schemaIndex]); - + { Resolve naming conflicts } ResolveNameConflicts(); @@ -611,8 +617,8 @@ begin ASchema.AddItem(interfaceItem); - for elementIndex := 0 to Pred(complexType.ElementDefs.Count) do - ProcessChildElement(ASchema, complexType.ElementDefs[elementIndex], interfaceItem); + for elementIndex := 0 to Pred(complexType.ElementDefList.Count) do + ProcessChildElement(ASchema, complexType.ElementDefList[elementIndex], interfaceItem); end; end; @@ -681,12 +687,12 @@ end; function TXMLDataBindingGenerator.ProcessElement(ASchema: TXMLDataBindingSchema; AElement: IXMLElementDef): TXMLDataBindingItem; var - elementIndex: Integer; attributeIndex: Integer; enumerationObject: TXMLDataBindingEnumeration; interfaceObject: TXMLDataBindingInterface; complexAliasItem: TXMLDataBindingComplexTypeAliasItem; simpleAliasItem: TXMLDataBindingSimpleTypeAliasItem; + elementIndex: Integer; begin Result := nil; @@ -1161,8 +1167,9 @@ var begin { Translate name } - AItem.SetTranslatedName(TranslateItemName(AItem)); - + AItem.TranslatedName := TranslateItemName(AItem); + DoPostProcessItem(AItem); + { Extract collections } if AItem.ItemType = itInterface then @@ -1252,6 +1259,13 @@ begin end; +procedure TXMLDataBindingGenerator.DoPostProcessItem(AItem: TXMLDataBindingItem); +begin + if Assigned(FOnPostProcessItem) then + FOnPostProcessItem(Self, AItem); +end; + + { TXMLDataBindingGeneratorItem } constructor TXMLDataBindingGeneratorItem.Create(AOwner: TXMLDataBindingGenerator); begin @@ -1405,12 +1419,6 @@ begin end; -procedure TXMLDataBindingItem.SetTranslatedName(const Value: string); -begin - FTranslatedName := Value; -end; - - { TXMLDataBindingInterface } constructor TXMLDataBindingInterface.Create(AOwner: TXMLDataBindingGenerator; ASchemaItem: IXMLSchemaItem; const AName: String); begin diff --git a/X2XMLDataBinding.dpr b/X2XMLDataBinding.dpr index a428c49..0a2baed 100644 --- a/X2XMLDataBinding.dpr +++ b/X2XMLDataBinding.dpr @@ -8,7 +8,9 @@ uses XMLDataBindingGenerator in 'Units\XMLDataBindingGenerator.pas', DelphiXMLDataBindingGenerator in 'Units\DelphiXMLDataBindingGenerator.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} diff --git a/X2XMLDataBindingCmdLine.dof b/X2XMLDataBindingCmdLine.dof index 8d20dea..530addd 100644 --- a/X2XMLDataBindingCmdLine.dof +++ b/X2XMLDataBindingCmdLine.dof @@ -100,7 +100,7 @@ Conditionals= DebugSourceDirs= UsePackages=0 [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= Launcher= UseLauncher=0 diff --git a/XSD/DataBindingHints.xsd b/XSD/DataBindingHints.xsd new file mode 100644 index 0000000..91a887c --- /dev/null +++ b/XSD/DataBindingHints.xsd @@ -0,0 +1,34 @@ + + + + + Contains hints and mappings for the data binding output + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/XSD/DataBindingSettings.xsd b/XSD/DataBindingSettings.xsd new file mode 100644 index 0000000..b5de0d0 --- /dev/null +++ b/XSD/DataBindingSettings.xsd @@ -0,0 +1,48 @@ + + + + + Contains the settings and hints for the Delphi XML Data Binding. + + + + + + + + + + Contains the user-defined output settings last used + + + + + + + + + + + + + + + + + + + + + + + + + + Determines the output type + + + + + + +