Finished NamedFormat conversion
This commit is contained in:
parent
3c09f6c331
commit
4f8751632a
@ -73,10 +73,8 @@ const
|
|||||||
);
|
);
|
||||||
|
|
||||||
|
|
||||||
PrefixInterface2 = 'IXML';
|
PrefixInterface = 'IXML';
|
||||||
PrefixClass2 = 'TXML';
|
PrefixClass = 'TXML';
|
||||||
PrefixOptional2 = 'Has';
|
|
||||||
PostfixText2 = 'Text';
|
|
||||||
|
|
||||||
|
|
||||||
InterfaceItemForward = ' IXML%Name:s = interface;';
|
InterfaceItemForward = ' IXML%Name:s = interface;';
|
||||||
@ -91,11 +89,6 @@ const
|
|||||||
ItemClass = 'TXMLNode';
|
ItemClass = 'TXMLNode';
|
||||||
|
|
||||||
|
|
||||||
MemberPropertyGet = ' function Get%Name:s: %DataType:s;';
|
|
||||||
MemberPropertySet = ' procedure Set%Name:s(const Value: %DataType:s);';
|
|
||||||
MemberProperty = ' property %Name:s: %DataType:s read Get%Name:s write Set%Name:s;';
|
|
||||||
MemberPropertyReadOnly = ' property %Name:s: %DataType:s read Get%Name:s;';
|
|
||||||
|
|
||||||
|
|
||||||
// #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 ?
|
||||||
@ -324,32 +317,6 @@ end;
|
|||||||
|
|
||||||
|
|
||||||
procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection);
|
procedure TDelphiXMLDataBindingGenerator.WriteDocumentFunctions(AStream: TStreamHelper; ASection: TDelphiXMLSection);
|
||||||
|
|
||||||
procedure WriteFunction(const AItemName, AFunction, AImplementation: String; const AVariables: String = '');
|
|
||||||
begin
|
|
||||||
if ASection = dxsInterface then
|
|
||||||
AStream.Write(' ');
|
|
||||||
|
|
||||||
AStream.WriteLnNamedFmt('function ' + AFunction + ': IXML%Name:s;',
|
|
||||||
['Name', AItemName]);
|
|
||||||
|
|
||||||
if ASection = dxsImplementation then
|
|
||||||
begin
|
|
||||||
if Length(AVariables) > 0 then
|
|
||||||
begin
|
|
||||||
AStream.WriteLn('var');
|
|
||||||
AStream.WriteLn(AVariables);
|
|
||||||
AStream.WriteLn();
|
|
||||||
end;
|
|
||||||
|
|
||||||
AStream.WriteLn('begin');
|
|
||||||
AStream.WriteLn(AImplementation);
|
|
||||||
AStream.WriteLn('end;');
|
|
||||||
AStream.WriteLn();
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
var
|
var
|
||||||
schemaIndex: Integer;
|
schemaIndex: Integer;
|
||||||
schema: TXMLDataBindingSchema;
|
schema: TXMLDataBindingSchema;
|
||||||
@ -380,32 +347,63 @@ begin
|
|||||||
begin
|
begin
|
||||||
if ASection = dxsInterface then
|
if ASection = dxsInterface then
|
||||||
AStream.Write(' ');
|
AStream.Write(' ');
|
||||||
|
|
||||||
AStream.WriteLn('{ Document functions }');
|
AStream.WriteLn('{ Document functions }');
|
||||||
hasItem := True;
|
hasItem := True;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
docBinding := NamedFormat('GetDocBinding(''%Name:s'', TXML%Name:s, TargetNamespace) as IXML%Name:s',
|
docBinding := NamedFormat('GetDocBinding(''%SourceName:s'', TXML%Name:s, TargetNamespace) as IXML%Name:s',
|
||||||
['Name', interfaceItem.TranslatedName]);
|
['SourceName', interfaceItem.Name,
|
||||||
|
'Name', interfaceItem.TranslatedName]);
|
||||||
|
|
||||||
WriteFunction(interfaceItem.TranslatedName,
|
|
||||||
'Get%Name:s(ADocument: IXMLDocument)',
|
|
||||||
' Result := ADocument.' + docBinding);
|
|
||||||
|
|
||||||
WriteFunction(interfaceItem.TranslatedName,
|
with TNamedFormatStringList.Create() do
|
||||||
'Load%Name:s(const AFileName: String)',
|
try
|
||||||
' Result := LoadXMLDocument(AFileName).' + docBinding);
|
case ASection of
|
||||||
|
dxsInterface:
|
||||||
|
begin
|
||||||
|
Add(' function Get%Name:s(ADocument: IXMLDocument): IXML%Name:s;');
|
||||||
|
Add(' function Load%Name:s(const AFileName: String): IXML%Name:s;');
|
||||||
|
Add(' function Load%Name:sFromStream(AStream: TStream): IXML%Name:s;');
|
||||||
|
Add(' function New%Name:s: IXML%Name:s;');
|
||||||
|
end;
|
||||||
|
dxsImplementation:
|
||||||
|
begin
|
||||||
|
Add('function Get%Name:s(ADocument: IXMLDocument): IXML%Name:s;');
|
||||||
|
Add('begin');
|
||||||
|
Add(' Result := ADocument.' + docBinding);
|
||||||
|
Add('end;');
|
||||||
|
AddLn;
|
||||||
|
|
||||||
WriteFunction(interfaceItem.TranslatedName,
|
Add('function Load%Name:s(const AFileName: String): IXML%Name:s;');
|
||||||
'Load%Name:sFromStream(AStream: TStream)',
|
Add('begin');
|
||||||
' doc := NewXMLDocument;'#13#10 +
|
Add(' Result := LoadXMLDocument(AFileName).' + docBinding);
|
||||||
' doc.LoadFromStream(AStream);'#13#10 +
|
Add('end;');
|
||||||
' Result := Get%Name:s(doc);',
|
AddLn;
|
||||||
' doc: IXMLDocument;');
|
|
||||||
|
|
||||||
WriteFunction(interfaceItem.TranslatedName,
|
Add('function Load%Name:sFromStream(AStream: TStream): IXML%Name:s;');
|
||||||
'New%Name:s',
|
Add('var');
|
||||||
' Result := NewXMLDocument.' + docBinding);
|
Add(' doc: IXMLDocument;');
|
||||||
|
AddLn;
|
||||||
|
Add('begin');
|
||||||
|
Add(' doc := NewXMLDocument;');
|
||||||
|
Add(' doc.LoadFromStream(AStream);');
|
||||||
|
Add(' Result := Get%Name:s(doc);');
|
||||||
|
Add('end;');
|
||||||
|
AddLn;
|
||||||
|
|
||||||
|
Add('function New%Name:s: IXML%Name:s;');
|
||||||
|
Add('begin');
|
||||||
|
Add(' Result := NewXMLDocument.' + docBinding);
|
||||||
|
Add('end;');
|
||||||
|
AddLn;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
AStream.Write(Format(['Name', interfaceItem.TranslatedName]));
|
||||||
|
finally
|
||||||
|
Free();
|
||||||
|
end;
|
||||||
|
|
||||||
AStream.WriteLn();
|
AStream.WriteLn();
|
||||||
end;
|
end;
|
||||||
@ -517,7 +515,7 @@ begin
|
|||||||
dxsInterface:
|
dxsInterface:
|
||||||
begin
|
begin
|
||||||
if Assigned(AItem.BaseItem) then
|
if Assigned(AItem.BaseItem) then
|
||||||
parent := PrefixInterface2 + AItem.BaseItem.TranslatedName
|
parent := PrefixInterface + AItem.BaseItem.TranslatedName
|
||||||
else
|
else
|
||||||
parent := ItemInterface;
|
parent := ItemInterface;
|
||||||
|
|
||||||
@ -535,7 +533,7 @@ begin
|
|||||||
dxsClass:
|
dxsClass:
|
||||||
begin
|
begin
|
||||||
if Assigned(AItem.BaseItem) then
|
if Assigned(AItem.BaseItem) then
|
||||||
parent := PrefixClass2 + AItem.BaseItem.TranslatedName
|
parent := PrefixClass + AItem.BaseItem.TranslatedName
|
||||||
else
|
else
|
||||||
parent := ItemClass;
|
parent := ItemClass;
|
||||||
|
|
||||||
@ -617,17 +615,18 @@ var
|
|||||||
itemProperty: TXMLDataBindingProperty;
|
itemProperty: TXMLDataBindingProperty;
|
||||||
propertyItem: TXMLDataBindingItem;
|
propertyItem: TXMLDataBindingItem;
|
||||||
dataTypeName: String;
|
dataTypeName: String;
|
||||||
propertyFormat: String;
|
|
||||||
optionalFormat: String;
|
|
||||||
writeOptional: Boolean;
|
writeOptional: Boolean;
|
||||||
writeTextProp: Boolean;
|
writeTextProp: Boolean;
|
||||||
hasMembers: Boolean;
|
hasMembers: Boolean;
|
||||||
localHasMembers: Boolean;
|
localHasMembers: Boolean;
|
||||||
member: TDelphiXMLMember;
|
member: TDelphiXMLMember;
|
||||||
value: String;
|
value: String;
|
||||||
|
sourceCode: TNamedFormatStringList;
|
||||||
|
propertyItemName: String;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
// #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties
|
// #ToDo1 (MvR) 9-3-2008: refactor WriteSchemaInterfaceProperties
|
||||||
|
// #ToDo1 (MvR) 17-3-2008: support conversions!
|
||||||
if ASection = dxsForward then
|
if ASection = dxsForward then
|
||||||
Exit;
|
Exit;
|
||||||
|
|
||||||
@ -643,6 +642,7 @@ begin
|
|||||||
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
|
for propertyIndex := 0 to Pred(AItem.PropertyCount) do
|
||||||
begin
|
begin
|
||||||
itemProperty := AItem.Properties[propertyIndex];
|
itemProperty := AItem.Properties[propertyIndex];
|
||||||
|
propertyItem := nil;
|
||||||
dataTypeName := '';
|
dataTypeName := '';
|
||||||
writeTextProp := False;
|
writeTextProp := False;
|
||||||
writeOptional := True;
|
writeOptional := True;
|
||||||
@ -658,13 +658,13 @@ begin
|
|||||||
begin
|
begin
|
||||||
if propertyItem.ItemType = itEnumeration then
|
if propertyItem.ItemType = itEnumeration then
|
||||||
begin
|
begin
|
||||||
dataTypeName := PrefixClass2;
|
dataTypeName := PrefixClass;
|
||||||
writeTextProp := True;
|
writeTextProp := True;
|
||||||
end else
|
end else
|
||||||
dataTypeName := PrefixInterface2;
|
dataTypeName := PrefixInterface;
|
||||||
|
|
||||||
{ Collections have a Count property, no need to write a
|
{ Collections have a Count property, no need to write a
|
||||||
HasX property as well. }
|
HasX property as well. }
|
||||||
writeOptional := (propertyItem.ItemType <> itCollection);
|
writeOptional := (propertyItem.ItemType <> itCollection);
|
||||||
|
|
||||||
dataTypeName := dataTypeName + propertyItem.TranslatedName;
|
dataTypeName := dataTypeName + propertyItem.TranslatedName;
|
||||||
@ -675,186 +675,176 @@ begin
|
|||||||
|
|
||||||
if Length(dataTypeName) > 0 then
|
if Length(dataTypeName) > 0 then
|
||||||
begin
|
begin
|
||||||
if writeOptional then
|
writeOptional := writeOptional and
|
||||||
writeOptional := itemProperty.IsOptional and
|
itemProperty.IsOptional and
|
||||||
(member in [dxmPropertyGet, dxmPropertyDeclaration]);
|
(member in [dxmPropertyGet, dxmPropertyDeclaration]);
|
||||||
|
|
||||||
case ASection of
|
|
||||||
dxsInterface,
|
|
||||||
dxsClass:
|
|
||||||
begin
|
|
||||||
{ Interface declaration }
|
|
||||||
propertyFormat := '';
|
|
||||||
optionalFormat := '';
|
|
||||||
|
|
||||||
case member of
|
|
||||||
dxmPropertyGet:
|
|
||||||
begin
|
|
||||||
propertyFormat := MemberPropertyGet;
|
|
||||||
optionalFormat := propertyFormat;
|
|
||||||
end;
|
|
||||||
|
|
||||||
dxmPropertySet:
|
|
||||||
if not itemProperty.IsReadOnly then
|
|
||||||
begin
|
|
||||||
propertyFormat := MemberPropertySet;
|
|
||||||
optionalFormat := '';
|
|
||||||
end;
|
|
||||||
|
|
||||||
dxmPropertyDeclaration:
|
|
||||||
begin
|
|
||||||
if itemProperty.IsReadOnly then
|
|
||||||
propertyFormat := MemberPropertyReadOnly
|
|
||||||
else
|
|
||||||
propertyFormat := MemberProperty;
|
|
||||||
|
|
||||||
optionalFormat := MemberPropertyReadOnly;
|
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
if Length(propertyFormat) > 0 then
|
sourceCode := TNamedFormatStringList.Create();
|
||||||
|
try
|
||||||
|
case ASection of
|
||||||
|
dxsInterface,
|
||||||
|
dxsClass:
|
||||||
begin
|
begin
|
||||||
|
{ Interface declaration }
|
||||||
if not hasMembers then
|
if not hasMembers then
|
||||||
begin
|
begin
|
||||||
if ASection = dxsClass then
|
if ASection = dxsClass then
|
||||||
AStream.WriteLn(' protected');
|
AStream.WriteLn(' protected');
|
||||||
end else if not localHasMembers then
|
end else if not localHasMembers then
|
||||||
AStream.WriteLn();
|
AStream.WriteLn();
|
||||||
|
|
||||||
|
|
||||||
if writeOptional then
|
case member of
|
||||||
AStream.WriteLnNamedFmt(optionalFormat,
|
dxmPropertyGet:
|
||||||
['Name', PrefixOptional2 + itemProperty.TranslatedName,
|
begin
|
||||||
'DataType', 'Boolean']);
|
if writeOptional then
|
||||||
|
sourceCode.Add(' function GetHas%Name:s: Boolean;');
|
||||||
|
|
||||||
|
if writeTextProp then
|
||||||
|
sourceCode.Add(' function Get%Name:sText: WideString;');
|
||||||
|
|
||||||
|
sourceCode.Add(' function Get%Name:s: %DataType:s;');
|
||||||
|
end;
|
||||||
|
|
||||||
|
dxmPropertySet:
|
||||||
|
if not itemProperty.IsReadOnly then
|
||||||
|
begin
|
||||||
|
if writeTextProp then
|
||||||
|
sourceCode.Add(' procedure Set%Name:sText(const Value: WideString);');
|
||||||
|
|
||||||
|
sourceCode.Add(' procedure Set%Name:s(const Value: %DataType:s);');
|
||||||
|
end;
|
||||||
|
|
||||||
|
dxmPropertyDeclaration:
|
||||||
|
begin
|
||||||
|
if writeOptional then
|
||||||
|
sourceCode.Add(' property Has%Name:s: Boolean read GetHas%Name:s;');
|
||||||
|
|
||||||
|
if writeTextProp then
|
||||||
|
sourceCode.Add(' property %Name:sText: WideString read Get%Name:sText;');
|
||||||
|
|
||||||
|
if itemProperty.IsReadOnly then
|
||||||
|
sourceCode.Add(' property %Name:s: %DataType:s read Get%Name:s;')
|
||||||
|
else
|
||||||
|
sourceCode.Add(' property %Name:s: %DataType:s read Get%Name:s write Set%Name:s;');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
if writeTextProp then
|
|
||||||
AStream.WriteLnNamedFmt(propertyFormat,
|
|
||||||
['Name', itemProperty.TranslatedName + PostfixText2,
|
|
||||||
'DataType', 'WideString']);
|
|
||||||
|
|
||||||
AStream.WriteLnNamedFmt(propertyFormat,
|
|
||||||
['Name', itemProperty.TranslatedName,
|
|
||||||
'DataType', dataTypeName]);
|
|
||||||
hasMembers := True;
|
hasMembers := True;
|
||||||
localHasMembers := True;
|
localHasMembers := True;
|
||||||
end;
|
end;
|
||||||
end;
|
dxsImplementation:
|
||||||
dxsImplementation:
|
begin
|
||||||
begin
|
{ Implementation }
|
||||||
{ Implementation }
|
case member of
|
||||||
case member of
|
dxmPropertyGet:
|
||||||
dxmPropertyGet:
|
|
||||||
begin
|
|
||||||
// #ToDo3 (MvR) 7-3-2008: extract strings
|
|
||||||
if writeOptional then
|
|
||||||
begin
|
begin
|
||||||
AStream.WriteLnNamedFmt('function TXML%Name:s.GetHas%PropertyName:s: Boolean;',
|
if writeOptional then
|
||||||
['Name', AItem.TranslatedName,
|
begin
|
||||||
'PropertyName', itemProperty.TranslatedName]);
|
sourceCode.Add('function TXML%Name:s.GetHas%PropertyName:s: Boolean;');
|
||||||
AStream.WriteLn('begin');
|
sourceCode.Add('begin');
|
||||||
AStream.WriteLnFmt(' Result := Assigned(ChildNodes.FindNode(''%s''));', [itemProperty.Name]);
|
sourceCode.Add(' Result := Assigned(ChildNodes.FindNode(''%PropertySourceName:s''));');
|
||||||
AStream.WriteLn('end;');
|
sourceCode.Add('end;');
|
||||||
AStream.WriteLn();
|
sourceCode.AddLn;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
|
||||||
if writeTextProp then
|
if writeTextProp then
|
||||||
begin
|
begin
|
||||||
AStream.WriteLnNamedFmt('function TXML%Name:s.Get%PropertyName:sText: WideString;',
|
sourceCode.Add('function TXML%Name:s.Get%PropertyName:sText: WideString;');
|
||||||
['Name', AItem.TranslatedName,
|
sourceCode.Add('begin');
|
||||||
'PropertyName', itemProperty.TranslatedName]);
|
sourceCode.Add(' Result := ChildNodes[''%PropertySourceName:s''].NodeValue;');
|
||||||
AStream.WriteLn('begin');
|
sourceCode.Add('end;');
|
||||||
AStream.WriteLnFmt(' Result := ChildNodes[''%s''].NodeValue;', [itemProperty.Name]);
|
sourceCode.AddLn;
|
||||||
AStream.WriteLn('end;');
|
end;
|
||||||
AStream.WriteLn();
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
AStream.WriteLnNamedFmt('function TXML%Name:s.Get%PropertyName:s: %DataType:s;',
|
sourceCode.Add('function TXML%Name:s.Get%PropertyName:s: %DataType:s;');
|
||||||
['Name', AItem.TranslatedName,
|
|
||||||
'PropertyName', itemProperty.TranslatedName,
|
|
||||||
'DataType', dataTypeName]);
|
|
||||||
|
|
||||||
case itemProperty.PropertyType of
|
case itemProperty.PropertyType of
|
||||||
ptSimple:
|
ptSimple:
|
||||||
begin
|
begin
|
||||||
AStream.WriteLn('begin');
|
sourceCode.Add('begin');
|
||||||
AStream.WriteLnFmt(' Result := ChildNodes[''%s''].NodeValue;', [itemProperty.Name]);
|
sourceCode.Add(' Result := ChildNodes[''%PropertySourceName:s''].NodeValue;');
|
||||||
end;
|
sourceCode.Add('end;');
|
||||||
|
|
||||||
ptItem:
|
|
||||||
begin
|
|
||||||
propertyItem := TXMLDataBindingItemProperty(itemProperty).Item;
|
|
||||||
|
|
||||||
case propertyItem.ItemType of
|
|
||||||
itInterface,
|
|
||||||
itCollection:
|
|
||||||
begin
|
|
||||||
AStream.WriteLn('begin');
|
|
||||||
AStream.WriteLnNamedFmt(' Result := (ChildNodes[''%Name:s''] as IXML%DataType:s);',
|
|
||||||
['Name', itemProperty.Name,
|
|
||||||
'DataType', propertyItem.TranslatedName]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
itEnumeration:
|
|
||||||
begin
|
|
||||||
AStream.WriteLn( 'var');
|
|
||||||
AStream.WriteLn( ' nodeValue: WideString;');
|
|
||||||
AStream.WriteLnFmt(' enumValue: %s;', [dataTypeName]);
|
|
||||||
AStream.WriteLn();
|
|
||||||
AStream.WriteLn( 'begin');
|
|
||||||
AStream.WriteLnFmt(' Result := %s(-1);', [dataTypeName]);
|
|
||||||
AStream.WriteLnFmt(' nodeValue := Get%sText;', [itemProperty.TranslatedName]);
|
|
||||||
AStream.WriteLnFmt(' for enumValue := Low(%0:s) to High(%0:s) do', [dataTypeName]);
|
|
||||||
AStream.WriteLnFmt(' if %sValues[enumValue] = nodeValue then', [propertyItem.TranslatedName]);
|
|
||||||
AStream.WriteLn( ' begin');
|
|
||||||
AStream.WriteLn( ' Result := enumValue;');
|
|
||||||
AStream.WriteLn( ' break;');
|
|
||||||
AStream.WriteLn( ' end;');
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
end;
|
|
||||||
end;
|
|
||||||
|
|
||||||
AStream.WriteLn('end;');
|
ptItem:
|
||||||
AStream.WriteLn();
|
begin
|
||||||
end;
|
if Assigned(propertyItem) then
|
||||||
dxmPropertySet:
|
begin
|
||||||
if not itemProperty.IsReadOnly then
|
case propertyItem.ItemType of
|
||||||
begin
|
itInterface,
|
||||||
if writeTextProp then
|
itCollection:
|
||||||
|
begin
|
||||||
|
sourceCode.Add('begin');
|
||||||
|
sourceCode.Add(' Result := (ChildNodes[''%Name:s''] as IXML%PropertyItemName:s);');
|
||||||
|
sourceCode.Add('end;');
|
||||||
|
end;
|
||||||
|
|
||||||
|
itEnumeration:
|
||||||
|
begin
|
||||||
|
sourceCode.Add('var');
|
||||||
|
sourceCode.Add(' nodeValue: WideString;');
|
||||||
|
sourceCode.Add(' enumValue: %DataType:s;');
|
||||||
|
sourceCode.AddLn;
|
||||||
|
sourceCode.Add('begin');
|
||||||
|
sourceCode.Add(' Result := %DataType:s(-1);');
|
||||||
|
sourceCode.Add(' nodeValue := Get%PropertyName:sText;');
|
||||||
|
sourceCode.Add(' for enumValue := Low(%DataType:s) to High(%DataType:s) do');
|
||||||
|
sourceCode.Add(' if %PropertyName:sValues[enumValue] = nodeValue then');
|
||||||
|
sourceCode.Add(' begin');
|
||||||
|
sourceCode.Add(' Result := enumValue;');
|
||||||
|
sourceCode.Add(' break;');
|
||||||
|
sourceCode.Add(' end;');
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
sourceCode.AddLn;
|
||||||
|
end;
|
||||||
|
dxmPropertySet:
|
||||||
|
if not itemProperty.IsReadOnly then
|
||||||
begin
|
begin
|
||||||
// #ToDo1 (MvR) 15-3-2008: hier was ik
|
if writeTextProp then
|
||||||
AStream.WriteLnFmt('procedure %0:s%1:s.Set%2:s%3:s(const Value: WideString);',
|
begin
|
||||||
[PrefixClass,
|
sourceCode.Add('procedure TXML%Name:s.Set%PropertyName:sText(const Value: WideString);');
|
||||||
AItem.TranslatedName,
|
sourceCode.Add('begin');
|
||||||
itemProperty.TranslatedName,
|
sourceCode.Add(' ChildNodes[''%PropertySourceName:s''].NodeValue := Value;');
|
||||||
PostfixText]);
|
sourceCode.Add('end;');
|
||||||
AStream.WriteLn('begin');
|
sourceCode.AddLn;
|
||||||
AStream.WriteLnFmt(' ChildNodes[''%s''].NodeValue := Value;', [itemProperty.Name]);
|
end;
|
||||||
AStream.WriteLn('end;');
|
|
||||||
AStream.WriteLn();
|
if Assigned(propertyItem) and (propertyItem.ItemType = itEnumeration) then
|
||||||
|
value := '%PropertyItemName:sValues[Value]'
|
||||||
|
else
|
||||||
|
value := 'Value';
|
||||||
|
|
||||||
|
sourceCode.Add('procedure TXML%Name:s.Set%PropertyName:s(const Value: %DataType:s);');
|
||||||
|
sourceCode.Add('begin');
|
||||||
|
sourceCode.Add(' ChildNodes[''%PropertySourceName:s''].NodeValue := ' + value + ';');
|
||||||
|
sourceCode.Add('end;');
|
||||||
|
sourceCode.AddLn;
|
||||||
end;
|
end;
|
||||||
|
end;
|
||||||
if (itemProperty.PropertyType = ptItem) and
|
|
||||||
(TXMLDataBindingItemProperty(itemProperty).Item.ItemType = itEnumeration) then
|
|
||||||
value := NamedFormat('%Name:sValues[Value]',
|
|
||||||
['Name', TXMLDataBindingItemProperty(itemProperty).Item.TranslatedName])
|
|
||||||
else
|
|
||||||
value := 'Value';
|
|
||||||
|
|
||||||
AStream.WriteLnFmt('procedure %0:s%1:s.Set%2:s(const Value: %3:s);',
|
|
||||||
[PrefixClass,
|
|
||||||
AItem.TranslatedName,
|
|
||||||
itemProperty.TranslatedName,
|
|
||||||
dataTypeName]);
|
|
||||||
AStream.WriteLn('begin');
|
|
||||||
AStream.WriteLnFmt(' ChildNodes[''%0s''].NodeValue := %1:s;', [itemProperty.Name, value]);
|
|
||||||
AStream.WriteLn('end;');
|
|
||||||
AStream.WriteLn();
|
|
||||||
end;
|
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
propertyItemName := '';
|
||||||
|
if Assigned(propertyItem) then
|
||||||
|
propertyItemName := propertyItem.TranslatedName;
|
||||||
|
|
||||||
|
AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName,
|
||||||
|
'PropertySourceName', itemProperty.Name,
|
||||||
|
'PropertyName', itemProperty.TranslatedName,
|
||||||
|
'PropertyItemName', propertyItemName,
|
||||||
|
'DataType', dataTypeName]));
|
||||||
|
finally
|
||||||
|
FreeAndNil(sourceCode);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
@ -867,14 +857,20 @@ end;
|
|||||||
|
|
||||||
procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollection(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
||||||
begin
|
begin
|
||||||
|
if not Assigned(AItem.CollectionItem) then
|
||||||
|
Exit;
|
||||||
|
|
||||||
case ASection of
|
case ASection of
|
||||||
dxsForward:
|
dxsForward:
|
||||||
AStream.WriteLnFmt(InterfaceItemForward, [AItem.TranslatedName]);
|
AStream.WriteLnNamedFmt(InterfaceItemForward,
|
||||||
|
['Name',
|
||||||
|
AItem.TranslatedName]);
|
||||||
dxsInterface:
|
dxsInterface:
|
||||||
begin
|
begin
|
||||||
AStream.WriteLnFmt(InterfaceItemInterface, [AItem.TranslatedName,
|
AStream.WriteLnNamedFmt(InterfaceItemInterface,
|
||||||
CollectionInterface]);
|
['Name', AItem.TranslatedName,
|
||||||
AStream.WriteLnFmt(' %s', [CreateNewGUID()]);
|
'ParentName', CollectionInterface]);
|
||||||
|
AStream.WriteLn(' ' + CreateNewGUID());
|
||||||
|
|
||||||
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
||||||
|
|
||||||
@ -883,8 +879,9 @@ begin
|
|||||||
end;
|
end;
|
||||||
dxsClass:
|
dxsClass:
|
||||||
begin
|
begin
|
||||||
AStream.WriteLnFmt(InterfaceItemClass, [AItem.TranslatedName,
|
AStream.WriteLnNamedFmt(InterfaceItemClass,
|
||||||
CollectionClass]);
|
['Name', AItem.TranslatedName,
|
||||||
|
'ParentName', CollectionClass]);
|
||||||
|
|
||||||
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
WriteSchemaCollectionProperties(AStream, AItem, ASection);
|
||||||
|
|
||||||
@ -902,97 +899,84 @@ end;
|
|||||||
procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
procedure TDelphiXMLDataBindingGenerator.WriteSchemaCollectionProperties(AStream: TStreamHelper; AItem: TXMLDataBindingCollection; ASection: TDelphiXMLSection);
|
||||||
var
|
var
|
||||||
dataTypeName: string;
|
dataTypeName: string;
|
||||||
|
dataIntfName: string;
|
||||||
|
sourceCode: TNamedFormatStringList;
|
||||||
procedure WriteMethodInterface(const AFunction: String);
|
|
||||||
begin
|
|
||||||
AStream.WriteLnFmt(' function ' + AFunction + ': %1:s%0:s;',
|
|
||||||
[dataTypeName,
|
|
||||||
PrefixInterface]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
procedure WriteMethodImplementation(const AFunction, AImplementation: String);
|
|
||||||
begin
|
|
||||||
AStream.WriteLnFmt('function %3:s%0:s.' + AFunction + ': %2:s%1:s;',
|
|
||||||
[AItem.TranslatedName,
|
|
||||||
dataTypeName,
|
|
||||||
PrefixInterface,
|
|
||||||
PrefixClass]);
|
|
||||||
AStream.WriteLn('begin');
|
|
||||||
|
|
||||||
AStream.WriteLnFmt(AImplementation,
|
|
||||||
[dataTypeName,
|
|
||||||
PrefixInterface]);
|
|
||||||
|
|
||||||
AStream.WriteLn('end;');
|
|
||||||
AStream.WriteLn();
|
|
||||||
end;
|
|
||||||
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if ASection = dxsClass then
|
if ASection = dxsClass then
|
||||||
AStream.WriteLn(' protected');
|
AStream.WriteLn(' protected');
|
||||||
|
|
||||||
|
// #ToDo1 (MvR) 17-3-2008: DataType for enumerations etc.
|
||||||
|
dataTypeName := PrefixInterface + AItem.CollectionItem.TranslatedName;
|
||||||
|
dataIntfName := dataTypeName;
|
||||||
|
|
||||||
case ASection of
|
sourceCode := TNamedFormatStringList.Create();
|
||||||
dxsInterface,
|
try
|
||||||
dxsClass:
|
case ASection of
|
||||||
begin
|
dxsInterface,
|
||||||
WriteMethodInterface('Get_%0:s(Index: Integer)');
|
dxsClass:
|
||||||
WriteMethodInterface('Add');
|
begin
|
||||||
WriteMethodInterface('Insert(Index: Integer)');
|
sourceCode.Add(' function Get_%ItemName:s(Index: Integer): %DataType:s;');
|
||||||
end;
|
sourceCode.Add(' function Add: %DataType:s;');
|
||||||
dxsImplementation:
|
sourceCode.Add(' function Insert(Index: Integer): %DataType:s;');
|
||||||
begin
|
end;
|
||||||
AStream.WriteLnFmt('procedure %1:s%0:s.AfterConstruction;',
|
dxsImplementation:
|
||||||
[AItem.TranslatedName,
|
begin
|
||||||
PrefixClass]);
|
sourceCode.Add('procedure TXML%Name:s.AfterConstruction;');
|
||||||
AStream.WriteLn('begin');
|
sourceCode.Add('begin');
|
||||||
|
|
||||||
AStream.WriteLnFmt(' RegisterChildNode(''%0:s'', %2:s%1:s);',
|
// #ToDo1 (MvR) 17-3-2008: DataType class / interface!!
|
||||||
[AItem.CollectionItem.Name,
|
sourceCode.Add(' RegisterChildNode(''%ItemSourceName:s'', %DataType:s);');
|
||||||
dataTypeName,
|
|
||||||
PrefixClass]);
|
|
||||||
|
|
||||||
AStream.WriteLn();
|
sourceCode.AddLn;
|
||||||
AStream.WriteLnFmt(' ItemTag := ''%0:s'';',
|
sourceCode.Add(' ItemTag := ''%ItemSourceName:s'';');
|
||||||
[AItem.CollectionItem.Name]);
|
sourceCode.Add(' ItemInterface := %DataInterface:s;');
|
||||||
|
sourceCode.AddLn;
|
||||||
AStream.WriteLnFmt(' ItemInterface := %1:s%0:s;',
|
sourceCode.Add(' inherited;');
|
||||||
[dataTypeName,
|
sourceCode.Add('end;');
|
||||||
PrefixInterface]);
|
sourceCode.AddLn;
|
||||||
|
|
||||||
AStream.WriteLn();
|
sourceCode.Add('function TXML%Name:s.Get_%ItemName:s(Index: Integer): %DataType:s;');
|
||||||
AStream.WriteLn(' inherited;');
|
sourceCode.Add('begin');
|
||||||
AStream.WriteLn('end;');
|
sourceCode.Add(' Result := (List[Index] as %DataType:s;');
|
||||||
AStream.WriteLn();
|
sourceCode.Add('end;');
|
||||||
|
sourceCode.AddLn;
|
||||||
|
|
||||||
WriteMethodImplementation('Get_%1:s(Index: Integer)',
|
sourceCode.Add('function TXML%Name:s.Add(Index: Integer): %DataType:s;');
|
||||||
' Result := (List[Index] as %1:s%0:s);');
|
sourceCode.Add('begin');
|
||||||
|
sourceCode.Add(' Result := (AddItem(-1) as %DataType:s;');
|
||||||
|
sourceCode.Add('end;');
|
||||||
|
sourceCode.AddLn;
|
||||||
|
|
||||||
WriteMethodImplementation('Add',
|
sourceCode.Add('function TXML%Name:s.Insert(Index: Integer): %DataType:s;');
|
||||||
' Result := (AddItem(-1) as %1:s%0:s);');
|
sourceCode.Add('begin');
|
||||||
|
sourceCode.Add(' Result := (AddItem(Index) as %DataType:s;');
|
||||||
|
sourceCode.Add('end;');
|
||||||
|
sourceCode.AddLn;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
WriteMethodImplementation('Insert(Index: Integer)',
|
case ASection of
|
||||||
' Result := (AddItem(Index) as %1:s%0:s);');
|
dxsInterface:
|
||||||
end;
|
begin
|
||||||
end;
|
sourceCode.AddLn;
|
||||||
|
sourceCode.Add(' property %ItemName:s[Index: Integer]: %DataType:s read Get_%ItemName:s; default;');
|
||||||
|
end;
|
||||||
|
|
||||||
case ASection of
|
dxsClass:
|
||||||
dxsInterface:
|
begin
|
||||||
begin
|
sourceCode.Add(' public');
|
||||||
AStream.WriteLn;
|
sourceCode.Add(' procedure AfterConstruction; override;');
|
||||||
AStream.WriteLnFmt(' property %0:s[Index: Integer]: %1:s%0:s read Get_%0:s; default;',
|
end;
|
||||||
[dataTypeName,
|
end;
|
||||||
PrefixInterface]);
|
|
||||||
end;
|
|
||||||
|
|
||||||
dxsClass:
|
AStream.Write(sourceCode.Format(['Name', AItem.TranslatedName,
|
||||||
begin
|
'ItemName', AItem.CollectionItem.TranslatedName,
|
||||||
AStream.WriteLn(' public');
|
'ItemSourceName', AItem.CollectionItem.Name,
|
||||||
AStream.WriteLn(' procedure AfterConstruction; override;');
|
'DataType', dataTypeName,
|
||||||
end;
|
'DataInterface', dataIntfName]));
|
||||||
|
finally
|
||||||
|
FreeAndNil(sourceCode);
|
||||||
end;
|
end;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
@ -32,9 +32,9 @@
|
|||||||
-M
|
-M
|
||||||
-$M16384,1048576
|
-$M16384,1048576
|
||||||
-K$00400000
|
-K$00400000
|
||||||
-N0"Lib"
|
-N"Lib"
|
||||||
-LE"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
|
-LE"c:\program files\borland\delphi7\Projects\Bpl"
|
||||||
-LN"C:\Documents and Settings\PsychoMark\My Documents\Borland Studio Projects\Bpl"
|
-LN"c:\program files\borland\delphi7\Projects\Bpl"
|
||||||
-w-UNSAFE_TYPE
|
-w-UNSAFE_TYPE
|
||||||
-w-UNSAFE_CODE
|
-w-UNSAFE_CODE
|
||||||
-w-UNSAFE_CAST
|
-w-UNSAFE_CAST
|
||||||
|
Loading…
Reference in New Issue
Block a user