Ignore:
Timestamp:
Apr 17, 2019, 12:58:41 AM (5 years ago)
Author:
chronos
Message:
  • Modified: Propagate project build mode options to used packages.
  • Added: Check memory leaks using heaptrc.
  • Modified: Update BGRABitmap package.
Location:
GraphicTest
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • GraphicTest

    • Property svn:ignore

      •  

        old new  
        88GraphicTest.lps
        99GraphicTest.dbg
         10heaptrclog.trc

  • GraphicTest/Packages/bgrabitmap/bgrasvgtype.pas

    r494 r521  
    22
    33{$mode objfpc}{$H+}
     4{$MODESWITCH ADVANCEDRECORDS}
    45
    56interface
    … …  
    78uses
    89  Classes, SysUtils, BGRATransform, BGRABitmapTypes, BGRAUnits,
    9   laz2_DOM, BGRACanvas2D;
     10  laz2_DOM, BGRACanvas2D, fgl, BGRAGraphics;
    1011
    1112type
     13  ArrayOfFloat = array of single;
     14 
    1215  TSVGElement = class;
     16  TSVGElementList = specialize TFPGList<TSVGElement>;
    1317  TSVGFactory = class of TSVGElement;
     18 
     19  TSVGFillMode = (
     20     sfmEvenOdd = Ord(fmAlternate),
     21     sfmNonZero = Ord(fmWinding)
     22   );
     23   
     24  TFindStyleState = (fssNotSearch,
     25                     fssNotFind,
     26                     fssFind);
     27  TStyleAttribute = record
     28     attr  : string;
     29     pos   : integer;
     30  end;
     31  ArrayOfTStyleAttribute = array of TStyleAttribute;
     32
     33  { TSVGPreserveAspectRatio }
     34
     35  TSVGPreserveAspectRatio = record
     36     Preserve, Slice: boolean;
     37     HorizAlign: TAlignment;
     38     VertAlign: TTextLayout;
     39     function ToString: string;
     40     class function Parse(AValue: string): TSVGPreserveAspectRatio; static;
     41     class function DefaultValue: TSVGPreserveAspectRatio; static;
     42  end;
     43
     44  TSVGRecomputeEvent = procedure(Sender: TObject) of object;
     45 
     46  { TSVGDataLink }
     47
     48  TSVGDataLink = class
     49   private
     50     FElements,
     51     FGradients,
     52     FStyles,
     53     FRootElements: TSVGElementList;
     54     function IsValidID(const id: integer; list: TSVGElementList): boolean;
     55     function GetElement(id: integer): TSVGElement;
     56     function GetGradient(id: integer): TSVGElement;
     57     function GetStyle(id: integer): TSVGElement;
     58     function GetRootElement(id: integer): TSVGElement;
     59     function FindElement(el: TSVGElement; list: TSVGElementList): integer;
     60     function Find(el: TSVGElement): integer;//(find on FElements)
     61     procedure InternalLink(const id: integer; parent: TSVGElement);
     62     procedure InternalUnLink(const id: integer);
     63     procedure InternalReLink(const id: integer; parent: TSVGElement);
     64   public
     65     constructor Create;
     66     destructor Destroy; override;
     67
     68     function ElementCount: integer;
     69     function GradientCount: integer;
     70     function StyleCount: integer;
     71     //contains the elements at the root of the link tree (having parent = nil)
     72     function RootElementCount: integer;
     73     function IsLink(el: TSVGElement): boolean;
     74     //(Note: assumes that the valid parent is present in the list or added later)
     75     function Link(el: TSVGElement; parent: TSVGElement = nil): integer;
     76     //excludes el from the list (+ restores validity of links)
     77     procedure Unlink(el: TSVGElement);
     78     //(faster method than a "for.. Unlink()")
     79     procedure UnlinkAll;
     80     //Method needed to change the parent of an item without removing it
     81     function ReLink(el: TSVGElement; parent: TSVGElement): boolean;
     82
     83     //(useful for testing support)
     84     function GetInternalState: TStringList;
     85
     86     property Elements[ID: integer]: TSVGElement read GetElement;
     87     property Gradients[ID: integer]: TSVGElement read GetGradient;
     88     property Styles[ID: integer]: TSVGElement read GetStyle;
     89     property RootElements[ID: integer]: TSVGElement read GetRootElement;
     90  end;
    1491
    1592  { TSVGElement }
    … …  
    1794  TSVGElement = class
    1895    private
    19       function GetAttributeOrStyle(AName: string): string;
     96      findStyleState: TFindStyleState;
     97      styleAttributes: ArrayOfTStyleAttribute;
     98      FDataParent: TSVGElement;
     99      FDataChildList: TSVGElementList;
     100      function GetAttributeOrStyle(AName,ADefault: string): string; overload;
     101      function GetAttributeOrStyle(AName: string): string; overload;
    20102      function GetFill: string;
    21103      function GetFillColor: TBGRAPixel;
    22104      function GetFillOpacity: single;
    23       function GetHorizAttributeOrStyleWithUnit(AName: string
    24         ): TFloatWithCSSUnit;
     105      function GetFillRule: string;
     106      function GetHorizAttributeOrStyleWithUnit(AName: string;
     107        ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
    25108      function GetIsFillNone: boolean;
    26109      function GetIsStrokeNone: boolean;
    27110      function GetMatrix(AUnit: TCSSUnit): TAffineMatrix;
    28111      function GetOpacity: single;
    29       function GetOrthoAttributeOrStyleWithUnit(AName: string
    30         ): TFloatWithCSSUnit;
     112      function GetOrthoAttributeOrStyleWithUnit(AName: string;
     113        ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
    31114      function GetStroke: string;
    32115      function GetStrokeColor: TBGRAPixel;
    … …  
    36119      function GetStrokeOpacity: single;
    37120      function GetStrokeWidth: TFloatWithCSSUnit;
    38       function GetStyle(const AName: string): string;
     121      function GetStrokeDashArray: string;
     122      function GetStrokeDashArrayF: ArrayOfFloat;
     123      function GetStrokeDashOffset: TFloatWithCSSUnit;
     124      function GetStyle(const AName,ADefault: string): string; overload;
     125      function GetStyle(const AName: string): string; overload;
    39126      function GetTransform: string;
    40127      function GetUnits: TCSSUnitConverter;
    41       function GetAttribute(AName: string): string;
    42       function GetVerticalAttributeOrStyleWithUnit(AName: string
    43         ): TFloatWithCSSUnit;
     128      function GetAttribute(AName,ADefault: string; ACanInherit: boolean): string; overload;
     129      function GetAttribute(AName,ADefault: string): string; overload;
     130      function GetAttribute(AName: string): string; overload;
     131      function GetVerticalAttributeOrStyleWithUnit(AName: string;
     132        ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
    44133      procedure SetAttribute(AName: string; AValue: string);
    45       function GetAttributeWithUnit(AName: string): TFloatWithCSSUnit;
    46       function GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit;
    47       function GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit;
    48       function GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit;
    49       function GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit;
     134      function GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
     135      function GetAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
     136      function GetAttributeOrStyleWithUnit(AName: string;
     137        ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
     138      function GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit; overload;
     139      function GetOrthoAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
     140      function GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
     141      function GetHorizAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
     142      function GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
     143      function GetVerticalAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit; overload;
     144      function GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit; overload;
     145      function GetID: string;
     146      function GetClassAt: string;
    50147      procedure SetAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
    51148      procedure SetFill(AValue: string);
    52149      procedure SetFillColor(AValue: TBGRAPixel);
    53150      procedure SetFillOpacity(AValue: single);
     151      procedure SetFillRule(AValue: string);
    54152      procedure SetHorizAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
    55153      procedure SetMatrix(AUnit: TCSSUnit; const AValue: TAffineMatrix);
    … …  
    62160      procedure SetStrokeOpacity(AValue: single);
    63161      procedure SetStrokeWidth(AValue: TFloatWithCSSUnit);
     162      procedure SetStrokeDashArray(AValue: string);
     163      procedure SetStrokeDashArrayF(AValue: ArrayOfFloat);
     164      procedure SetStrokeDashOffset(AValue: TFloatWithCSSUnit);
    64165      procedure SetStyle(AName: string; AValue: string);
    65166      procedure SetTransform(AValue: string);
    66167      procedure SetVerticalAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
    67168      procedure SetOrthoAttributeWithUnit(AName: string; AValue: TFloatWithCSSUnit);
     169      procedure SetID(AValue: string);
     170      procedure SetClassAt(AValue: string);
     171      function FindStyleElementInternal(const classStr: string;
     172        out attributesStr: string): integer;
     173      procedure FindStyleElement;
    68174    protected
     175      FDataLink: TSVGDataLink;
    69176      FDomElem: TDOMElement;
    70177      FUnits: TCSSUnitConverter;
    … …  
    74181      procedure InternalDraw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual;
    75182      procedure LocateStyleDeclaration(AText: string; AProperty: string; out AStartPos,AColonPos,AValueLength: integer);
     183      procedure ApplyFillStyle(ACanvas2D: TBGRACanvas2D; {%H-}AUnit: TCSSUnit); virtual;
    76184      procedure ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
     185      procedure Initialize; virtual;
    77186    public
    78       constructor Create({%H-}ADocument: TXMLDocument; AElement: TDOMElement; AUnits: TCSSUnitConverter); virtual;
    79       constructor Create({%H-}ADocument: TXMLDocument; {%H-}AUnits: TCSSUnitConverter); virtual;
     187      constructor Create({%H-}ADocument: TXMLDocument; AElement: TDOMElement; AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual;
     188      constructor Create({%H-}ADocument: TXMLDocument; {%H-}AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink); overload; virtual;
     189      destructor Destroy; override;
     190      procedure Recompute; virtual;
    80191      procedure Draw({%H-}ACanvas2d: TBGRACanvas2D; {%H-}AUnit: TCSSUnit);
    81192      procedure fillNone;
    … …  
    83194      procedure transformNone;
    84195      procedure RemoveStyle(const AName: string);
     196      function HasAttribute(AName: string): boolean;
     197      function fillMode: TSVGFillMode;
     198      function DataChildList: TSVGElementList;
     199      property DataLink: TSVGDataLink read FDataLink write FDataLink;
     200      property AttributeDef[AName,ADefault: string]: string read GetAttribute;
    85201      property Attribute[AName: string]: string read GetAttribute write SetAttribute;
     202      property AttributeOrStyleDef[AName,ADefault: string]: string read GetAttributeOrStyle;
    86203      property AttributeOrStyle[AName: string]: string read GetAttributeOrStyle;
     204      property StyleDef[AName,ADefault: string]: string read GetStyle;
    87205      property Style[AName: string]: string read GetStyle write SetStyle;
     206      property AttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetAttributeWithUnit;
     207      property AttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetAttributeWithUnit write SetAttributeWithUnit;
     208      property OrthoAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit;
    88209      property OrthoAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetOrthoAttributeWithUnit write SetOrthoAttributeWithUnit;
     210      property HorizAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeWithUnit;
    89211      property HorizAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetHorizAttributeWithUnit write SetHorizAttributeWithUnit;
     212      property VerticalAttributeWithUnitDef[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit;
    90213      property VerticalAttributeWithUnit[AName: string]: TFloatWithCSSUnit read GetVerticalAttributeWithUnit write SetVerticalAttributeWithUnit;
    91       property OrthoAttributeOrStyleWithUnit[AName: string]: TFloatWithCSSUnit read GetOrthoAttributeOrStyleWithUnit;
    92       property HorizAttributeOrStyleWithUnit[AName: string]: TFloatWithCSSUnit read GetHorizAttributeOrStyleWithUnit;
    93       property VerticalAttributeOrStyleWithUnit[AName: string]: TFloatWithCSSUnit read GetVerticalAttributeOrStyleWithUnit;
     214      property OrthoAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetOrthoAttributeOrStyleWithUnit;
     215      property HorizAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetHorizAttributeOrStyleWithUnit;
     216      property VerticalAttributeOrStyleWithUnit[AName: string; ADefault: TFloatWithCSSUnit]: TFloatWithCSSUnit read GetVerticalAttributeOrStyleWithUnit;
    94217      property DOMElement: TDOMElement read GetDOMElement;
    95218      property Units: TCSSUnitConverter read GetUnits;
    … …  
    105228      property strokeLineJoin: string read GetStrokeLineJoin write SetStrokeLineJoin;
    106229      property strokeLineCap: string read GetStrokeLineCap write SetStrokeLineCap;
     230      property strokeDashArray: string read GetStrokeDashArray write SetStrokeDashArray;
     231      property strokeDashArrayF: ArrayOfFloat read GetStrokeDashArrayF write SetStrokeDashArrayF;
     232      property strokeDashOffset: TFloatWithCSSUnit read GetStrokeDashOffset write SetStrokeDashOffset;
    107233      property fill: string read GetFill write SetFill;
    108234      property fillColor: TBGRAPixel read GetFillColor write SetFillColor;
    109235      property fillOpacity: single read GetFillOpacity write SetFillOpacity;
     236      property fillRule: string read GetFillRule write SetFillRule;
    110237      property opacity: single read GetOpacity write SetOpacity;
     238      property ID: string read GetID write SetID;
     239      property classAt: string read GetClassAt write SetClassAt;//Attribute "class"
     240      property DataParent: TSVGElement read FDataParent write FDataParent;
    111241  end;
    112242
    … …  
    125255    function ParseId: string;
    126256    function ParseSymbol: char;
     257    function ParseTransform: TAffineMatrix;
    127258    procedure SkipSymbol(ASymbol: char);
    128259    procedure SkipUpToSymbol(ASymbol:char);
    … …  
    133264    property Done: boolean read GetDone;
    134265  end;
     266 
     267  resourcestring
     268    rsInvalidId = 'invalid id';
    135269
    136270implementation
     271
     272uses BGRASVGShapes;
     273
     274{ TSVGPreserveAspectRatio }
     275
     276function TSVGPreserveAspectRatio.ToString: string;
     277begin
     278  if not Preserve then result := 'none' else
     279  begin
     280    result := '';
     281    case HorizAlign of
     282    taCenter: result += 'xMid';
     283    taRightJustify: result += 'xMax';
     284    else result += 'xMin';
     285    end;
     286    case VertAlign of
     287    tlCenter: result += 'YMid';
     288    tlBottom: result += 'YMax';
     289    else result += 'YMin';
     290    end;
     291    if Slice then result += ' slice' else result += ' meet';
     292  end;
     293end;
     294
     295class function TSVGPreserveAspectRatio.Parse(AValue: string
     296  ): TSVGPreserveAspectRatio;
     297var p: TSVGParser;
     298  id: string;
     299begin
     300  p := TSVGParser.Create(AValue);
     301  result := DefaultValue;
     302  repeat
     303    id := p.ParseId;
     304    if id = 'none' then
     305    begin
     306      result.Preserve := false;
     307      //set other parameters for intermediate value of ViewSize (before stretching non-proportionaly)
     308      result.Slice := false;
     309      result.HorizAlign := taCenter;
     310      result.VertAlign := tlCenter;
     311      exit;
     312    end else
     313    if id = 'slice' then result.Slice := true
     314    else if (length(id)=8) and (id[1] = 'x') and (id[5] = 'Y') then
     315    begin
     316      case copy(id,2,3) of
     317      'Min': result.HorizAlign := taLeftJustify;
     318      'Mid': result.HorizAlign := taCenter;
     319      'Max': result.HorizAlign := taRightJustify;
     320      end;
     321      case copy(id,6,3) of
     322      'Min': result.VertAlign := tlTop;
     323      'Mid': result.VertAlign := tlCenter;
     324      'Max': result.VertAlign := tlBottom;
     325      end;
     326    end;
     327  until id = '';
     328  p.Free;
     329end;
     330
     331class function TSVGPreserveAspectRatio.DefaultValue: TSVGPreserveAspectRatio;
     332begin
     333  result.Preserve := true;
     334  result.Slice := false;
     335  result.HorizAlign := taCenter;
     336  result.VertAlign := tlCenter;
     337end;
    137338
    138339{ TSVGParser }
    … …  
    194395end;
    195396
     397function TSVGParser.ParseTransform: TAffineMatrix;
     398var
     399  kind: String;
     400  m : TAffineMatrix;
     401  angle,tx,ty: single;
     402begin
     403  result := AffineMatrixIdentity;
     404  while not Done do
     405  begin
     406    kind := ParseId;
     407    if kind = '' then break;
     408    if ParseSymbol <> '(' then break;
     409    if compareText(kind,'matrix')=0 then
     410    begin
     411      m[1,1] := ParseFloat;
     412      SkipSymbol(',');
     413      m[2,1] := ParseFloat;
     414      SkipSymbol(',');
     415      m[1,2] := ParseFloat;
     416      SkipSymbol(',');
     417      m[2,2] := ParseFloat;
     418      SkipSymbol(',');
     419      m[1,3] := ParseFloat;
     420      SkipSymbol(',');
     421      m[2,3] := ParseFloat;
     422      result *= m;
     423    end else
     424    if compareText(kind,'translate')=0 then
     425    begin
     426      tx := ParseFloat;
     427      SkipSymbol(',');
     428      ty := ParseFloat;
     429      result *= AffineMatrixTranslation(tx,ty);
     430    end else
     431    if compareText(kind,'scale')=0 then
     432    begin
     433      tx := ParseFloat;
     434      SkipSymbol(',');
     435      ClearError;
     436      ty := ParseFloat;
     437      if NumberError then ty := tx;
     438      result *= AffineMatrixScale(tx,ty);
     439    end else
     440    if compareText(kind,'rotate')=0 then
     441    begin
     442      angle := ParseFloat;
     443      SkipSymbol(',');
     444      tx := ParseFloat;
     445      SkipSymbol(',');
     446      ty := ParseFloat;
     447      result *= AffineMatrixTranslation(tx,ty)*AffineMatrixRotationDeg(angle)*
     448                AffineMatrixTranslation(-tx,-ty);
     449    end else
     450    if compareText(kind,'skewx')=0 then
     451    begin
     452      angle := ParseFloat;
     453      result *= AffineMatrixSkewXDeg(angle);
     454    end else
     455    if compareText(kind,'skewy')=0 then
     456    begin
     457      angle := ParseFloat;
     458      result *= AffineMatrixSkewYDeg(angle);
     459    end;
     460    SkipUpToSymbol(')');
     461  end;
     462end;
     463
    196464procedure TSVGParser.SkipSymbol(ASymbol: char);
    197465begin
    … …  
    211479end;
    212480
     481{ TSVGDataLink }
     482
     483constructor TSVGDataLink.Create;
     484begin
     485  FElements:= TSVGElementList.Create;
     486  FGradients:= TSVGElementList.Create;
     487  FStyles:= TSVGElementList.Create;
     488  FRootElements:= TSVGElementList.Create;
     489end;
     490
     491destructor TSVGDataLink.Destroy;
     492begin
     493  FreeAndNil(FRootElements);
     494  FreeAndNil(FGradients);
     495  FreeAndNil(FElements);
     496  FreeAndNil(FStyles);
     497  inherited Destroy;
     498end;
     499
     500function TSVGDataLink.IsValidID(const id: integer; list: TSVGElementList): boolean;
     501begin
     502  result:= (id >= 0) and (id < list.Count);
     503end;
     504
     505function TSVGDataLink.GetElement(id: integer): TSVGElement;
     506begin
     507  if not IsValidID(id,FElements) then
     508   raise exception.Create(rsInvalidId);
     509  result:= FElements[id];
     510end;
     511
     512function TSVGDataLink.GetGradient(id: integer): TSVGElement;
     513begin
     514  if not IsValidID(id,FGradients) then
     515   raise exception.Create(rsInvalidId);
     516  result:= FGradients[id];
     517end;
     518
     519function TSVGDataLink.GetStyle(id: integer): TSVGElement;
     520begin
     521  if not IsValidID(id,FStyles) then
     522   raise exception.Create(rsInvalidId);
     523  result:= FStyles[id];
     524end; 
     525
     526function TSVGDataLink.GetRootElement(id: integer): TSVGElement;
     527begin
     528  if not IsValidID(id,FRootElements) then
     529   raise exception.Create(rsInvalidId);
     530  result:= FRootElements[id];
     531end;
     532
     533function TSVGDataLink.FindElement(el: TSVGElement; list: TSVGElementList): integer;
     534var
     535  i: integer;
     536begin
     537  for i:= 0 to list.Count-1 do
     538    if list[i] = el then
     539    begin
     540      result:= i;
     541      Exit;
     542    end;
     543  result:= -1;
     544end;
     545
     546function TSVGDataLink.Find(el: TSVGElement): integer;
     547begin
     548  result:= FindElement(el,FElements);
     549end;
     550
     551procedure TSVGDataLink.InternalLink(const id: integer; parent: TSVGElement);
     552var
     553  el: TSVGElement;
     554begin
     555  el:= FElements.Items[id];
     556  with el do
     557  begin
     558    DataParent:= parent;
     559    if parent = nil then
     560     FRootElements.Add(el);
     561    //Update DataChildList of "parent" before add it
     562    //(not use el.DataChildList.Clear here!!)
     563    if parent <> nil then
     564      parent.DataChildList.Add(el);
     565  end;
     566end;
     567
     568procedure TSVGDataLink.InternalUnLink(const id: integer);
     569var
     570  i,pos_root: integer;
     571  el: TSVGElement;
     572begin
     573  el:= FElements.Items[id];
     574  with el do
     575  begin
     576    //se root need remove (use pos for add child as new root)
     577    if DataParent = nil then
     578     pos_root:= FRootElements.Remove(el)
     579    else
     580     pos_root:= FRootElements.Count;
     581    //i have to assign a parent of a upper level
     582    //and update child list of new parent (if not nil)
     583    with DataChildList do
     584    begin
     585      for i:= 0 to Count-1 do
     586      begin
     587       Items[i].DataParent:= el.DataParent;
     588       if el.DataParent = nil then
     589        //with parent nil = new root
     590        FRootElements.Insert(pos_root+i, Items[i])
     591       else
     592        el.DataParent.DataChildList.Add( Items[i] );
     593      end;
     594      Clear;
     595    end;
     596    //if he has a parent, I have to remove his reference as a child
     597    if DataParent <> nil then
     598    begin
     599      DataParent.DataChildList.Remove(el);
     600      DataParent:= nil;
     601    end;
     602  end;
     603end;
     604
     605procedure TSVGDataLink.InternalReLink(const id: integer; parent: TSVGElement);
     606begin
     607  InternalUnLink(id);
     608  InternalLink(id,parent);
     609end;
     610
     611function TSVGDataLink.ElementCount: integer;
     612begin
     613  result:= FElements.Count;
     614end;
     615
     616function TSVGDataLink.GradientCount: integer;
     617begin
     618  result:= FGradients.Count;
     619end;
     620
     621function TSVGDataLink.StyleCount: integer;
     622begin
     623  result:= FStyles.Count;
     624end;
     625
     626function TSVGDataLink.RootElementCount: integer;
     627begin
     628  result:= FRootElements.Count;
     629end;
     630
     631function TSVGDataLink.IsLink(el: TSVGElement): boolean;
     632begin
     633  result:= Find(el) <> -1;
     634end;
     635
     636function TSVGDataLink.Link(el: TSVGElement; parent: TSVGElement = nil): integer;
     637begin
     638  FElements.Add(el);
     639  result:= FElements.Count-1;
     640  InternalLink(result,parent);
     641  if el is TSVGGradient then
     642    FGradients.Add(el)
     643  else if el is TSVGStyle then
     644    FStyles.Add(el);
     645end;
     646
     647procedure TSVGDataLink.Unlink(el: TSVGElement);
     648var
     649  id: integer;
     650begin
     651  id:= FindElement(el,FElements);
     652  if id <> -1 then
     653  begin
     654    if el is TSVGGradient then
     655      FGradients.Remove(el)
     656    else if el is TSVGStyle then
     657      FStyles.Remove(el);
     658    InternalUnLink(id);
     659    FElements.Delete(id);
     660  end
     661  else
     662   raise exception.Create('element not find');
     663end;
     664
     665procedure TSVGDataLink.UnlinkAll;
     666var
     667  i: integer;
     668begin
     669  FGradients.Clear;
     670  FStyles.Clear;
     671
     672  for i:= 0 to FElements.Count-1 do
     673    InternalUnLink(i);
     674  FRootElements.Clear;
     675  FElements.Clear;
     676end;
     677
     678function TSVGDataLink.ReLink(el: TSVGElement; parent: TSVGElement): boolean;
     679var
     680  id: integer;
     681begin
     682  id:= FindElement(el,FElements);
     683  if id <> -1 then
     684  begin
     685    result:= true;
     686    if el.DataParent <> parent then
     687      InternalReLink(id,parent);
     688  end
     689  else
     690    result:= false;
     691end;
     692
     693function TSVGDataLink.GetInternalState: TStringList;
     694var
     695  nid: integer;
     696  sl: TStringList;
     697
     698  function SpaceStr(const level: integer): string;
     699  var
     700    i: integer;
     701  begin
     702    result:= '';
     703    for i:= 1 to level do
     704      result:= result + ' ';
     705  end;
     706
     707  procedure AddStr(s: string; const level: integer);
     708  begin
     709    sl.Add( SpaceStr(level) + s );
     710  end;
     711
     712  function ElementIdentity(el: TSVGElement): string;
     713  begin
     714   if el = nil then
     715     result:= 'nil'
     716   else
     717   begin
     718     result:= el.ID;
     719     if Trim(Result) = '' then
     720       result:= 'unknow';
     721     result:= result + ' - ' + el.ClassName +
     722       //(slow: for test ok)
     723       ' | (pos: ' + IntToStr( Find(el) ) + ')';
     724   end;
     725  end;
     726
     727  procedure ElementToInfo(el: TSVGElement; const level: integer);
     728  Var
     729   i: integer;
     730   sep: string;
     731  begin
     732   if el.DataParent = nil then
     733    sep:= '###'
     734   else
     735    sep:= '***';
     736   AddStr('{'+sep+' '+ElementIdentity(el)+' '+sep+'}', level);
     737   AddStr('[Parent: ' + ElementIdentity(el.DataParent) + ']', level);
     738   for i:= 0 to el.DataChildList.Count-1 do
     739     AddStr('[Child: ' + ElementIdentity(el.DataChildList[i]) + ']', level);
     740  end;
     741
     742  procedure BuildInfo(el: TSVGElement; const level: integer = 1);
     743  const
     744    kspace = 5;
     745  var
     746    i: Integer;
     747  begin
     748   ElementToInfo(el,level);
     749   Inc(nid);
     750   for i:= 0 to el.DataChildList.Count-1 do
     751     BuildInfo(el.DataChildList[i],level+kspace);
     752  end;
     753
     754var
     755 i: integer;
     756begin
     757  nid:= 0;
     758  sl:= TStringList.Create;
     759  for i:= 0 to FRootElements.Count-1 do
     760    BuildInfo( FRootElements[i] );
     761  result:= sl;
     762end;     
     763
    213764{ TSVGElement }
    214765
     766function TSVGElement.GetAttribute(AName,ADefault: string; ACanInherit: boolean): string;
     767var
     768  curNode: TDOMElement;
     769begin
     770  curNode := FDomElem;
     771  repeat
     772    result := Trim(curNode.GetAttribute(AName));
     773    if (result = 'currentColor') and (AName <> 'color') then
     774    begin
     775      AName := 'color';
     776      curNode := FDomElem; //get from the current element
     777      ACanInherit:= true;
     778      result := Trim(curNode.GetAttribute(AName));
     779    end;
     780    if ((result = '') or (result = 'inherit')) and ACanInherit and
     781      (curNode.ParentNode is TDOMElement) then
     782      curNode := curNode.ParentNode as TDOMElement
     783    else
     784      curNode := nil;
     785  until curNode = nil;
     786
     787  if (result = '') or (result = 'inherit') then
     788    result:= ADefault;
     789end;
     790
     791function TSVGElement.GetAttribute(AName, ADefault: string): string;
     792begin
     793  result := GetAttribute(AName, ADefault, False);
     794end;
     795
    215796function TSVGElement.GetAttribute(AName: string): string;
    216797begin
    217   result := FDomElem.GetAttribute(AName);
    218 end;
    219 
    220 function TSVGElement.GetVerticalAttributeOrStyleWithUnit(AName: string
    221   ): TFloatWithCSSUnit;
    222 begin
    223   result := GetAttributeOrStyleWithUnit(AName);
     798  result:= GetAttribute(AName,'');
     799end; 
     800
     801function TSVGElement.GetVerticalAttributeOrStyleWithUnit(AName: string;
     802  ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     803begin
     804  result := GetAttributeOrStyleWithUnit(AName,ADefault);
    224805  if result.CSSUnit <> cuCustom then
    225806    if units.DpiScaleY = 0 then
    … …  
    229810end;
    230811
     812function TSVGElement.GetAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     813begin
     814  result := TCSSUnitConverter.parseValue(Attribute[AName],ADefault);
     815end;
     816
    231817function TSVGElement.GetAttributeWithUnit(AName: string): TFloatWithCSSUnit;
    232818begin
    233   result := TCSSUnitConverter.parseValue(Attribute[AName],FloatWithCSSUnit(0,cuCustom));
    234 end;
    235 
    236 function TSVGElement.GetAttributeOrStyleWithUnit(AName: string
    237   ): TFloatWithCSSUnit;
    238 var valueText: string;
     819  result := GetAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
     820end; 
     821
     822function TSVGElement.GetAttributeOrStyleWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     823var
     824  valueText: string;
    239825begin
    240826  valueText := Style[AName];
    241   if valueText = '' then valueText := Attribute[AName];
    242   result := TCSSUnitConverter.parseValue(valueText,FloatWithCSSUnit(0,cuCustom));
    243 end;
    244 
    245 function TSVGElement.GetOrthoAttributeWithUnit(AName: string
    246   ): TFloatWithCSSUnit;
    247 begin
    248   result := GetHorizAttributeWithUnit(AName);
     827  if valueText = '' then
     828    valueText := GetAttribute(AName,'',True);
     829  result := TCSSUnitConverter.parseValue(valueText,ADefault);
     830end;
     831
     832function TSVGElement.GetAttributeOrStyleWithUnit(AName: string): TFloatWithCSSUnit;
     833begin
     834  result := GetAttributeOrStyleWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
     835end;
     836
     837function TSVGElement.GetOrthoAttributeWithUnit(AName: string;
     838  ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     839begin
     840  result := GetHorizAttributeWithUnit(AName,ADefault);
    249841  //value will be inconsistent if scaling is inconsistent
    250842end;
    251843
    252 function TSVGElement.GetHorizAttributeWithUnit(AName: string
    253   ): TFloatWithCSSUnit;
    254 begin
    255   result := GetAttributeWithUnit(AName);
     844function TSVGElement.GetOrthoAttributeWithUnit(AName: string): TFloatWithCSSUnit;
     845begin
     846  result := GetOrthoAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
     847end;
     848
     849function TSVGElement.GetHorizAttributeWithUnit(AName: string;
     850  ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     851begin
     852  result := GetAttributeWithUnit(AName,ADefault);
     853  if result.value <> EmptySingle then
     854  begin
     855    if result.CSSUnit <> cuCustom then
     856      if units.DpiScaleX = 0 then
     857        result.value := 0
     858      else
     859        result.value /= Units.DpiScaleX;
     860  end;
     861end;
     862
     863function TSVGElement.GetHorizAttributeWithUnit(AName: string): TFloatWithCSSUnit;
     864begin
     865  result := GetHorizAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
     866end;
     867
     868function TSVGElement.GetAttributeOrStyle(AName,ADefault: string): string;
     869begin
     870  result := GetStyle(AName,ADefault);
     871  if result = '' then
     872    result := GetAttribute(AName,ADefault,True);
     873end;
     874
     875function TSVGElement.GetAttributeOrStyle(AName: string): string;
     876begin
     877  result:= GetAttributeOrStyle(AName,'');
     878end;   
     879
     880function TSVGElement.GetFill: string;
     881begin
     882  result := AttributeOrStyleDef['fill','black'];
     883end;
     884
     885function TSVGElement.GetFillColor: TBGRAPixel;
     886begin
     887  result := StrToBGRA(fill,BGRABlack);
     888  result.alpha := round(result.alpha*fillOpacity*opacity);
     889  if result.alpha = 0 then result := BGRAPixelTransparent;
     890end;
     891
     892function TSVGElement.GetFillOpacity: single;
     893var errPos: integer;
     894begin
     895  val(AttributeOrStyleDef['fill-opacity','1'], result, errPos);
     896  if errPos <> 0 then result := 1 else
     897    if result < 0 then result := 0 else
     898      if result > 1 then result := 1;
     899end;
     900
     901function TSVGElement.GetFillRule: string;
     902begin
     903  result := AttributeOrStyleDef['fill-rule','nonzero'];
     904end;
     905
     906function TSVGElement.GetHorizAttributeOrStyleWithUnit(AName: string;
     907  ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     908begin
     909  result := GetAttributeOrStyleWithUnit(AName,ADefault);
    256910  if result.CSSUnit <> cuCustom then
    257911    if units.DpiScaleX = 0 then
    … …  
    261915end;
    262916
    263 function TSVGElement.GetAttributeOrStyle(AName: string): string;
    264 begin
    265   result := GetStyle(AName);
    266   if result = '' then result := GetAttribute(AName);
    267 end;
    268 
    269 function TSVGElement.GetFill: string;
    270 begin
    271   result := AttributeOrStyle['fill'];
    272 end;
    273 
    274 function TSVGElement.GetFillColor: TBGRAPixel;
    275 begin
    276   result := StrToBGRA(fill,BGRABlack);
    277   result.alpha := round(result.alpha*fillOpacity*opacity);
    278   if result.alpha = 0 then result := BGRAPixelTransparent;
    279 end;
    280 
    281 function TSVGElement.GetFillOpacity: single;
     917function TSVGElement.GetIsFillNone: boolean;
     918begin
     919  result := compareText(trim(fill),'none')=0;
     920end;
     921
     922function TSVGElement.GetIsStrokeNone: boolean;
     923var strokeStr: string;
     924begin
     925  strokeStr := stroke;
     926  result := (trim(strokeStr)='') or (compareText(trim(strokeStr),'none')=0);
     927end;
     928
     929function TSVGElement.GetMatrix(AUnit: TCSSUnit): TAffineMatrix;
     930var parser: TSVGParser;
     931    s: string;
     932begin
     933  s := transform;
     934  if s='' then
     935  begin
     936    result := AffineMatrixIdentity;
     937    exit;
     938  end;
     939  parser := TSVGParser.Create(s);
     940  result := parser.ParseTransform;
     941  result[1,3] := Units.ConvertWidth(result[1,3],cuCustom,AUnit);
     942  result[2,3] := Units.ConvertHeight(result[2,3],cuCustom,AUnit);
     943  parser.Free;
     944end;
     945
     946function TSVGElement.GetOpacity: single;
    282947var errPos: integer;
    283948begin
    284   val(AttributeOrStyle['fill-opacity'], result, errPos);
     949  val(AttributeOrStyleDef['opacity','1'], result, errPos);
    285950  if errPos <> 0 then result := 1 else
    286951    if result < 0 then result := 0 else
    … …  
    288953end;
    289954
    290 function TSVGElement.GetHorizAttributeOrStyleWithUnit(AName: string
    291   ): TFloatWithCSSUnit;
    292 begin
    293   result := GetAttributeOrStyleWithUnit(AName);
    294   if result.CSSUnit <> cuCustom then
    295     if units.DpiScaleX = 0 then
    296       result.value := 0
    297     else
    298       result.value /= Units.DpiScaleX;
    299 end;
    300 
    301 function TSVGElement.GetIsFillNone: boolean;
    302 begin
    303   result := compareText(trim(fill),'none')=0;
    304 end;
    305 
    306 function TSVGElement.GetIsStrokeNone: boolean;
    307 var strokeStr: string;
    308 begin
    309   strokeStr := stroke;
    310   result := (trim(strokeStr)='') or (compareText(trim(strokeStr),'none')=0);
    311 end;
    312 
    313 function TSVGElement.GetMatrix(AUnit: TCSSUnit): TAffineMatrix;
    314 var parser: TSVGParser;
    315     s,kind: string;
    316     m : TAffineMatrix;
    317     angle,tx,ty: single;
    318 begin
    319   result := AffineMatrixIdentity;
    320   s := transform;
    321   if s='' then exit;
    322   parser := TSVGParser.Create(s);
    323   while not parser.Done do
    324   begin
    325     kind := parser.ParseId;
    326     if kind = '' then break;
    327     if parser.ParseSymbol <> '(' then break;
    328     if compareText(kind,'matrix')=0 then
    329     begin
    330       m[1,1] := parser.ParseFloat;
    331       parser.SkipSymbol(',');
    332       m[2,1] := parser.ParseFloat;
    333       parser.SkipSymbol(',');
    334       m[1,2] := parser.ParseFloat;
    335       parser.SkipSymbol(',');
    336       m[2,2] := parser.ParseFloat;
    337       parser.SkipSymbol(',');
    338       m[1,3] := parser.ParseFloat;
    339       parser.SkipSymbol(',');
    340       m[2,3] := parser.ParseFloat;
    341       result *= m;
    342     end else
    343     if compareText(kind,'translate')=0 then
    344     begin
    345       tx := parser.ParseFloat;
    346       parser.SkipSymbol(',');
    347       ty := parser.ParseFloat;
    348       result *= AffineMatrixTranslation(tx,ty);
    349     end else
    350     if compareText(kind,'scale')=0 then
    351     begin
    352       tx := parser.ParseFloat;
    353       parser.SkipSymbol(',');
    354       parser.ClearError;
    355       ty := parser.ParseFloat;
    356       if parser.NumberError then ty := tx;
    357       result *= AffineMatrixScale(tx,ty);
    358     end else
    359     if compareText(kind,'rotate')=0 then
    360     begin
    361       angle := parser.ParseFloat;
    362       parser.SkipSymbol(',');
    363       tx := parser.ParseFloat;
    364       parser.SkipSymbol(',');
    365       ty := parser.ParseFloat;
    366       result *= AffineMatrixTranslation(tx,ty)*AffineMatrixRotationDeg(angle)*
    367                 AffineMatrixTranslation(-tx,-ty);
    368     end else
    369     if compareText(kind,'skewx')=0 then
    370     begin
    371       angle := parser.ParseFloat;
    372       result *= AffineMatrixSkewXDeg(angle);
    373     end else
    374     if compareText(kind,'skewy')=0 then
    375     begin
    376       angle := parser.ParseFloat;
    377       result *= AffineMatrixSkewYDeg(angle);
    378     end;
    379     parser.SkipUpToSymbol(')');
    380   end;
    381   parser.free;
    382   result[1,3] := Units.ConvertWidth(result[1,3],cuCustom,AUnit);
    383   result[2,3] := Units.ConvertHeight(result[2,3],cuCustom,AUnit);
    384 end;
    385 
    386 function TSVGElement.GetOpacity: single;
     955function TSVGElement.GetOrthoAttributeOrStyleWithUnit(AName: string;
     956  ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     957begin
     958  result := GetHorizAttributeOrStyleWithUnit(AName,ADefault);
     959  //value will be inconsistent if scaling is inconsistent
     960end;
     961
     962function TSVGElement.GetStroke: string;
     963begin
     964  result := AttributeOrStyleDef['stroke','none'];
     965end;
     966
     967function TSVGElement.GetStrokeColor: TBGRAPixel;
     968begin
     969  result := StrToBGRA(stroke);
     970  result.alpha := round(result.alpha*strokeOpacity*opacity);
     971  if result.alpha = 0 then result := BGRAPixelTransparent;
     972end;
     973
     974function TSVGElement.GetStrokeLineCap: string;
     975begin
     976  result := AttributeOrStyleDef['stroke-linecap','butt'];
     977end;
     978
     979function TSVGElement.GetStrokeLineJoin: string;
     980begin
     981  result := AttributeOrStyleDef['stroke-linejoin','miter'];
     982end;
     983
     984function TSVGElement.GetStrokeMiterLimit: single;
    387985var errPos: integer;
    388986begin
    389   val(AttributeOrStyle['opacity'], result, errPos);
     987  val(AttributeOrStyleDef['stroke-miterlimit','4'], result, errPos);
     988  if errPos <> 0 then result := 4 else
     989    if result < 1 then result := 1;
     990end;
     991
     992function TSVGElement.GetStrokeOpacity: single;
     993var errPos: integer;
     994begin
     995  val(AttributeOrStyleDef['stroke-opacity','1'], result, errPos);
    390996  if errPos <> 0 then result := 1 else
    391997    if result < 0 then result := 0 else
    … …  
    393999end;
    3941000
    395 function TSVGElement.GetOrthoAttributeOrStyleWithUnit(AName: string
    396   ): TFloatWithCSSUnit;
    397 begin
    398   result := GetHorizAttributeOrStyleWithUnit(AName);
    399   //value will be inconsistent if scaling is inconsistent
    400 end;
    401 
    402 function TSVGElement.GetStroke: string;
    403 begin
    404   result := AttributeOrStyle['stroke'];
    405 end;
    406 
    407 function TSVGElement.GetStrokeColor: TBGRAPixel;
    408 begin
    409   result := StrToBGRA(stroke);
    410   result.alpha := round(result.alpha*strokeOpacity*opacity);
    411   if result.alpha = 0 then result := BGRAPixelTransparent;
    412 end;
    413 
    414 function TSVGElement.GetStrokeLineCap: string;
    415 begin
    416   result := AttributeOrStyle['stroke-linecap'];
    417   if result = '' then result := 'butt';
    418 end;
    419 
    420 function TSVGElement.GetStrokeLineJoin: string;
    421 begin
    422   result := AttributeOrStyle['stroke-linejoin'];
    423   if result = '' then result := 'miter';
    424 end;
    425 
    426 function TSVGElement.GetStrokeMiterLimit: single;
    427 var errPos: integer;
    428 begin
    429   val(AttributeOrStyle['stroke-miterlimit'], result, errPos);
    430   if errPos <> 0 then result := 4 else
    431     if result < 1 then result := 1;
    432 end;
    433 
    434 function TSVGElement.GetStrokeOpacity: single;
    435 var errPos: integer;
    436 begin
    437   val(AttributeOrStyle['stroke-opacity'], result, errPos);
    438   if errPos <> 0 then result := 1 else
    439     if result < 0 then result := 0 else
    440       if result > 1 then result := 1;
    441 end;
    442 
    4431001function TSVGElement.GetStrokeWidth: TFloatWithCSSUnit;
    4441002begin
    445   result := OrthoAttributeOrStyleWithUnit['stroke-width'];
    446 end;
     1003  result := OrthoAttributeOrStyleWithUnit['stroke-width',FloatWithCSSUnit(1,cuCustom)];
     1004end;
     1005
     1006function TSVGElement.GetStrokeDashArray: string;
     1007begin
     1008  result := AttributeDef['stroke-dasharray','none'];
     1009end;
     1010
     1011function TSVGElement.GetStrokeDashArrayF: ArrayOfFloat;
     1012var
     1013  parser: TSVGParser;
     1014  nvalue,i: integer;
     1015  s_array: String;
     1016begin
     1017  s_array:= strokeDashArray;
     1018  if s_array = 'none' then
     1019  begin
     1020    setlength(Result,0);
     1021    exit;
     1022  end;
     1023  parser:=TSVGParser.Create(s_array);
     1024  nvalue := 0;
     1025  repeat
     1026    parser.ParseFloat;
     1027    if not parser.NumberError then
     1028      inc(nvalue);
     1029  until parser.NumberError or parser.Done;
     1030  parser.ClearError;
     1031  setlength(Result,nvalue);
     1032  parser.Position := 1;
     1033  for i := 0 to high(result) do
     1034    result[i] := parser.ParseFloat;
     1035  parser.Free;
     1036end;
     1037
     1038function TSVGElement.GetStrokeDashOffset: TFloatWithCSSUnit;
     1039begin
     1040  result := OrthoAttributeWithUnit['stroke-dashoffset'];
     1041end;   
     1042
     1043function TSVGElement.GetStyle(const AName,ADefault: string): string;
     1044
     1045  function GetInternal(const ruleset: string): string;
     1046  var
     1047    startPos, colonPos, valueLength: integer;
     1048  begin
     1049    LocateStyleDeclaration(ruleset, AName, startPos,colonPos, valueLength);
     1050    if valueLength <> -1 then
     1051      result := trim(copy(ruleset, colonPos+1, valueLength))
     1052    else
     1053      result := '';
     1054  end;
     1055
     1056var
     1057  i: integer;
     1058begin
     1059  result:= '';
     1060
     1061  //Find on <style> block (priority!)
     1062  //if "not search"..search
     1063  if findStyleState = fssNotSearch then
     1064    FindStyleElement;
     1065  //if "find"..use
     1066  if findStyleState <> fssNotFind then
     1067    for i:= Length(styleAttributes)-1 downto 0 do
     1068    begin
     1069      result:= GetInternal(styleAttributes[i].attr);
     1070      if result <> '' then
     1071        Break;
     1072    end;
     1073
     1074  if result = '' then
     1075    result:= GetInternal( Attribute['style',ADefault] );
     1076end;     
    4471077
    4481078function TSVGElement.GetStyle(const AName: string): string;
    449 var
    450     startPos, colonPos, valueLength: integer;
    451     ruleset: string;
    452 begin
    453   ruleset := Attribute['style'];
    454   LocateStyleDeclaration(ruleset, AName, startPos,colonPos, valueLength);
    455   if valueLength <> -1 then
    456   begin
    457     result := trim(copy(ruleset, colonPos+1, valueLength));
    458   end else
    459     result := '';
    460 end;
     1079begin
     1080  result:= GetStyle(AName,'');
     1081end;
    4611082
    4621083function TSVGElement.GetTransform: string;
    … …  
    4701091end;
    4711092
     1093function TSVGElement.GetVerticalAttributeWithUnit(AName: string; ADefault: TFloatWithCSSUnit): TFloatWithCSSUnit;
     1094begin
     1095  result := GetAttributeWithUnit(AName,ADefault);
     1096  if result.value <> EmptySingle then
     1097  begin
     1098    if result.CSSUnit <> cuCustom then
     1099      if units.DpiScaleY = 0 then
     1100        result.value := 0
     1101      else
     1102        result.value /= Units.DpiScaleY;
     1103  end;
     1104end;
     1105
    4721106function TSVGElement.GetVerticalAttributeWithUnit(AName: string): TFloatWithCSSUnit;
    4731107begin
    474   result := GetAttributeWithUnit(AName);
    475   if result.CSSUnit <> cuCustom then
    476     if units.DpiScaleY = 0 then
    477       result.value := 0
    478     else
    479       result.value /= Units.DpiScaleY;
    480 end;
     1108  result := GetVerticalAttributeWithUnit(AName,FloatWithCSSUnit(0,cuCustom));
     1109end; 
    4811110
    4821111function TSVGElement.GetDOMElement: TDOMElement;
    … …  
    4841113  result := FDomElem;
    4851114end;
     1115
     1116function TSVGElement.GetID: string;
     1117begin
     1118  result := Attribute['id'];
     1119end;
     1120
     1121function TSVGElement.GetClassAt: string;
     1122begin
     1123  result := Attribute['class'];
     1124end; 
    4861125
    4871126procedure TSVGElement.SetAttribute(AName: string; AValue: string);
    … …  
    5141153  RemoveStyle('fill-opacity');
    5151154end;
     1155
     1156procedure TSVGElement.SetFillRule(AValue: string);
     1157begin
     1158  Attribute['fill-rule'] := AValue;
     1159  RemoveStyle('fill-rule');
     1160end; 
    5161161
    5171162procedure TSVGElement.SetHorizAttributeWithUnit(AName: string;
    … …  
    6131258end;
    6141259
     1260procedure TSVGElement.SetStrokeDashArray(AValue: string);
     1261begin
     1262  Attribute['stroke-dasharray'] := AValue;
     1263end;
     1264
     1265procedure TSVGElement.SetStrokeDashArrayF(AValue: ArrayOfFloat);
     1266var
     1267  s: string;
     1268  i: integer;
     1269begin
     1270  s:= '';
     1271  for i := 0 to high(AValue) do
     1272  begin
     1273    if s <> '' then s += ' ';
     1274    s += TCSSUnitConverter.formatValue(AValue[i])+' ';
     1275  end;
     1276  strokeDashArray := s;
     1277end;
     1278
     1279procedure TSVGElement.SetStrokeDashOffset(AValue: TFloatWithCSSUnit);
     1280begin
     1281  OrthoAttributeWithUnit['stroke-dashoffset'] := AValue;
     1282end;     
     1283
    6151284procedure TSVGElement.SetStyle(AName: string; AValue: string);
    6161285var
    … …  
    6681337    SetHorizAttributeWithUnit(AName,AValue);
    6691338end;
     1339
     1340procedure TSVGElement.SetID(AValue: string);
     1341begin
     1342  Attribute['id'] := AValue;
     1343end;
     1344
     1345procedure TSVGElement.SetClassAt(AValue: string);
     1346begin
     1347  Attribute['class'] := AValue;
     1348end;
    6701349
    6711350procedure TSVGElement.Init(ADocument: TXMLDocument; ATag: string;
    … …  
    7481427end;
    7491428
     1429procedure TSVGElement.ApplyFillStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
     1430begin
     1431  ACanvas2D.fillStyle(fillColor);
     1432
     1433  ACanvas2D.fillMode := TFillMode(fillMode);
     1434end;   
     1435
    7501436procedure TSVGElement.ApplyStrokeStyle(ACanvas2D: TBGRACanvas2D; AUnit: TCSSUnit);
     1437var
     1438  a: ArrayOfFloat;
     1439  lw: single;
     1440  i: Integer;
    7511441begin
    7521442  ACanvas2d.strokeStyle(strokeColor);
    753   ACanvas2d.lineWidth := Units.ConvertWidth(strokeWidth,AUnit).value;
     1443  lw := Units.ConvertWidth(strokeWidth,AUnit).value;
     1444  ACanvas2d.lineWidth := lw;
    7541445  ACanvas2d.lineCap := strokeLineCap;
    7551446  ACanvas2d.lineJoin := strokeLineJoin;
    7561447  ACanvas2d.miterLimit := strokeMiterLimit;
     1448 
     1449  a:= strokeDashArrayF;
     1450  if (Length(a) <> 0) and (lw > 0) then
     1451  begin
     1452    for i := 0 to high(a) do
     1453      a[i] /= lw;
     1454    ACanvas2d.lineStyle(a);
     1455  end
     1456  else
     1457    ACanvas2d.lineStyle(psSolid);
     1458end;
     1459
     1460procedure TSVGElement.Initialize;
     1461begin
     1462  SetLength(styleAttributes,0);
     1463  findStyleState   := fssNotSearch;
     1464  FDataParent      := nil;
     1465  FDataChildList   := TSVGElementList.Create;
    7571466end;
    7581467
    7591468constructor TSVGElement.Create(ADocument: TXMLDocument; AElement: TDOMElement;
    760   AUnits: TCSSUnitConverter);
    761 begin
     1469  AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
     1470begin
     1471  FDataLink:= ADataLink;
     1472  Initialize;
    7621473  Init(ADocument,AElement,AUnits);
    7631474end;
    7641475
    7651476constructor TSVGElement.Create(ADocument: TXMLDocument;
    766   AUnits: TCSSUnitConverter);
    767 begin
    768   raise exception.Create('Cannot create a generic element');
     1477  AUnits: TCSSUnitConverter; ADataLink: TSVGDataLink);
     1478begin
     1479  FDataLink:= ADataLink;
     1480  Initialize;
     1481  //raise exception.Create('Cannot create a generic element');
     1482end;
     1483
     1484destructor TSVGElement.Destroy;
     1485begin
     1486  SetLength(styleAttributes,0);
     1487  FreeAndNil(FDataChildList);
     1488  inherited Destroy;
     1489end;
     1490
     1491procedure TSVGElement.Recompute;
     1492begin
     1493
    7691494end;
    7701495
    … …  
    8091534end;
    8101535
     1536function TSVGElement.HasAttribute(AName: string): boolean;
     1537begin
     1538  result := FDomElem.hasAttribute(AName);
     1539end;
     1540
     1541function TSVGElement.fillMode: TSVGFillMode;
     1542begin
     1543  if fillRule = 'evenodd' then
     1544    result := sfmEvenOdd
     1545  else
     1546    result := sfmNonZero;
     1547end;
     1548
     1549function TSVGElement.DataChildList: TSVGElementList;
     1550begin
     1551   result:= FDataChildList;
     1552end;
     1553
     1554function TSVGElement.FindStyleElementInternal(const classStr: string;
     1555  out attributesStr: string): integer;
     1556var
     1557  i: integer;
     1558begin
     1559  attributesStr:= '';
     1560  with FDataLink do
     1561    for i:= 0 to StyleCount-1 do
     1562    begin
     1563      result:= (Styles[i] as TSVGStyle).Find(classStr);
     1564      if result <> -1 then
     1565      begin
     1566        attributesStr:= (Styles[i] as TSVGStyle).Styles[result].attribute;
     1567        Exit;
     1568      end;
     1569    end;
     1570  result:= -1;
     1571end;
     1572
     1573procedure TSVGElement.FindStyleElement;
     1574
     1575  procedure AddStyle(const s: string; const id: integer);
     1576  var
     1577    l: integer;
     1578  begin
     1579    findStyleState:= fssFind;
     1580    l:= Length(styleAttributes);
     1581    SetLength(styleAttributes,l+1);
     1582    with styleAttributes[l] do
     1583    begin
     1584     attr:= s;
     1585     pos:= id;
     1586    end;
     1587  end;
     1588
     1589var
     1590  fid: integer;
     1591  tag,styleC,s: string;
     1592begin
     1593  findStyleState:= fssNotFind;
     1594  SetLength(styleAttributes,0);
     1595  tag:= FDomElem.TagName;
     1596  styleC:= classAt;
     1597  (*
     1598    if style element is:
     1599    <style>
     1600     circle.test{fill:red; fill-opacity: 0.8;}
     1601     circle{fill:blue; fill-opacity: 0.4;}
     1602     circle.style1{fill:yellow;}
     1603    </style>
     1604    and circle declare:
     1605    <circle class = "style1" cx="160" cy="160" r="35" stroke="black" />
     1606
     1607    styleAttributes[0] = 'fill:blue; fill-opacity: 0.4;'
     1608    styleAttributes[1] = 'fill:yellow;'
     1609
     1610    fill-opacity for "style1" = 0.4 not default 1!
     1611  *)
     1612
     1613  //Find as: "[tag]" example "circle"
     1614  fid:= FindStyleElementInternal(tag,s);
     1615  if fid <> -1 then
     1616    AddStyle(s,fid);
     1617  if styleC <> '' then
     1618  begin
     1619    //Find as: "[tag].[class]" example "circle.style1"
     1620    fid:= FindStyleElementInternal(tag+'.'+styleC,s);
     1621    if fid <> -1 then
     1622      AddStyle(s,fid)
     1623    else
     1624    begin
     1625      //Find as: ".[class]" example ".style1"
     1626      fid:= FindStyleElementInternal('.'+styleC,s);
     1627      if fid <> -1 then
     1628        AddStyle(s,fid);
     1629    end;
     1630  end;
     1631end;     
     1632
    8111633end.
    8121634
Note: See TracChangeset for help on using the changeset viewer.