The Road to Delphi

Delphi – Free Pascal – Oxygene


2 Comments

Enabling XPath (selectNode, selectNodes) methods in Vcl and FireMonkey Apps

The TXMLDocument class allow you to manipulate XML files in VCL and FireMonkey Apps, but this class doesn’t implements a direct way to call the XPath related methods (selectNode, selectNodes) , so you must write a set of helper functions to call these methods.

Normally you can write something like so

 
function selectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  Result:=LDomNodeSelect.selectNode(nodePath);
end;

 
function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  Result:=LDomNodeSelect.selectNodes(nodePath);
end;

And use like so.

 
var
  XmlDoc: IXMLDocument;
  LNode : IDOMNode;
  i : Integer;
begin
  XmlDoc := TXMLDocument.Create(nil);
  XmlDoc.Active := True;
  XmlDoc.Options := XmlDoc.Options + [doNodeAutoIndent];
  XmlDoc.Version := '1.0';
  ...
  ...
  LNode:=selectSingleNode(XmlDoc.DOMDocument,XPathExpr);

The above code will works fine under Windows using the MSXML provider as Default DOM Vendor, but in a FireMonkey Application which must run in OSX and Windows you must set the Default DOM Vendor to ADOM (OpenXML).

 
 DefaultDOMVendor := OpenXML4Factory.Description;

Now if you try to use the above functions (selectSingleNode, SelectNodes) under the ADOM vendor you will get an awfull exception

 
EOleException Catastrophic failure 8000FFFF

The root of this issue is located in the Tox4DOMNode.selectNode and Tox4DOMNode.selectNodes implementation of these methods, check the next code.

 
function Tox4DOMNode.selectNode(const nodePath: WideString): IDOMNode;
var
  xpath: TXpathExpression;
  xdomText: TDomText;
begin
  Result := nil;
  if not Assigned(WrapperDocument) or not Assigned(WrapperDocument.WrapperDOMImpl) then
    Exit;

  xpath := WrapperDocument.WrapperDOMImpl.FXpath; //here the xpath is set with a nil value because the FXpath was no initialized  
  xpath.ContextNode := NativeNode; //Here the App crash because xpath is nil

The FXpath field is initialized in the Tox4DOMImplementation.InitParserAgent method which is never call at least which you uses the Tox4DOMImplementation.loadFromStream or Tox4DOMImplementation.loadxml methods. So to fix this issue you must call the Tox4DOMImplementation.InitParserAgent function before to call the selectNode and selectNodes methods.

 
function selectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNode(nodePath);
end;
 
function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNodes(nodePath);
end;

Now with these changes you will able to evaluate XPath expressions in VCL and FireMonkey Apps using the ADOM vendor.

This is a demo console App tested in Windows and OSX (XE2 and XE4)

 
{$APPTYPE CONSOLE}

uses
  {$IFDEF MSWINDOWS}
  System.Win.ComObj,
  Winapi.ActiveX,
  {$ENDIF}
  System.SysUtils,
  Xml.XMLIntf,
  Xml.adomxmldom,
  Xml.XMLDom,
  Xml.XMLDoc;

function selectSingleNode(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNode;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNode(nodePath);
end;

function SelectNodes(ADOMDocument: IDOMDocument; const nodePath: WideString): IDOMNodeList;
var
  LDomNodeSelect : IDomNodeSelect;
begin
  if not Assigned(ADOMDocument) or not Supports(ADOMDocument.documentElement, IDomNodeSelect, LDomNodeSelect) then
   Exit;
  //or just LDomNodeSelect:= (ADOMDocument.documentElement as IDOMNodeSelect);
  if (DefaultDOMVendor = OpenXML4Factory.Description) then
    Tox4DOMNode(LDomNodeSelect).WrapperDocument.WrapperDOMImpl.InitParserAgent;
  Result:=LDomNodeSelect.selectNodes(nodePath);
end;

procedure  TestXPath;
var
  XmlDoc: IXMLDocument;
  Root, Book, Author, Publisher : IXMLNode;
  LNodeList : IDOMNodeList;
  LNode : IDOMNode;
  i : Integer;
begin
  XmlDoc := TXMLDocument.Create(nil);
  XmlDoc.Active := True;
  XmlDoc.Options := XmlDoc.Options + [doNodeAutoIndent];
  XmlDoc.Version := '1.0';

  Root := XmlDoc.CreateNode('BookStore');
  Root.Attributes['url'] := 'http://www.amazon.com';
  XmlDoc.DocumentElement := Root;

  Book := XmlDoc.CreateNode('Book');
  Book.Attributes['Name'] := 'Steve Jobs';
  Author := XmlDoc.CreateNode('Author');
  Author.Text := 'Walter Isaacson';
  Publisher := XmlDoc.CreateNode('Publisher');
  Publisher.Text := 'Simon Schuster (October 24, 2011)';
  Root.ChildNodes.Add(Book);
  Book.ChildNodes.Add(Author);
  Book.ChildNodes.Add(Publisher);

  Book := XmlDoc.CreateNode('Book');
  Book.Attributes['Name'] := 'Clean Code: A Handbook of Agile Software Craftsmanship';
  Author := XmlDoc.CreateNode('Author');
  Author.Text := 'Robert C. Martin';
  Publisher := XmlDoc.CreateNode('Publisher');
  Publisher.Text := 'Prentice Hall; 1 edition (August 11, 2008)';
  Root.ChildNodes.Add(Book);
  Book.ChildNodes.Add(Author);
  Book.ChildNodes.Add(Publisher);

  Book := XmlDoc.CreateNode('Book');
  Book.Attributes['Name'] := 'Paradox Lost';
  Author := XmlDoc.CreateNode('Author');
  Author.Text := 'Kress, Peter';
  Publisher := XmlDoc.CreateNode('Publisher');
  Publisher.Text := 'Prentice Hall; 1 edition (February 2, 2000)';
  Root.ChildNodes.Add(Book);
  Book.ChildNodes.Add(Author);
  Book.ChildNodes.Add(Publisher);

  Writeln(XmlDoc.XML.Text);

  Writeln('selectSingleNode');
  LNode:=selectSingleNode(XmlDoc.DOMDocument,'/BookStore/Book[2]/Author["Robert C. Martin"]');
  if LNode<>nil then
   Writeln(LNode.firstChild.nodeValue);

  Writeln;

  Writeln('SelectNodes');
  LNodeList:=SelectNodes(XmlDoc.DOMDocument,'//BookStore/Book/Author');
  if LNodeList<>nil then
    for i := 0 to LNodeList.length-1 do
      Writeln(LNodeList[i].firstChild.nodeValue);
end;

begin
 try
    ReportMemoryLeaksOnShutdown:=True;
    DefaultDOMVendor := OpenXML4Factory.Description;
    {$IFDEF MSWINDOWS}CoInitialize(nil);{$ENDIF}
    try
      TestXPath;
    finally
    {$IFDEF MSWINDOWS}CoUninitialize;{$ENDIF}
    end;
 except
    {$IFDEF MSWINDOWS}
    on E:EOleException do
        Writeln(Format('EOleException %s %x', [E.Message,E.ErrorCode]));
    {$ENDIF}
    on E:Exception do
        Writeln(E.Classname, ':', E.Message);
 end;
 Writeln;
 Writeln('Press Enter to exit');
 Readln;
end.

OSXXPATH


10 Comments

Exploring Delphi XE2 – Tweaking the FireMonkey Styles

Maybe you’ve seen   articles about how use the FireMonkey Styles, and how you can set almost every aspect of a visual control, today I will go a step  forward to show how you can adjust the HSL (Hue, Saturation, and Lightness) values or a particular RGB component of the colors that belongs to a FireMonkey style.

Introduction

Fortunately the format of the styles used by FireMonkey is stored in a human readable format very similar to our old dfm format (Delphi forms), this allows us to understand how FireMonkey store, read and use these styles and of course make cool stuff with this.

Now look the next piece of a FireMonkey style and pays attention to the highlighted values

  object TRectangle
    StyleName = 'backgroundstyle'
    Position.Point = '(396,476)'
    Width = 50.000000000000000000
    Height = 50.000000000000000000
    HitTest = False
    DesignVisible = False
    Fill.Color = xFF505050
    Stroke.Kind = bkNone
  end
  object TRectangle
    StyleName = 'panelstyle'
    Position.Point = '(396,476)'
    Width = 50.000000000000000000
    Height = 50.000000000000000000
    HitTest = False
    DesignVisible = False
    Fill.Color = xFF404040
    Stroke.Kind = bkNone
    XRadius = 3.000000000000000000
    YRadius = 3.000000000000000000
  end
  object TCalloutRectangle
    StyleName = 'calloutpanelstyle'
    Position.Point = '(396,476)'
    Width = 50.000000000000000000
    Height = 50.000000000000000000
    HitTest = False
    DesignVisible = False
    Fill.Color = xFF404040
    Stroke.Kind = bkNone
    XRadius = 3.000000000000000000
    YRadius = 3.000000000000000000
    CalloutWidth = 23.000000000000000000
    CalloutLength = 11.000000000000000000
  end
      object TText
        StyleName = 'text'
        Position.Point = '(15,-8)'
        Locked = True
        Width = 50.000000000000000000
        Height = 17.000000000000000000
        ClipParent = True
        HitTest = False
        AutoSize = True
        Fill.Color = claWhite
        Text = 'Groupbox'
        WordWrap = False
      end

As you can see the colors of the FireMonkey style elements are stored in a hexadecimal format or using the name of the predefined FireMonkey colors , and these are the values ​​we need to modify.

The FireMonkey styles can be embedded in the resource property of a TStyleBook component or in a .Style file. In order to modify these values we need to parse the style and locate all entries which represent a TAlphaColor.

Parsing a FireMonkey Style

The first thing that jumps out is that the root component of is a TLayout object and the style format only defines a tree of objects. So the general idea is iterate over all the TAlphaColor properties, modify the colors and then write back to the TStyleBook.Resource property the modified TLayout.

So the first idea is, Hey I can load this tree of objects in a TLayout and then using the RTTI and a recursive function I can set all the properties which are of the type TAlphaColor.

So you will write something like this to create the TLayout object

 Stream:=TStringStream.Create;
 try
   s:=FStyleBook.Resource.Text;
   Stream.WriteString(s);
   Stream.Position:=0;
   FLayout:=TLayout(CreateObjectFromStream(nil,Stream));
 finally
  Stream.Free;
 end;

And now you will write a nice recursive function using the RTTI to set all the Colors of all the children objects. you will check which works ok (the colors are modified as you want) and then you will write the modified Style to the TLayout.Resource property. But stop we can’t use this method to do this task because the properties stored in FireMonkey Style is just a subset of all the properties of each object let me explain :

This is a TText object

  TText = class(TShape)
   //only showing the published properties.
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
    property Fill;
    property Font: TFont read FFont write SetFont;
    property HorzTextAlign: TTextAlign read FHorzTextAlign write SetHorzTextAlign
      default TTextAlign.taCenter;
    property VertTextAlign: TTextAlign read FVertTextAlign write SetVertTextAlign
      default TTextAlign.taCenter;
    property Text: string read FText write SetText;
    property Stretch: Boolean read FStretch write SetStretch default False;
    property WordWrap: Boolean read FWordWrap write SetWordWrap default True;
  end;

And this is how a TText object is stored in a FireMonkey Style

    object TText
      StyleName = 'text'
      Align = alClient
      Locked = True
      Width = 49.000000000000000000
      Height = 20.000000000000000000
      HitTest = False
      Fill.Color = xFFE0E0E0
      Text = 'label'
    end

As you can see if you use the RTTI way to set the new color values and then write the object back you will passing all the properties to the object and finally you will create a giant modified
FireMonkey style which will slow down our application. So what is the solution? well just parse the text of the style manually and determine using a simple algorithm if the entry (line) to process is a TAlphaColor or not.

In this point you have many options, you can use a regular expression, or create an array with the name of all possible entries to process like Fill.Color, Color, Stroke.Color and so on, and all this just to process a line like Fill.Color = xFFE0E0E0. But I choose more simple option, just dividing a line in 2 components called Name and Value.

Let me show you with a piece of code.

First define a structure to hold the data of the style to modify.

 TFMStyleLine=record
  Index   : Integer;
 IsColor : Boolean;
  Name    : string;
  Value   : string;
 Color : TAlphaColor;
 end;

 FLines : TList<TFMStyleLine>;

and then write a procedure to parse the FireMonkey Style


//this function determine if a particular line of the resource property is a AlphaColor
function PropIsColor(const Name, Value: string): Boolean;
begin
 Result:=(CompareText(Name,'Color')=0) or (Pos('.Color',Name)>0) or (StartsText('cla',Value)) or (Length(Value)=9) and (Value[1]='x'));
end;

//Fill a generic list with the lines which have a color property
procedure FillList;
var
  i : integer;
  ALine : TFMStyleLine;
  p : integer;
begin
  FLines.Clear;
  for i := 0 to FStyleBook.Resource.Count-1 do
  begin
    ALine.IsColor:=False;
    ALine.Name:='';
    ALine.Value:='';
    ALine.Color:=claNull;
    //Determine if the line has a = sign
    p:=Pos('=',FStyleBook.Resource[i]);
     if p>0 then
     begin
       //get the name of the property
       ALine.Name :=Trim(Copy(FStyleBook.Resource[i],1,p-1));
       //get the value of the property
       ALine.Value:=Trim(Copy(FStyleBook.Resource[i],p+1));
       //check if is the line has a color
       ALine.IsColor:=PropIsColor(ALine.Name, ALine.Value);
       if ALine.IsColor then
       begin
         //store the index of the line from the resource to modify
         ALine.Index:=i;
         ALine.Color :=StringToAlphaColor(ALine.Value);
         //add the record to the collection
         FLines.Add(ALine);
       end;
     end;
  end;
end;

As you can see the logic is very simple (sure can be improved) and works.

Making the changes

In this point we have a list with all the colors to modify, so we can to start applying the operations over the colors to change the HSL and RGB components.

//this procedure modify the RGB components of the colors stored in the generics list, adding a delta value (1..255) for each component (R, G, B)
procedure ChangeRGB(dR, dG, dB: Byte);
var
  i : Integer;
  v : TFMStyleLine;
begin
  for i := 0 to FLines.Count-1 do
   //only modify the lines which contains a Color <>  claNull
   if FLines[i].IsColor and (FLines[i].Color<>claNull) then
    begin
      v:=FLines[i];
      TAlphaColorRec(v.Color).R:=TAlphaColorRec(v.Color).R+dR;
      TAlphaColorRec(v.Color).G:=TAlphaColorRec(v.Color).G+dG;
      TAlphaColorRec(v.Color).B:=TAlphaColorRec(v.Color).B+dB;
      if v.Color<>FMod[i].Color then
        FMod[i]:=v;
    end;
end;

//this procedure modify the HSL values from the colors stored in generic list
procedure ChangeHSL(dH, dS, dL: Single);
var
  i : Integer;
  v : TFMStyleLine;
begin
  for i := 0 to FLines.Count-1 do
   //only modify the lines which contains a Color <>  claNull
   if FLines[i].IsColor and (FLines[i].Color<>claNull) then
    begin
      v:=FLines[i];
      v.Color:=(FMX.Types.ChangeHSL(v.Color,dH,dS,dL));
      if v.Color<>FMod[i].Color then
        FMod[i]:=v;
    end;
end;

And now an example of how use this code. check the next form which has the Blend style (included with Delphi XE)

Now executing this code for the HSL transformation

Var
 Eq : TStyleEqualizer;
begin
 Eq:= TStyleEqualizer.Create;
 try
  Eq.StyleBook:=StyleBook1;
  Eq.ChangeHSL(130/360,5/100,0);
  Eq.Refresh;
 finally
  Eq.Free;
 end;
end;

we have this result

Now executing this code for the RGB transformation

Var
 Eq : TStyleEqualizer;
begin
 Eq:= TStyleEqualizer.Create;
 try
  Eq.StyleBook:=StyleBook1;
  Eq.ChangeRGB(50,0,0);
  Eq.Refresh;
 finally
  Eq.Free;
 end;
end;

The Application

Finally I wrote an application that uses the functions described above to modify in runtime any FireMonkey Style and let you save the changes creating a new style in just a few clicks.

Check this video to see the application in action

Check the source code on Github.