3637 lines
105 KiB
ObjectPascal
3637 lines
105 KiB
ObjectPascal
|
{
|
||
|
|
Version 11.7
|
||
|
|
Copyright (c) 1995-2008 by L. David Baldwin,
|
||
|
|
Copyright (c) 2008-2016 by HtmlViewer Team
|
||
|
|
|
||
|
|
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
||
|
|
this software and associated documentation files (the "Software"), to deal in
|
||
|
|
the Software without restriction, including without limitation the rights to
|
||
|
|
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies
|
||
|
|
of the Software, and to permit persons to whom the Software is furnished to do
|
||
|
|
so, subject to the following conditions:
|
||
|
|
|
||
|
|
The above copyright notice and this permission notice shall be included in all
|
||
|
|
copies or substantial portions of the Software.
|
||
|
|
|
||
|
|
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||
|
|
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
|
||
|
|
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
|
||
|
|
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
|
||
|
|
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
|
||
|
|
CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
|
||
|
|
|
||
|
|
Note that the source modules HTMLGIF1.PAS and DITHERUNIT.PAS
|
||
|
|
are covered by separate copyright notices located in those modules.
|
||
|
|
}
|
||
|
|
|
||
|
|
{$I frxHTMLCons.inc}
|
||
|
|
|
||
|
|
unit frxHTMLStyleUn;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
{$ifdef LCL}
|
||
|
|
LclIntf, LclType, frxHTMLMisc,
|
||
|
|
{$else}
|
||
|
|
Windows,
|
||
|
|
{$endif}
|
||
|
|
Classes, Graphics, SysUtils, Math, Forms, Contnrs, Variants,
|
||
|
|
//
|
||
|
|
frxHTMLBuffer,
|
||
|
|
frxHTMLFonts,
|
||
|
|
frxHTMLGlobals,
|
||
|
|
frxHTMLSymb,
|
||
|
|
frxHTMLUn2,
|
||
|
|
frxHTMLStyleTypes;
|
||
|
|
|
||
|
|
const
|
||
|
|
CurColor_Val = 'currentColor';
|
||
|
|
CurColorStr = 'currentcolor';
|
||
|
|
varInt = [varInteger, varByte, varSmallInt, varShortInt, varWord, varLongWord, varInt64];
|
||
|
|
varFloat = [varSingle, varDouble, varCurrency];
|
||
|
|
varNum = varInt + varFloat;
|
||
|
|
CrLf = #$D#$A;
|
||
|
|
|
||
|
|
//BG, 16.09.2010: CSS2.2: same sizes like html font size:
|
||
|
|
|
||
|
|
const
|
||
|
|
FontConvBase: array[1..7] of Double = (8.0, 10.0, 12.0, 14.0, 18.0, 24.0, 36.0);
|
||
|
|
PreFontConvBase: array[1..7] of Double = (7.0, 8.0, 10.0, 12.0, 15.0, 20.0, 30.0);
|
||
|
|
|
||
|
|
var
|
||
|
|
FontConv: array[1..7] of Double;
|
||
|
|
PreFontConv: array[1..7] of Double;
|
||
|
|
|
||
|
|
type
|
||
|
|
// Notice: in ThtPropertyIndex order of rectangle properties required:
|
||
|
|
//
|
||
|
|
// Top, Right, Bottom, Left.
|
||
|
|
//
|
||
|
|
// Some code relies on this order.
|
||
|
|
//
|
||
|
|
ThtPropertyIndex = (
|
||
|
|
FontFamily, FontSize, FontStyle, FontWeight,
|
||
|
|
TextAlign, TextDirection, TextDecoration, LetterSpacing, Color,
|
||
|
|
|
||
|
|
// the below properties are in MarginArrays
|
||
|
|
BackgroundColor, BackgroundImage, BackgroundPosition, BackgroundRepeat, BackgroundAttachment,
|
||
|
|
piMinHeight, piMinWidth, piMaxHeight, piMaxWidth, BoxSizing,
|
||
|
|
MarginTop, MarginRight, MarginBottom, MarginLeft,
|
||
|
|
PaddingTop, PaddingRight, PaddingBottom, PaddingLeft,
|
||
|
|
BorderTopWidth, BorderRightWidth, BorderBottomWidth, BorderLeftWidth,
|
||
|
|
BorderTopColor, BorderRightColor, BorderBottomColor, BorderLeftColor,
|
||
|
|
BorderTopStyle, BorderRightStyle, BorderBottomStyle, BorderLeftStyle,
|
||
|
|
piWidth, piHeight, piTop, piRight, piBottom, piLeft,
|
||
|
|
BorderSpacingHorz, BorderSpacingVert, //These two are internal
|
||
|
|
// the above properties are in MarginArrays
|
||
|
|
|
||
|
|
Visibility, LineHeight, VerticalAlign, Position, ZIndex,
|
||
|
|
ListStyleType, ListStyleImage, Float, Clear, TextIndent,
|
||
|
|
PageBreakBefore, PageBreakAfter, PageBreakInside, TextTransform,
|
||
|
|
WordWrap, FontVariant, BorderCollapse, OverFlow, piDisplay, piEmptyCells,
|
||
|
|
piWhiteSpace,
|
||
|
|
|
||
|
|
// the below properties are short hands
|
||
|
|
MarginX, PaddingX, BorderWidthX, BorderX,
|
||
|
|
BorderTX, BorderRX, BorderBX, BorderLX,
|
||
|
|
FontX, BackgroundX, ListStyleX, BorderColorX,
|
||
|
|
BorderStyleX,
|
||
|
|
// the above properties are short hands
|
||
|
|
|
||
|
|
//the following have multiple values sometimes
|
||
|
|
BorderSpacing
|
||
|
|
//the above have multiple values sometimes
|
||
|
|
);
|
||
|
|
|
||
|
|
TShortHand = MarginX..BorderSpacing;//BorderStyleX;
|
||
|
|
|
||
|
|
ThtPropIndices = FontFamily..piWhiteSpace;
|
||
|
|
ThtPropertyArray = array [ThtPropIndices] of Variant;
|
||
|
|
ThtPropIndexSet = Set of ThtPropIndices;
|
||
|
|
|
||
|
|
ThtMarginIndices = BackgroundColor..BorderSpacingVert; //piLeft;
|
||
|
|
ThtVMarginArray = array [ThtMarginIndices] of Variant;
|
||
|
|
ThtMarginArray = array [ThtMarginIndices] of Integer;
|
||
|
|
|
||
|
|
const
|
||
|
|
PropWords: array [ThtPropertyIndex] of ThtString = (
|
||
|
|
'font-family', 'font-size', 'font-style', 'font-weight',
|
||
|
|
'text-align', 'dir', 'text-decoration', 'letter-spacing', 'color',
|
||
|
|
|
||
|
|
// these properties are in MarginArrays
|
||
|
|
'background-color', 'background-image', 'background-position', 'background-repeat', 'background-attachment',
|
||
|
|
'min-height', 'min-width', 'max-height', 'max-width', 'box-sizing',
|
||
|
|
'margin-top', 'margin-right', 'margin-bottom', 'margin-left',
|
||
|
|
'padding-top', 'padding-right', 'padding-bottom', 'padding-left',
|
||
|
|
'border-top-width', 'border-right-width', 'border-bottom-width', 'border-left-width',
|
||
|
|
'border-top-color', 'border-right-color', 'border-bottom-color', 'border-left-color',
|
||
|
|
'border-top-style', 'border-right-style', 'border-bottom-style', 'border-left-style',
|
||
|
|
'width', 'height', 'top', 'right', 'bottom', 'left',
|
||
|
|
'thv-border-spacing-horz', 'thv-border-spacing-vert', //These two are for internal use only
|
||
|
|
|
||
|
|
'visibility', 'line-height', 'vertical-align', 'position', 'z-index',
|
||
|
|
'list-style-type', 'list-style-image', 'float', 'clear', 'text-indent',
|
||
|
|
'page-break-before', 'page-break-after', 'page-break-inside', 'text-transform',
|
||
|
|
'word-wrap', 'font-variant', 'border-collapse', 'overflow', 'display', 'empty-cells',
|
||
|
|
'white-space',
|
||
|
|
|
||
|
|
// short hand names
|
||
|
|
'margin', 'padding', 'border-width', 'border',
|
||
|
|
'border-top', 'border-right', 'border-bottom', 'border-left',
|
||
|
|
'font', 'background', 'list-style', 'border-color',
|
||
|
|
'border-style',
|
||
|
|
//multiple values
|
||
|
|
'border-spacing'
|
||
|
|
);
|
||
|
|
|
||
|
|
type
|
||
|
|
TfrxHtStyleList = class;
|
||
|
|
TfrxHtPropStack = class;
|
||
|
|
|
||
|
|
TfrxHtProperties = class
|
||
|
|
private
|
||
|
|
FDefPointSize : Double;
|
||
|
|
PropStack: TfrxHtPropStack; // owner
|
||
|
|
TheFont: TfrxHtFont;
|
||
|
|
InLink: Boolean;
|
||
|
|
DefFontname: ThtString;
|
||
|
|
procedure AssignCodePage(const CP: Integer);
|
||
|
|
procedure CalcLinkFontInfo(Styles: TfrxHtStyleList; I: Integer);
|
||
|
|
procedure GetSingleFontInfo(var Font: TfrxHtFontInfo);
|
||
|
|
function GetFont: TfrxHtFont;
|
||
|
|
function GetEmSize: Integer;
|
||
|
|
function GetExSize: Integer;
|
||
|
|
public
|
||
|
|
PropSym: TElemSymb;
|
||
|
|
PropTag, PropClass, PropID, PropPseudo, PropTitle: ThtString;
|
||
|
|
PropStyle: TfrxHtProperties;
|
||
|
|
FontBG: TColor;
|
||
|
|
FCharSet: TFontCharSet;
|
||
|
|
FCodePage: Integer;
|
||
|
|
Props: ThtPropertyArray;
|
||
|
|
Originals: array[ThtPropIndices] of Boolean;
|
||
|
|
Important: array[ThtPropIndices] of Boolean;
|
||
|
|
FIObj: TFontInfoObj;
|
||
|
|
ID: Integer;
|
||
|
|
|
||
|
|
constructor Create; overload; // for use in style list only
|
||
|
|
constructor Create(APropStack: TfrxHtPropStack); overload; // for use in property stack
|
||
|
|
constructor CreateCopy(ASource: TfrxHtProperties);
|
||
|
|
destructor Destroy; override;
|
||
|
|
function Clone: TfrxHtProperties; virtual;
|
||
|
|
|
||
|
|
function BorderStyleNotBlank: Boolean;
|
||
|
|
function Collapse: Boolean;
|
||
|
|
function GetBackgroundColor: TColor;
|
||
|
|
function GetBackgroundImage(var Image: ThtString): Boolean;
|
||
|
|
function GetBorderStyle(Index: ThtPropIndices; var BorderStyle: ThtBorderStyle): Boolean;
|
||
|
|
function GetClear(var Clr: ThtClearStyle): Boolean;
|
||
|
|
function GetDisplay: ThtDisplayStyle; //BG, 15.09.2009
|
||
|
|
function GetFloat(var Align: ThtAlignmentStyle): Boolean;
|
||
|
|
function GetFontVariant: ThtString;
|
||
|
|
function GetLineHeight(NewHeight: Integer): Integer;
|
||
|
|
function GetListStyleImage: ThtString;
|
||
|
|
function GetListStyleType: ThtBulletStyle;
|
||
|
|
function GetOriginalForegroundColor: TColor;
|
||
|
|
function GetPosition: ThtBoxPositionStyle;
|
||
|
|
function GetTextIndent(out PC: Boolean): Integer;
|
||
|
|
function GetTextTransform: ThtTextTransformStyle;
|
||
|
|
function GetVertAlign(var Align: ThtAlignmentStyle): Boolean;
|
||
|
|
function GetVisibility: ThtVisibilityStyle;
|
||
|
|
function GetZIndex: Integer;
|
||
|
|
function HasBorderStyle: Boolean;
|
||
|
|
function HasBorderWidth: Boolean;
|
||
|
|
function IsOverflowHidden: Boolean;
|
||
|
|
function ShowEmptyCells: Boolean;
|
||
|
|
procedure AddPropertyByIndex(Index: ThtPropIndices; PropValue: ThtString; IsImportant: Boolean);
|
||
|
|
procedure AddPropertyByName(const PropName, PropValue: ThtString; IsImportant: Boolean);
|
||
|
|
procedure SetPropertyDefault(Index: ThtPropIndices; const Value: Variant);
|
||
|
|
procedure SetPropertyDefaults(Indexes: ThtPropIndexSet; const Value: Variant);
|
||
|
|
procedure Assign(const Item: Variant; Index: ThtPropIndices);
|
||
|
|
procedure AssignCharSetAndCodePage(CS: TFontCharset; CP: Integer);
|
||
|
|
procedure Combine(Styles: TfrxHtStyleList; Sym: TElemSymb; const Tag, AClass, AnID, Pseudo, ATitle: ThtString; AProp: TfrxHtProperties; Attributes: TfrxHtAttributeList; ParentIndexInPropStack: Integer); overload;
|
||
|
|
procedure Combine(Styles: TfrxHtStyleList; Sym: TElemSymb; const Tag, Pseudo: ThtString; Properties: TfrxHtProperties; Attributes: TfrxHtAttributeList; ParentIndexInPropStack: Integer); overload;
|
||
|
|
procedure Copy(Source: TfrxHtProperties);
|
||
|
|
procedure CopyDefault(Source: TfrxHtProperties);
|
||
|
|
procedure GetBackgroundPos(EmSize, ExSize: Integer; out P: PtPositionRec);
|
||
|
|
procedure GetFontInfo(AFI: TFontInfoObj);
|
||
|
|
procedure GetPageBreaks(out Before, After, Intact: Boolean);
|
||
|
|
function GetBoxSizing(var VBoxSizing : ThtBoxSizing) : Boolean;
|
||
|
|
function GetBorderSpacingHorz: Integer;
|
||
|
|
function GetBorderSpacingVert: Integer;
|
||
|
|
procedure GetVMarginArrayDefBorder(var MArray: ThtVMarginArray; const ADefColor : Variant);
|
||
|
|
procedure GetVMarginArray(var MArray: ThtVMarginArray);
|
||
|
|
function HasBorderSpacing: Boolean;
|
||
|
|
procedure Inherit(Tag: ThtString; Source: TfrxHtProperties);
|
||
|
|
procedure SetFontBG;
|
||
|
|
procedure Update(Source: TfrxHtProperties; Styles: TfrxHtStyleList; I: Integer);
|
||
|
|
//BG, 20.09.2009:
|
||
|
|
property Display: ThtDisplayStyle read GetDisplay;
|
||
|
|
property CharSet: TFontCharset read FCharSet write FCharSet;
|
||
|
|
property CodePage: Integer read FCodePage write AssignCodePage;
|
||
|
|
property DefPointSize : Double read FDefPointSize write FDefPointSize;
|
||
|
|
property EmSize: Integer read GetEmSize;
|
||
|
|
property ExSize: Integer read GetExSize;
|
||
|
|
property Font: TfrxHtFont read GetFont;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TfrxHtStyleList = class(ThtStringList)
|
||
|
|
private
|
||
|
|
SeqNo: Integer;
|
||
|
|
FDefProp: TfrxHtProperties;
|
||
|
|
protected
|
||
|
|
FDefPointSize : Double;
|
||
|
|
//this must be protected so that the property can be changed in
|
||
|
|
//a descendant while being read only.
|
||
|
|
procedure SetLinksActive(Value: Boolean); virtual; abstract;
|
||
|
|
property LinksActive: Boolean write SetLinksActive;
|
||
|
|
public
|
||
|
|
constructor Create; overload;
|
||
|
|
destructor Destroy; override;
|
||
|
|
function AddDuplicate(const Tag: ThtString; Prop: TfrxHtProperties): TfrxHtProperties;
|
||
|
|
function AddObject(const S: ThtString; AObject: TObject): Integer; override;
|
||
|
|
function GetSeqNo: ThtString;
|
||
|
|
procedure Clear; override;
|
||
|
|
procedure AddModifyProp(const Selector, Prop, Value: ThtString; IsImportant: Boolean);
|
||
|
|
procedure Initialize(const FontName, PreFontName: ThtString; PointSize: Double;
|
||
|
|
AColor, AHotspot, AVisitedColor, AActiveColor: TColor; LinkUnderline: Boolean;
|
||
|
|
ACodePage: TBuffCodePage; ACharSet: TFontCharSet; MarginHeight, MarginWidth: Integer);
|
||
|
|
procedure ModifyLinkColor(Pseudo: ThtString; AColor: TColor);
|
||
|
|
property DefProp: TfrxHtProperties read FDefProp;
|
||
|
|
property DefPointSize : Double read FDefPointSize write FDefPointSize;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TfrxHtPropStack = class(TObjectList)
|
||
|
|
private
|
||
|
|
function GetProp(Index: Integer): TfrxHtProperties; {$ifdef UseInline} inline; {$endif}
|
||
|
|
public
|
||
|
|
function Last: TfrxHtProperties; {$ifdef UseInline} inline; {$endif}
|
||
|
|
property Items[Index: Integer]: TfrxHtProperties read GetProp; default;
|
||
|
|
end;
|
||
|
|
|
||
|
|
type
|
||
|
|
ThtPropertyIndexes = set of ThtPropertyIndex;
|
||
|
|
|
||
|
|
ThtConvData = record
|
||
|
|
BaseWidth, BaseHeight: Integer;
|
||
|
|
EmSize, ExSize: Integer;
|
||
|
|
BorderWidth: Integer;
|
||
|
|
AutoCount: Integer;
|
||
|
|
IsAutoParagraph: ThtPropertyIndexes;
|
||
|
|
end;
|
||
|
|
|
||
|
|
const
|
||
|
|
IntNull = -12345678;
|
||
|
|
Auto = -12348765;
|
||
|
|
AutoParagraph = -12348766;
|
||
|
|
ParagraphSpace = 14; {default spacing between paragraphs, etc.}
|
||
|
|
ImageSpace = 3; {extra space for left, right images}
|
||
|
|
ListIndent = 40;
|
||
|
|
|
||
|
|
EastEurope8859_2 = 31; {for 8859-2}
|
||
|
|
|
||
|
|
|
||
|
|
// BG, 25.04.2012: Added:
|
||
|
|
function IsAuto(const Value: Variant): Boolean; {$ifdef UseInline} inline; {$endif}
|
||
|
|
|
||
|
|
//BG, 05.10.2010: added:
|
||
|
|
function VarIsIntNull(const Value: Variant): Boolean; {$ifdef UseInline} inline; {$endif}
|
||
|
|
function VarIsAuto(const Value: Variant): Boolean; {$ifdef UseInline} inline; {$endif}
|
||
|
|
|
||
|
|
function VMargToMarg(const Value: Variant; Relative: Boolean; Base, EmSize, ExSize, Default: Integer): Integer;
|
||
|
|
|
||
|
|
function ConvData(BaseWidth, BaseHeight, EmSize, ExSize, BorderWidth: Integer; AutoCount: Integer = 0): ThtConvData;
|
||
|
|
procedure ConvMargProp(I: ThtPropIndices; const VM: ThtVMarginArray; var ConvData: ThtConvData; var M: ThtMarginArray);
|
||
|
|
|
||
|
|
procedure ConvInlineMargArray(const VM: ThtVMarginArray; BaseWidth, BaseHeight, EmSize, ExSize, BorderWidth: Integer; {BStyle: ThtBorderStyle;} out M: ThtMarginArray);
|
||
|
|
procedure ConvMargArray(const VM: ThtVMarginArray; BaseWidth, BaseHeight, EmSize, ExSize, BorderWidth: Integer; out AutoCount: Integer; var M: ThtMarginArray);
|
||
|
|
procedure ConvMargArrayForCellPadding(const VM: ThtVMarginArray; EmSize, ExSize: Integer; var M: ThtMarginArray);
|
||
|
|
procedure ConvVertMargins(const VM: ThtVMarginArray; var CD: ThtConvData; var M: ThtMarginArray);
|
||
|
|
|
||
|
|
|
||
|
|
function OpacityFromStr(S : ThtString) : Byte;
|
||
|
|
|
||
|
|
function SortedColors: ThtStringList;
|
||
|
|
function TryStrToColor(S: ThtString; NeedPound: Boolean; out Color: TColor): Boolean;
|
||
|
|
function ColorAndOpacityFromString(S: ThtString; NeedPound: Boolean; out Color: TColor; out VOpacity : Byte): Boolean;
|
||
|
|
|
||
|
|
function ReadURL(Item: Variant): ThtString;
|
||
|
|
|
||
|
|
function LowerCaseUnquotedStr(const S : THtString) : THtString;
|
||
|
|
function RemoveQuotes(const S: ThtString): ThtString;
|
||
|
|
function ReadFontName(S: ThtString): ThtString;
|
||
|
|
|
||
|
|
procedure ApplyBoxWidthSettings(var AMarg: ThtMarginArray; var VMinWidth, VMaxWidth: Integer);
|
||
|
|
procedure ApplyBoxSettings(var AMarg: ThtMarginArray);
|
||
|
|
|
||
|
|
//here for inlining
|
||
|
|
function SkipWhiteSpace(const S: ThtString; I, L: Integer): Integer;
|
||
|
|
function FontSizeConv(const Str: ThtString; OldSize, DefPointSize: Double): Double;
|
||
|
|
function LengthConv(const Str: ThtString; Relative: Boolean; Base, EmSize, ExSize, Default: Integer): Integer;
|
||
|
|
|
||
|
|
procedure CalcAutoMinMaxConstraints(W, H, MinW, MaxW, MinH, MaxH: Integer; out ResW, ResH: Integer);
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
{$ifdef Compiler24_Plus}
|
||
|
|
System.UITypes,
|
||
|
|
{$endif}
|
||
|
|
frxSVGColor;
|
||
|
|
|
||
|
|
var
|
||
|
|
// DefPointSize: Double;
|
||
|
|
CharsetPerCharset: array [TFontCharset] of record Inited: Boolean; Charset: TFontCharset; end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 17.02.2011 --
|
||
|
|
function SkipWhiteSpace(const S: ThtString; I, L: Integer): Integer;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
while I <= L do
|
||
|
|
begin
|
||
|
|
case S[I] of
|
||
|
|
' ',
|
||
|
|
#10,
|
||
|
|
#12,
|
||
|
|
#13:;
|
||
|
|
else
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
Inc(I);
|
||
|
|
end;
|
||
|
|
Result := I;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 17.02.2011 --
|
||
|
|
function FindChar(const S: ThtString; C: ThtChar; I, L: Integer): Integer;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
while (I <= L) and (S[I] <> C) do
|
||
|
|
Inc(I);
|
||
|
|
Result := I;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------ReadURL}
|
||
|
|
|
||
|
|
function ReadURL(Item: Variant): ThtString;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
{
|
||
|
|
If Item is a string try to find and parse:
|
||
|
|
|
||
|
|
url( ["<url>"|'<url>'|<url>] )
|
||
|
|
|
||
|
|
and if successful return the <url>.
|
||
|
|
|
||
|
|
ReadURL tolerates
|
||
|
|
- any substring before url
|
||
|
|
- any substring after the (optionally quoted) <url>
|
||
|
|
- nested '(' ')' pairs even in the unquoted <url>
|
||
|
|
}
|
||
|
|
var
|
||
|
|
S: ThtString;
|
||
|
|
I, J, L, N: Integer;
|
||
|
|
Q: ThtChar;
|
||
|
|
begin
|
||
|
|
Result := '';
|
||
|
|
if VarIsStr(Item) then
|
||
|
|
begin
|
||
|
|
S := Item;
|
||
|
|
I := Pos('url(', S);
|
||
|
|
if I > 0 then
|
||
|
|
begin
|
||
|
|
L := Length(S);
|
||
|
|
|
||
|
|
// optional white spaces
|
||
|
|
I := SkipWhiteSpace(S, I + 4, L);
|
||
|
|
|
||
|
|
// optional quote char
|
||
|
|
Q := #0;
|
||
|
|
if I < L then
|
||
|
|
case S[I] of
|
||
|
|
'''', '"':
|
||
|
|
begin
|
||
|
|
Q := S[I];
|
||
|
|
Inc(I);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// read url
|
||
|
|
if Q <> #0 then
|
||
|
|
// up to quote char
|
||
|
|
J := FindChar(S, Q, I, L)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
// unquoted: up to whitespace or ')'
|
||
|
|
// beyond CSS: tolerate nested '(' ')' pairs as part of the name.
|
||
|
|
N := 0;
|
||
|
|
J := I;
|
||
|
|
while J <= L do
|
||
|
|
begin
|
||
|
|
case S[J] of
|
||
|
|
' ',
|
||
|
|
#10,
|
||
|
|
#12,
|
||
|
|
#13:
|
||
|
|
if N = 0 then
|
||
|
|
break;
|
||
|
|
|
||
|
|
'(':
|
||
|
|
Inc(N);
|
||
|
|
|
||
|
|
')':
|
||
|
|
begin
|
||
|
|
if N = 0 then
|
||
|
|
break;
|
||
|
|
Dec(N);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Inc(J);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result := Copy(S, I, J - I);
|
||
|
|
|
||
|
|
// ignore the rest: optional whitespaces and ')'
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 15.03.2011 --
|
||
|
|
var
|
||
|
|
PropertyStrings: ThtStringList;
|
||
|
|
|
||
|
|
function StyleProperties: ThtStringList;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var
|
||
|
|
I: ThtPropertyIndex;
|
||
|
|
begin
|
||
|
|
// Put the Properties into a sorted StringList for faster access.
|
||
|
|
if PropertyStrings = nil then
|
||
|
|
begin
|
||
|
|
PropertyStrings := ThtStringList.Create;
|
||
|
|
for I := Low(I) to High(I) do
|
||
|
|
PropertyStrings.AddObject(PropWords[I], Pointer(I));
|
||
|
|
PropertyStrings.Sort;
|
||
|
|
end;
|
||
|
|
Result := PropertyStrings;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 15.03.2011 --
|
||
|
|
function TryStrToPropIndex(const PropWord: ThtString; var PropIndex: ThtPropIndices): Boolean;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
P: ThtPropertyIndex;
|
||
|
|
begin
|
||
|
|
I := StyleProperties.IndexOf(PropWord);
|
||
|
|
Result := I >= 0;
|
||
|
|
if Result then
|
||
|
|
begin
|
||
|
|
P := ThtPropertyIndex(StyleProperties.Objects[I]);
|
||
|
|
Result := P in [Low(ThtPropIndices)..High(ThtPropIndices)];
|
||
|
|
if Result then
|
||
|
|
PropIndex := P;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
Sequence: Integer;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.Create}
|
||
|
|
|
||
|
|
constructor TfrxHtProperties.Create;
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
ID := Sequence;
|
||
|
|
Inc(Sequence);
|
||
|
|
FontBG := clNone;
|
||
|
|
for I := MarginTop to BorderSpacingVert do
|
||
|
|
Props[I] := IntNull;
|
||
|
|
Props[ZIndex] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 12.09.2010 --
|
||
|
|
constructor TfrxHtProperties.Create(APropStack: TfrxHtPropStack);
|
||
|
|
begin
|
||
|
|
Create;
|
||
|
|
Self.PropStack := APropStack;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 21.10.2016 --
|
||
|
|
function TfrxHtProperties.Clone: TfrxHtProperties;
|
||
|
|
begin
|
||
|
|
Result := TfrxHtProperties.CreateCopy(Self);
|
||
|
|
|
||
|
|
Result.Props := Props;
|
||
|
|
Result.Originals := Originals;
|
||
|
|
Result.Important := Important;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 20.01.2013 --
|
||
|
|
constructor TfrxHtProperties.CreateCopy(ASource: TfrxHtProperties);
|
||
|
|
begin
|
||
|
|
FDefPointSize := ASource.DefPointSize;
|
||
|
|
PropStack := ASource.PropStack ;
|
||
|
|
InLink := ASource.InLink ;
|
||
|
|
DefFontname := ASource.DefFontname ;
|
||
|
|
PropTag := ASource.PropTag ;
|
||
|
|
PropClass := ASource.PropClass ;
|
||
|
|
PropID := ASource.PropID ;
|
||
|
|
PropPseudo := ASource.PropPseudo ;
|
||
|
|
PropTitle := ASource.PropTitle ;
|
||
|
|
PropStyle := ASource.PropStyle ;
|
||
|
|
FontBG := ASource.FontBG ;
|
||
|
|
FCharSet := ASource.FCharSet ;
|
||
|
|
FCodePage := ASource.FCodePage ;
|
||
|
|
Props := ASource.Props ;
|
||
|
|
Originals := ASource.Originals ;
|
||
|
|
ID := ASource.ID ;
|
||
|
|
if ASource.FIObj <> nil then
|
||
|
|
begin
|
||
|
|
FIObj := TFontInfoObj.Create;
|
||
|
|
FIObj.Assign(ASource.FIObj);
|
||
|
|
end;
|
||
|
|
if ASource.TheFont <> nil then
|
||
|
|
begin
|
||
|
|
TheFont := TfrxHtFont.Create;
|
||
|
|
TheFont.Assign(ASource.TheFont);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TfrxHtProperties.Destroy;
|
||
|
|
begin
|
||
|
|
TheFont.Free;
|
||
|
|
FIObj.Free;
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.Copy}
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.Copy(Source: TfrxHtProperties);
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
FDefPointSize := Source.DefPointSize;
|
||
|
|
for I := Low(I) to High(I) do
|
||
|
|
Props[I] := Source.Props[I];
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.CopyDefault}
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.CopyDefault(Source: TfrxHtProperties);
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
for I := Low(I) to High(I) do
|
||
|
|
Props[I] := Source.Props[I];
|
||
|
|
CodePage := Source.CodePage;
|
||
|
|
DefFontname := Source.DefFontname;
|
||
|
|
FDefPointSize := Source.DefPointSize;
|
||
|
|
PropTag := 'default';
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.Inherit(Tag: ThtString; Source: TfrxHtProperties);
|
||
|
|
{copy the properties that are inheritable}
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
Span, HBF: Boolean;
|
||
|
|
isTable: Boolean;
|
||
|
|
begin
|
||
|
|
Span := Source.PropTag = 'span';
|
||
|
|
HBF := (Source.PropTag = 'thead') or (Source.PropTag = 'tbody') or (Source.PropTag = 'tfoot');
|
||
|
|
isTable := Tag = 'table';
|
||
|
|
for I := Low(I) to High(I) do
|
||
|
|
if Span {and (I <> BorderStyle)} then {Borderstyle already acted on}
|
||
|
|
Props[I] := Source.Props[I]
|
||
|
|
else if HBF then
|
||
|
|
begin
|
||
|
|
Props[I] := Source.Props[I]; {tr gets them all}
|
||
|
|
Originals[I] := Source.Originals[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
case I of
|
||
|
|
MarginTop..BorderLeftStyle,
|
||
|
|
piMinHeight, piMinWidth,
|
||
|
|
piMaxHeight, piMaxWidth,
|
||
|
|
piWidth, piHeight,
|
||
|
|
piTop..piLeft:
|
||
|
|
Props[I] := IntNull;
|
||
|
|
|
||
|
|
WordWrap:
|
||
|
|
if isTable then
|
||
|
|
Props[I] := 'normal'
|
||
|
|
else
|
||
|
|
Props[I] := Source.Props[I];
|
||
|
|
|
||
|
|
BackgroundColor, BackgroundImage, BackgroundPosition,
|
||
|
|
BackgroundRepeat, BackgroundAttachment,
|
||
|
|
//BorderColor, BorderStyle,
|
||
|
|
BorderCollapse,
|
||
|
|
PageBreakBefore, PageBreakAfter, PageBreakInside,
|
||
|
|
Clear, Float, Position, OverFlow, piDisplay:
|
||
|
|
; {do nothing}
|
||
|
|
else
|
||
|
|
Props[I] := Source.Props[I];
|
||
|
|
end;
|
||
|
|
DefPointSize := Source.DefPointSize;
|
||
|
|
DefFontname := Source.DefFontname;
|
||
|
|
FontBG := Source.FontBG;
|
||
|
|
CodePage := Source.CodePage;
|
||
|
|
PropTitle := Source.PropTitle;
|
||
|
|
InLink := Source.InLink;
|
||
|
|
if InLink then
|
||
|
|
begin
|
||
|
|
if not Assigned(FIObj) then
|
||
|
|
FIObj := TFontInfoObj.Create;
|
||
|
|
FIObj.Assign(Source.FIObj);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.Update}
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.Update(Source: TfrxHtProperties; Styles: TfrxHtStyleList; I: Integer);
|
||
|
|
{Change the inherited properties for this item to those of Source}
|
||
|
|
var
|
||
|
|
Index: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
for Index := Low(Index) to High(Index) do
|
||
|
|
if not Originals[Index] then
|
||
|
|
Props[Index] := Source.Props[Index];
|
||
|
|
FreeAndNil(TheFont); {may no longer be good}
|
||
|
|
if Assigned(FIObj) then
|
||
|
|
if Source.Inlink then
|
||
|
|
FIObj.Assign(Source.FIObj)
|
||
|
|
else if PropPseudo = 'link' then {an <a href> tag}
|
||
|
|
CalcLinkFontInfo(Styles, I)
|
||
|
|
else
|
||
|
|
begin {an <a href> tag has been removed}
|
||
|
|
FreeAndNil(FIObj);
|
||
|
|
Inlink := False;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.Assign}
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.Assign(const Item: Variant; Index: ThtPropIndices);
|
||
|
|
{Assignment should be made in order of importance as the first one in
|
||
|
|
predominates}
|
||
|
|
begin
|
||
|
|
if not Originals[Index] then
|
||
|
|
begin
|
||
|
|
Props[Index] := Item;
|
||
|
|
Originals[Index] := True;
|
||
|
|
if InLink then
|
||
|
|
case Index of
|
||
|
|
Color:
|
||
|
|
FIObj.Info.iColor := Item;
|
||
|
|
FontSize:
|
||
|
|
FIObj.Info.iSize := Item;
|
||
|
|
FontFamily:
|
||
|
|
FIObj.Info.iName := Item;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetBackgroundImage(var Image: ThtString): Boolean;
|
||
|
|
begin
|
||
|
|
if (VarIsStr(Props[BackgroundImage])) then
|
||
|
|
if (Props[BackgroundImage] = 'none') then
|
||
|
|
begin
|
||
|
|
Image := '';
|
||
|
|
Result := True;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Image := ReadUrl(Props[BackgroundImage]);
|
||
|
|
Result := Image <> '';
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//procedure TfrxHtProperties.AssignCharSet(CS: TFontCharset);
|
||
|
|
//begin
|
||
|
|
// AssignCharSetAndCodePage(CS, CharSetToCodePage(CS));
|
||
|
|
//end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 30.01.2011 --
|
||
|
|
function TranslateCharset(CS: TFontCharset): TFontCharset;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
// extracted from TfrxHtProperties.AssignCharSetAndCodePage()
|
||
|
|
var
|
||
|
|
Save: HFONT;
|
||
|
|
tm: TTextmetric;
|
||
|
|
DC: HDC;
|
||
|
|
Font: TFont;
|
||
|
|
begin
|
||
|
|
if not CharsetPerCharset[CS].Inited then
|
||
|
|
begin
|
||
|
|
{the following makes sure the CharSet is available}
|
||
|
|
CharsetPerCharset[CS].Inited := True;
|
||
|
|
CharsetPerCharset[CS].Charset := CS;
|
||
|
|
Font := TFont.Create;
|
||
|
|
try
|
||
|
|
Font.Name := '';
|
||
|
|
Font.CharSet := CS;
|
||
|
|
DC := GetDC(0);
|
||
|
|
try
|
||
|
|
Save := SelectObject(DC, Font.Handle);
|
||
|
|
try
|
||
|
|
GetTextMetrics(DC, tm);
|
||
|
|
CharsetPerCharset[CS].Charset := tm.tmCharSet;
|
||
|
|
finally
|
||
|
|
SelectObject(DC, Save);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
ReleaseDC(0, DC);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
Font.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result := CharsetPerCharset[CS].Charset;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 25.12.2010 --
|
||
|
|
procedure TfrxHtProperties.AssignCharSetAndCodePage(CS: TFontCharset; CP: Integer);
|
||
|
|
begin
|
||
|
|
if (FCharSet <> CS) or (FCodePage <> CP) then
|
||
|
|
begin
|
||
|
|
case CS of
|
||
|
|
EastEurope8859_2:
|
||
|
|
FCharSet := TranslateCharset(EASTEUROPE_CHARSET);
|
||
|
|
|
||
|
|
DEFAULT_CHARSET:
|
||
|
|
FCharSet := CS;
|
||
|
|
else
|
||
|
|
FCharSet := TranslateCharset(CS);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if Assigned(FIObj) then
|
||
|
|
FIObj.Info.iCharset := CharSet;
|
||
|
|
|
||
|
|
FCodePage := CP;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.AssignCodePage(const CP: Integer);
|
||
|
|
begin
|
||
|
|
case CP of
|
||
|
|
CP_UTF8,
|
||
|
|
CP_UTF16LE,
|
||
|
|
CP_UTF16BE:
|
||
|
|
AssignCharSetAndCodePage(DEFAULT_CHARSET, CP);
|
||
|
|
else
|
||
|
|
AssignCharSetAndCodePage(CodePageToCharSet(CP), CP);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.GetBackgroundPos}
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.GetBackgroundPos(EmSize, ExSize: Integer; out P: PtPositionRec);
|
||
|
|
var
|
||
|
|
S: array[1..2] of ThtString;
|
||
|
|
Tmp: ThtString;
|
||
|
|
I, N, XY: Integer;
|
||
|
|
PXY: PPositionRec;
|
||
|
|
begin
|
||
|
|
//BG, 29.08.2009: thanks to SourceForge user 'bolex': 'not' was missing.
|
||
|
|
if (not VarIsStr(Props[BackgroundPosition])) then
|
||
|
|
begin
|
||
|
|
P.X.PosType := bpDim;
|
||
|
|
P.X.Value := 0;
|
||
|
|
P.Y := P.X;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Tmp := Trim(Props[BackgroundPosition]);
|
||
|
|
N := Pos(' ', Tmp);
|
||
|
|
if N > 0 then
|
||
|
|
begin
|
||
|
|
S[1] := System.Copy(Tmp, 1, N - 1);
|
||
|
|
S[2] := Trim(system.Copy(Tmp, N + 1, 255));
|
||
|
|
N := 2;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
S[1] := Tmp;
|
||
|
|
N := 1;
|
||
|
|
end;
|
||
|
|
I := 1;
|
||
|
|
XY := 1; {X}
|
||
|
|
while I <= N do
|
||
|
|
begin
|
||
|
|
if XY = 1 then
|
||
|
|
PXY := @P.X
|
||
|
|
else
|
||
|
|
PXY := @P.Y;
|
||
|
|
PXY.PosType := bpDim;
|
||
|
|
if S[I] = 'center' then
|
||
|
|
PXY.PosType := bpCenter
|
||
|
|
else if Pos('%', S[I]) > 0 then
|
||
|
|
PXY.PosType := bpPercent
|
||
|
|
else if S[I] = 'left' then
|
||
|
|
begin
|
||
|
|
if XY = 2 then {entered in reverse direction}
|
||
|
|
P.Y := P.X;
|
||
|
|
P.X.PosType := bpLeft;
|
||
|
|
end
|
||
|
|
else if S[I] = 'right' then
|
||
|
|
begin
|
||
|
|
if XY = 2 then
|
||
|
|
P.Y := P.X;
|
||
|
|
P.X.PosType := bpRight;
|
||
|
|
end
|
||
|
|
else if S[I] = 'top' then
|
||
|
|
begin
|
||
|
|
P.Y.PosType := bpTop;
|
||
|
|
if XY = 1 then
|
||
|
|
Dec(XY); {read next one into X}
|
||
|
|
end
|
||
|
|
else if S[I] = 'bottom' then
|
||
|
|
begin
|
||
|
|
P.Y.PosType := bpBottom;
|
||
|
|
if XY = 1 then
|
||
|
|
Dec(XY);
|
||
|
|
end;
|
||
|
|
if PXY.PosType in [bpDim, bpPercent] then
|
||
|
|
begin
|
||
|
|
PXY.Value := LengthConv(S[I], False, 100, EmSize, ExSize, 0);
|
||
|
|
end;
|
||
|
|
Inc(I);
|
||
|
|
Inc(XY);
|
||
|
|
end;
|
||
|
|
if N = 1 then
|
||
|
|
if XY = 2 then
|
||
|
|
P.Y.PosType := bpCenter
|
||
|
|
else
|
||
|
|
P.X.PosType := bpCenter; {single entry but it was a Y}
|
||
|
|
end;
|
||
|
|
P.X.RepeatD := True;
|
||
|
|
P.Y.RepeatD := True;
|
||
|
|
if (VarIsStr(Props[BackgroundRepeat])) then
|
||
|
|
begin
|
||
|
|
Tmp := Trim(Props[BackgroundRepeat]);
|
||
|
|
if Tmp = 'no-repeat' then
|
||
|
|
begin
|
||
|
|
P.X.RepeatD := False;
|
||
|
|
P.Y.RepeatD := False;
|
||
|
|
end
|
||
|
|
else if Tmp = 'repeat-x' then
|
||
|
|
P.Y.RepeatD := False
|
||
|
|
else if Tmp = 'repeat-y' then
|
||
|
|
P.X.RepeatD := False;
|
||
|
|
end;
|
||
|
|
P.X.Fixed := False;
|
||
|
|
if (VarIsStr(Props[BackgroundAttachment])) and
|
||
|
|
(Trim(Props[BackgroundAttachment]) = 'fixed') then
|
||
|
|
P.X.Fixed := True;
|
||
|
|
P.Y.Fixed := P.X.Fixed;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetVertAlign(var Align: ThtAlignmentStyle): Boolean;
|
||
|
|
{note: 'top' should have a catagory of its own}
|
||
|
|
var
|
||
|
|
S: ThtString;
|
||
|
|
begin
|
||
|
|
if (VarIsStr(Props[VerticalAlign])) then
|
||
|
|
begin
|
||
|
|
Result := True;
|
||
|
|
S := Props[VerticalAlign];
|
||
|
|
if (S = 'top') or (S = 'text-top') then
|
||
|
|
Align := ATop
|
||
|
|
else if S = 'middle' then
|
||
|
|
Align := AMiddle
|
||
|
|
else if S = 'baseline' then
|
||
|
|
Align := ABaseline
|
||
|
|
else if (S = 'bottom') then
|
||
|
|
Align := ABottom
|
||
|
|
else if (S = 'sub') then
|
||
|
|
Align := ASub
|
||
|
|
else if (S = 'super') then
|
||
|
|
Align := ASuper
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.IsOverflowHidden: Boolean;
|
||
|
|
begin
|
||
|
|
Result := (VarIsStr(Props[OverFlow])) and (Props[OverFlow] = 'hidden');
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetFloat(var Align: ThtAlignmentStyle): Boolean;
|
||
|
|
var
|
||
|
|
S: ThtString;
|
||
|
|
begin
|
||
|
|
if (VarIsStr(Props[Float])) then
|
||
|
|
begin
|
||
|
|
Result := True;
|
||
|
|
S := Props[Float];
|
||
|
|
if S = 'left' then
|
||
|
|
Align := aLeft
|
||
|
|
else if S = 'right' then
|
||
|
|
Align := aRight
|
||
|
|
else if S = 'none' then
|
||
|
|
Align := aNone
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetClear(var Clr: ThtClearStyle): Boolean;
|
||
|
|
var
|
||
|
|
S: ThtString;
|
||
|
|
begin
|
||
|
|
if (VarIsStr(Props[Clear])) then
|
||
|
|
begin
|
||
|
|
S := Props[Clear];
|
||
|
|
Result := TryStrToClearStyle(S, Clr);
|
||
|
|
//Props[Clear] := Unassigned; {allow only one read}
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 15.09.2009 --
|
||
|
|
function TfrxHtProperties.GetDisplay: ThtDisplayStyle;
|
||
|
|
begin
|
||
|
|
if VarIsStr(Props[piDisplay]) then
|
||
|
|
if TryStrToDisplayStyle(Props[piDisplay], Result) then
|
||
|
|
exit;
|
||
|
|
Result := pdUnassigned;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 21.09.2016 --
|
||
|
|
function TfrxHtProperties.GetEmSize: Integer;
|
||
|
|
begin
|
||
|
|
Result := Font.EmSize;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 21.09.2016 --
|
||
|
|
function TfrxHtProperties.GetExSize: Integer;
|
||
|
|
begin
|
||
|
|
Result := Font.ExSize;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 16.04.2011 --
|
||
|
|
function TfrxHtProperties.GetListStyleType: ThtBulletStyle;
|
||
|
|
begin
|
||
|
|
if VarIsStr(Props[ListStyleType]) then
|
||
|
|
if TryStrToBulletStyle(Props[ListStyleType], Result) then
|
||
|
|
Exit;
|
||
|
|
Result := lbBlank;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetListStyleImage: ThtString;
|
||
|
|
begin
|
||
|
|
Result := ReadURL(Props[ListStyleImage])
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetPosition: ThtBoxPositionStyle;
|
||
|
|
begin
|
||
|
|
Result := posStatic;
|
||
|
|
if VarIsStr(Props[Position]) then
|
||
|
|
begin
|
||
|
|
if Props[Position] = 'absolute' then
|
||
|
|
Result := posAbsolute
|
||
|
|
else if Props[Position] = 'fixed' then
|
||
|
|
Result := posFixed
|
||
|
|
else if Props[Position] = 'relative' then
|
||
|
|
Result := posRelative;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetVisibility: ThtVisibilityStyle;
|
||
|
|
begin
|
||
|
|
Result := viVisible;
|
||
|
|
if VarType(Props[Visibility]) in varInt then
|
||
|
|
if Props[Visibility] = viHidden then
|
||
|
|
Result := viHidden;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetZIndex: Integer;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
if VarType(Props[ZIndex]) in VarInt then
|
||
|
|
Result := Props[ZIndex]
|
||
|
|
else if VarIsStr(Props[ZIndex]) then
|
||
|
|
Result := StrToIntDef(Props[ZIndex], 0);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 15.10.2010 --
|
||
|
|
function TfrxHtProperties.HasBorderWidth: Boolean;
|
||
|
|
begin
|
||
|
|
Result := not (VarIsIntNull(Props[BorderTopWidth]) or VarIsEmpty(Props[BorderTopWidth]))
|
||
|
|
or not (VarIsIntNull(Props[BorderRightWidth]) or VarIsEmpty(Props[BorderRightWidth]))
|
||
|
|
or not (VarIsIntNull(Props[BorderBottomWidth]) or VarIsEmpty(Props[BorderBottomWidth]))
|
||
|
|
or not (VarIsIntNull(Props[BorderLeftWidth]) or VarIsEmpty(Props[BorderLeftWidth]));
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.Collapse: Boolean;
|
||
|
|
begin
|
||
|
|
Result := (VarIsStr(Props[BorderCollapse])) and (Props[BorderCollapse] = 'collapse');
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetLineHeight(NewHeight: Integer): Integer;
|
||
|
|
var
|
||
|
|
V: Double;
|
||
|
|
Code: Integer;
|
||
|
|
begin
|
||
|
|
if VarIsStr(Props[LineHeight]) then
|
||
|
|
begin
|
||
|
|
Val(Props[LineHeight], V, Code);
|
||
|
|
if Code = 0 then {a numerical entry with no 'em', '%', etc. Use the new font height}
|
||
|
|
Result := Round(V * NewHeight)
|
||
|
|
else
|
||
|
|
{note: 'normal' yields -1 in the next statement}
|
||
|
|
Result := LengthConv(Props[LineHeight], True, EmSize, EmSize, ExSize, -1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetTextIndent(out PC: Boolean): Integer;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
PC := False;
|
||
|
|
if VarIsStr(Props[TextIndent]) then
|
||
|
|
begin
|
||
|
|
I := Pos('%', Props[TextIndent]);
|
||
|
|
if I > 0 then
|
||
|
|
begin
|
||
|
|
PC := True; {return value in percent}
|
||
|
|
Result := LengthConv(Props[TextIndent], True, 100, 0, 0, 0);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := LengthConv(Props[TextIndent], False, 0, EmSize, EmSize, 0);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetTextTransform: ThtTextTransformStyle;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
if VarType(Props[TextTransform]) in VarInt then
|
||
|
|
Result := Props[TextTransform]
|
||
|
|
else
|
||
|
|
Result := txNone;
|
||
|
|
except
|
||
|
|
Result := txNone;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetFontVariant: ThtString;
|
||
|
|
begin
|
||
|
|
try
|
||
|
|
if VarIsStr(Props[FontVariant]) then
|
||
|
|
Result := Props[FontVariant]
|
||
|
|
else
|
||
|
|
Result := 'normal';
|
||
|
|
except
|
||
|
|
Result := 'normal';
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.GetPageBreaks(out Before, After, Intact: Boolean);
|
||
|
|
begin
|
||
|
|
Before := (VarIsStr(Props[PageBreakBefore])) and (Props[PageBreakBefore] = 'always');
|
||
|
|
After := (VarIsStr(Props[PageBreakAfter])) and (Props[PageBreakAfter] = 'always');
|
||
|
|
Intact := (VarIsStr(Props[PageBreakInside])) and (Props[PageBreakInside] = 'avoid');
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetBackgroundColor: TColor;
|
||
|
|
begin
|
||
|
|
if (VarType(Props[BackgroundColor]) in varInt) and Originals[BackgroundColor] then
|
||
|
|
{Originals to prevent fonts from getting inherited background color}
|
||
|
|
Result := Props[BackgroundColor]
|
||
|
|
else
|
||
|
|
Result := clNone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetOriginalForegroundColor: TColor;
|
||
|
|
begin {return a color only if it hasn't been inherited}
|
||
|
|
if (VarType(Props[Color]) in varInt) and Originals[Color] then
|
||
|
|
Result := Props[Color]
|
||
|
|
else
|
||
|
|
Result := clNone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 12.03.2011 --
|
||
|
|
function TfrxHtProperties.GetBorderStyle(Index: ThtPropIndices; var BorderStyle: ThtBorderStyle): Boolean;
|
||
|
|
// Returns True, if there is a valid border style property.
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
if VarIsStr(Props[Index]) then
|
||
|
|
Result := TryStrToBorderStyle(Props[Index], BorderStyle)
|
||
|
|
else if VarType(Props[Index]) in varInt then
|
||
|
|
if (Props[Index] >= Low(ThtBorderStyle)) and (Props[Index] <= High(ThtBorderStyle)) then
|
||
|
|
begin
|
||
|
|
BorderStyle := ThtBorderStyle(Props[Index]);
|
||
|
|
Result := True;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetBoxSizing(var VBoxSizing: ThtBoxSizing): Boolean;
|
||
|
|
begin
|
||
|
|
Result := TryStrToBoxSizing(Props[BoxSizing], VBoxSizing);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.BorderStyleNotBlank: Boolean;
|
||
|
|
{was a border of some type (including bssNone) requested?}
|
||
|
|
var
|
||
|
|
Dummy: ThtBorderStyle;
|
||
|
|
begin
|
||
|
|
Dummy := bssNone;
|
||
|
|
Result :=
|
||
|
|
GetBorderStyle(BorderTopStyle, Dummy) or
|
||
|
|
GetBorderStyle(BorderRightStyle, Dummy) or
|
||
|
|
GetBorderStyle(BorderBottomStyle, Dummy) or
|
||
|
|
GetBorderStyle(BorderLeftStyle, Dummy);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 12.03.2011 --
|
||
|
|
function TfrxHtProperties.HasBorderStyle: Boolean;
|
||
|
|
// Returns True, if at least one border has a style.
|
||
|
|
var
|
||
|
|
Dummy: ThtBorderStyle;
|
||
|
|
begin
|
||
|
|
Dummy := bssNone;
|
||
|
|
|
||
|
|
GetBorderStyle(BorderTopStyle, Dummy);
|
||
|
|
Result := Dummy <> bssNone;
|
||
|
|
if Result then
|
||
|
|
exit;
|
||
|
|
|
||
|
|
GetBorderStyle(BorderRightStyle, Dummy);
|
||
|
|
Result := Dummy <> bssNone;
|
||
|
|
if Result then
|
||
|
|
exit;
|
||
|
|
|
||
|
|
GetBorderStyle(BorderBottomStyle, Dummy);
|
||
|
|
Result := Dummy <> bssNone;
|
||
|
|
if Result then
|
||
|
|
exit;
|
||
|
|
|
||
|
|
GetBorderStyle(BorderLeftStyle, Dummy);
|
||
|
|
Result := Dummy <> bssNone;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetBorderSpacingHorz: Integer;
|
||
|
|
var
|
||
|
|
V: Double;
|
||
|
|
Code: Integer;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if VarIsStr(Props[BorderSpacingHorz]) then
|
||
|
|
begin
|
||
|
|
Val(Props[BorderSpacingHorz], V, Code);
|
||
|
|
if Code = 0 then {a numerical entry with no 'em', '%', etc. }
|
||
|
|
Result := Round(V)
|
||
|
|
else
|
||
|
|
{note: 'normal' yields -1 in the next statement}
|
||
|
|
Result := LengthConv(Props[BorderSpacingHorz], True, EmSize, EmSize, ExSize, -1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetBorderSpacingVert: Integer;
|
||
|
|
var
|
||
|
|
V: Double;
|
||
|
|
Code: Integer;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if VarIsStr(Props[BorderSpacingVert]) then
|
||
|
|
begin
|
||
|
|
Val(Props[BorderSpacingVert], V, Code);
|
||
|
|
if Code = 0 then {a numerical entry with no 'em', '%', etc. }
|
||
|
|
Result := Round(V)
|
||
|
|
else
|
||
|
|
{note: 'normal' yields -1 in the next statement}
|
||
|
|
Result := LengthConv(Props[BorderSpacingVert], True, EmSize, EmSize, ExSize, -1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.HasBorderSpacing: Boolean;
|
||
|
|
begin
|
||
|
|
Result := not (VarIsIntNull(Props[BorderSpacingHorz]) or VarIsEmpty(Props[BorderSpacingHorz]));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.SetFontBG;
|
||
|
|
{called for font tags like <b>, <small>, etc. Sets the font background color.}
|
||
|
|
begin
|
||
|
|
if (VarType(Props[BackgroundColor]) in varInt) and Originals[BackgroundColor] then
|
||
|
|
FontBG := Props[BackgroundColor];
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 20.01.2013 --
|
||
|
|
procedure TfrxHtProperties.SetPropertyDefault(Index: ThtPropIndices; const Value: Variant);
|
||
|
|
begin
|
||
|
|
if (Props[Index] = Unassigned) or ((VarType(Props[Index]) in varInt) and (Props[Index] = IntNull)) then
|
||
|
|
Props[Index] := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 20.01.2013 --
|
||
|
|
procedure TfrxHtProperties.SetPropertyDefaults(Indexes: ThtPropIndexSet; const Value: Variant);
|
||
|
|
var
|
||
|
|
Index: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
for Index := Low(Index) to High(Index) do
|
||
|
|
if Index in Indexes then
|
||
|
|
SetPropertyDefault(Index, Value);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 23.11.2009 --
|
||
|
|
function TfrxHtProperties.ShowEmptyCells: Boolean;
|
||
|
|
begin
|
||
|
|
Result := not (VarIsStr(Props[piEmptyCells]) and (Props[piEmptyCells] = 'hide'));
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ConvVertMargins(const VM: ThtVMarginArray; var CD: ThtConvData; var M: ThtMarginArray);
|
||
|
|
begin
|
||
|
|
ConvMargProp(PaddingTop, VM, CD, M);
|
||
|
|
ConvMargProp(BorderTopWidth, VM, CD, M);
|
||
|
|
ConvMargProp(MarginTop, VM, CD, M);
|
||
|
|
ConvMargProp(piHeight, VM, CD, M);
|
||
|
|
ConvMargProp(piMinHeight, VM, CD, M);
|
||
|
|
ConvMargProp(piMaxHeight, VM, CD, M);
|
||
|
|
ConvMargProp(MarginBottom, VM, CD, M);
|
||
|
|
ConvMargProp(BorderBottomWidth, VM, CD, M);
|
||
|
|
ConvMargProp(PaddingBottom, VM, CD, M);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 25.04.2012 --
|
||
|
|
function IsAuto(const Value: Variant): Boolean;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
Result := Value = Auto;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 05.10.2010 --
|
||
|
|
function VarIsIntNull(const Value: Variant): Boolean;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
Result := (VarType(Value) in varInt) and (Value = IntNull);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 05.10.2010 --
|
||
|
|
function VarIsAuto(const Value: Variant): Boolean;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
Result := (VarType(Value) in varInt) and (Value = Auto);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 05.10.2010 --
|
||
|
|
function VMargToMarg(const Value: Variant; Relative: Boolean; Base, EmSize, ExSize, Default: Integer): Integer;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
if VarIsStr(Value) then
|
||
|
|
Result := LengthConv(Value, Relative, Base, EmSize, ExSize, Default)
|
||
|
|
else if (VarType(Value) in varInt) and (Value <> IntNull) then
|
||
|
|
Result := Value
|
||
|
|
else
|
||
|
|
Result := Default;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ApplyBoxWidthSettings(var AMarg: ThtMarginArray; var VMinWidth, VMaxWidth: Integer);
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
begin
|
||
|
|
{Important!!!
|
||
|
|
|
||
|
|
You have to do this with settings. This is only for FindWidth methods}
|
||
|
|
if AMarg[piMaxWidth] > 0 then
|
||
|
|
begin
|
||
|
|
AMarg[piWidth] := Min(AMarg[piMaxWidth], AMarg[piWidth]);
|
||
|
|
VMaxWidth := Min(AMarg[piMaxWidth], VMaxWidth);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if AMarg[piMinWidth] > 0 then
|
||
|
|
begin
|
||
|
|
AMarg[piWidth] := Max(AMarg[piMinWidth], AMarg[piWidth]);
|
||
|
|
VMinWidth := Max(AMarg[piMinWidth], VMinWidth);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ApplyBoxSettings(var AMarg: ThtMarginArray);
|
||
|
|
|
||
|
|
procedure ApplyBorderBoxModel(var AMarg : ThtMarginArray);
|
||
|
|
begin
|
||
|
|
if AMarg[piWidth] > -1 then
|
||
|
|
Dec(AMarg[piWidth], AMarg[BorderLeftWidth] + AMarg[PaddingLeft] + AMarg[PaddingRight] + AMarg[BorderRightWidth]);
|
||
|
|
|
||
|
|
if AMarg[piHeight] > -1 then
|
||
|
|
Dec(AMarg[piHeight], AMarg[BorderTopWidth] + AMarg[PaddingTop] + AMarg[PaddingBottom] + AMarg[BorderBottomWidth]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
{JPM: This test is here to prevent AMarg[piWidth] from being ruined
|
||
|
|
if it is set to Auto. If it is ruined, AutoCount might be incremented
|
||
|
|
correctly causing a rendering bug. }
|
||
|
|
|
||
|
|
//min max width
|
||
|
|
if AMarg[piWidth] > 0 then
|
||
|
|
begin
|
||
|
|
if AMarg[piMaxWidth] > 0 then
|
||
|
|
AMarg[piWidth] := Min(AMarg[piWidth], AMarg[piMaxWidth]);
|
||
|
|
|
||
|
|
if AMarg[piMinWidth] > 0 then
|
||
|
|
AMarg[piWidth] := Max(AMarg[piWidth], AMarg[piMinWidth]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
//BG, 09.08.2015: this min/max handling is not as described in CSS 2.1
|
||
|
|
// and tents to bust the document design.
|
||
|
|
// //min max height
|
||
|
|
// if AMarg[piHeight] > 0 then
|
||
|
|
// begin
|
||
|
|
// if AMarg[piMaxHeight] > 0 then
|
||
|
|
// AMarg[piHeight] := Min(AMarg[piHeight], AMarg[piMaxHeight]);
|
||
|
|
//
|
||
|
|
// if AMarg[piMinHeight] > 0 then
|
||
|
|
// AMarg[piHeight] := Max(AMarg[piHeight], AMarg[piMinHeight]);
|
||
|
|
// end;
|
||
|
|
|
||
|
|
case ThtBoxSizing(AMarg[BoxSizing]) of
|
||
|
|
BorderBox: ApplyBorderBoxModel(AMarg);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------ConvMargArray}
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 16.05.2014 --
|
||
|
|
function ConvData(
|
||
|
|
BaseWidth, BaseHeight: Integer;
|
||
|
|
EmSize, ExSize: Integer;
|
||
|
|
BorderWidth: Integer;
|
||
|
|
AutoCount: Integer = 0): ThtConvData;
|
||
|
|
begin
|
||
|
|
Result.BaseWidth := BaseWidth;
|
||
|
|
Result.BaseHeight := BaseHeight;
|
||
|
|
Result.EmSize := EmSize;
|
||
|
|
Result.ExSize := ExSize;
|
||
|
|
Result.BorderWidth := BorderWidth;
|
||
|
|
Result.AutoCount := AutoCount;
|
||
|
|
Result.IsAutoParagraph := [];
|
||
|
|
end;
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 16.05.2014 --
|
||
|
|
procedure ConvMargProp(I: ThtPropIndices; const VM: ThtVMarginArray; var ConvData: ThtConvData; var M: ThtMarginArray);
|
||
|
|
|
||
|
|
function Base(I: ThtPropIndices): Integer;
|
||
|
|
begin
|
||
|
|
case I of
|
||
|
|
BorderTopWidth, BorderBottomWidth,
|
||
|
|
MarginTop, MarginBottom,
|
||
|
|
piMinHeight, piMaxHeight,
|
||
|
|
PaddingTop, PaddingBottom,
|
||
|
|
LineHeight,
|
||
|
|
piHeight, piTop:
|
||
|
|
Base := ConvData.BaseHeight
|
||
|
|
else
|
||
|
|
Base := ConvData.BaseWidth;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
LBoxSizing: ThtBoxSizing;
|
||
|
|
Color: TColor;
|
||
|
|
begin
|
||
|
|
with ConvData do
|
||
|
|
begin
|
||
|
|
case I of
|
||
|
|
BackgroundColor, BorderTopColor..BorderLeftColor:
|
||
|
|
begin
|
||
|
|
if VarType(VM[I]) <= VarNull then
|
||
|
|
M[I] := clNone
|
||
|
|
else if VarIsStr(VM[I]) then
|
||
|
|
begin
|
||
|
|
if TryStrToColor(VM[I], false, Color) then
|
||
|
|
M[I] := Color;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end;
|
||
|
|
|
||
|
|
BorderTopWidth..BorderLeftWidth:
|
||
|
|
begin
|
||
|
|
if VM[ThtPropIndices(Ord(BorderTopStyle) + (Ord(I) - Ord(BorderTopWidth)))] = bssNone then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
begin
|
||
|
|
if VM[I] = 'thin' then
|
||
|
|
M[I] := 2
|
||
|
|
else if VM[I] = 'medium' then
|
||
|
|
M[I] := 4
|
||
|
|
else if VM[I] = 'thick' then
|
||
|
|
M[I] := 6
|
||
|
|
else
|
||
|
|
M[I] := LengthConv(VM[I], False, Base(I), EmSize, ExSize, BorderWidth); {Auto will be 4}
|
||
|
|
end
|
||
|
|
else if (VarType(VM[I]) in varInt) then
|
||
|
|
begin
|
||
|
|
if (VM[I] = IntNull) then
|
||
|
|
M[I] := BorderWidth
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
piMinHeight, piMaxHeight,
|
||
|
|
piHeight:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
begin
|
||
|
|
M[I] := LengthConv(VM[I], False, Base(I), EmSize, ExSize, 0); {Auto will be 0}
|
||
|
|
if Pos('%', VM[I]) > 0 then {include border in % heights}
|
||
|
|
M[I] := M[I] - M[BorderTopWidth] - M[BorderBottomWidth] - M[PaddingTop] - M[PaddingBottom];
|
||
|
|
end
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
PaddingTop..PaddingLeft,BorderSpacingHorz,BorderSpacingVert:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
begin
|
||
|
|
M[I] := LengthConv(VM[I], False, Base(I), EmSize, ExSize, 0); {Auto will be 0}
|
||
|
|
end
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
piTop..piLeft:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, Base(I), EmSize, ExSize, Auto) {Auto will be Auto}
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := Auto
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := Auto;
|
||
|
|
end;
|
||
|
|
|
||
|
|
BoxSizing:
|
||
|
|
if TryStrToBoxSizing(VM[I],LBoxSizing) then begin
|
||
|
|
M[I] := Ord(LBoxSizing);
|
||
|
|
end else begin
|
||
|
|
//assume content-box
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
MarginRight, MarginLeft:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
begin
|
||
|
|
if VM[I] = 'auto' then
|
||
|
|
begin
|
||
|
|
M[I] := Auto;
|
||
|
|
Inc(AutoCount);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseWidth, EmSize, ExSize, 0);
|
||
|
|
end
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
MarginTop, MarginBottom:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseHeight, EmSize, ExSize, 0) {Auto will be 0}
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := 0
|
||
|
|
else if VM[I] = AutoParagraph then
|
||
|
|
begin
|
||
|
|
M[I] := ParagraphSpace;
|
||
|
|
Include(IsAutoParagraph, I);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
piMinWidth,
|
||
|
|
piMaxWidth:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseWidth, EmSize, ExSize, Auto)
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
piWidth:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseWidth, EmSize, ExSize, Auto)
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := Auto
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := Auto;
|
||
|
|
if M[I] = Auto then
|
||
|
|
Inc(AutoCount);
|
||
|
|
end;
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, Base(I), EmSize, ExSize, 0)
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := 0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ConvMargArray(const VM: ThtVMarginArray; BaseWidth, BaseHeight, EmSize, ExSize: Integer;
|
||
|
|
BorderWidth: Integer; out AutoCount: Integer; var M: ThtMarginArray);
|
||
|
|
{This routine does not do MarginTop and MarginBottom as they are done by ConvVertMargins}
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
CD: ThtConvData;
|
||
|
|
begin
|
||
|
|
CD := ConvData(BaseWidth, BaseHeight, EmSize, ExSize, BorderWidth);
|
||
|
|
for I := Low(VM) to High(VM) do
|
||
|
|
if not (I in [MarginTop, MarginBottom]) then
|
||
|
|
ConvMargProp(I, VM, CD, M);
|
||
|
|
AutoCount := CD.AutoCount; {count of 'auto's in width items}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure ConvMargArrayForCellPadding(const VM: ThtVMarginArray; EmSize,
|
||
|
|
ExSize: Integer; var M: ThtMarginArray);
|
||
|
|
{Return negative for no entry or percent entry}
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
for I := PaddingTop to PaddingLeft do
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, -100, EmSize, ExSize, 0) {Auto will be 0}
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := -1
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------ConvInlineMargArray}
|
||
|
|
|
||
|
|
procedure ConvInlineMargArray(const VM: ThtVMarginArray; BaseWidth, BaseHeight, EmSize,
|
||
|
|
ExSize, BorderWidth: Integer; {BStyle: ThtBorderStyle;} out M: ThtMarginArray);
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
{currently for images, form controls. BaseWidth/Height and BStyle currently not supported}
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
for I := Low(VM) to High(VM) do
|
||
|
|
case I of
|
||
|
|
piHeight, piWidth:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseWidth, EmSize, ExSize, Auto) {Auto will be Auto}
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := IntNull
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := IntNull;
|
||
|
|
end;
|
||
|
|
|
||
|
|
piMinHeight, piMinWidth, piMaxHeight, piMaxWidth,
|
||
|
|
MarginLeft, MarginRight, MarginTop, MarginBottom:
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseWidth, EmSize, ExSize, 0) {auto is 0}
|
||
|
|
else if VarType(VM[I]) in varInt then
|
||
|
|
begin
|
||
|
|
if VM[I] = IntNull then
|
||
|
|
M[I] := IntNull
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end
|
||
|
|
else
|
||
|
|
M[I] := IntNull;
|
||
|
|
end;
|
||
|
|
|
||
|
|
BorderTopWidth..BorderLeftWidth:
|
||
|
|
begin
|
||
|
|
if VM[ThtPropIndices(Ord(BorderTopStyle) + (Ord(I) - Ord(BorderTopWidth)))] = bssNone then
|
||
|
|
M[I] := 0
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if VarIsStr(VM[I]) then
|
||
|
|
begin
|
||
|
|
if VM[I] = 'thin' then
|
||
|
|
M[I] := 2
|
||
|
|
else if VM[I] = 'medium' then
|
||
|
|
M[I] := 4
|
||
|
|
else if VM[I] = 'thick' then
|
||
|
|
M[I] := 6
|
||
|
|
else
|
||
|
|
M[I] := LengthConv(VM[I], False, BaseWidth, EmSize, ExSize, BorderWidth); {Auto will be BorderWidth}
|
||
|
|
end
|
||
|
|
else if (VarType(VM[I]) in varInt) then
|
||
|
|
begin
|
||
|
|
if (VM[I] = IntNull) then
|
||
|
|
M[I] := 4
|
||
|
|
else
|
||
|
|
M[I] := VM[I];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
else
|
||
|
|
; {remaining items unsupported/unused}
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.Combine}
|
||
|
|
|
||
|
|
//-- BG ---------------------------------------------------------- 28.02.2016 --
|
||
|
|
procedure TfrxHtProperties.Combine(Styles: TfrxHtStyleList; Sym: TElemSymb;
|
||
|
|
const Tag, Pseudo: ThtString; Properties: TfrxHtProperties;
|
||
|
|
Attributes: TfrxHtAttributeList; ParentIndexInPropStack: Integer);
|
||
|
|
begin
|
||
|
|
if Attributes <> nil then
|
||
|
|
Combine(Styles, Sym, Tag, Attributes.TheClass, Attributes.TheID, PSeudo, Attributes.TheTitle, Properties, Attributes, ParentIndexInPropStack)
|
||
|
|
else
|
||
|
|
Combine(Styles, Sym, Tag, '', '', PSeudo, '', Properties, Attributes, ParentIndexInPropStack);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.Combine(Styles: TfrxHtStyleList; Sym: TElemSymb;
|
||
|
|
const Tag, AClass, AnID, PSeudo, ATitle: ThtString; AProp: TfrxHtProperties; Attributes: TfrxHtAttributeList; ParentIndexInPropStack: Integer);
|
||
|
|
{When called, this TfrxHtProperties contains the inherited properties. Here we
|
||
|
|
add the ones relevant to this item. AProp are TfrxHtProperties gleaned from the
|
||
|
|
Style= attribute. AClass may be a multiple class like class="ab.cd"}
|
||
|
|
|
||
|
|
procedure CombineX(Styles: TfrxHtStyleList;
|
||
|
|
const Tag, AClass, AnID, PSeudo, ATitle: ThtString; AProp: TfrxHtProperties);
|
||
|
|
{When called, this TfrxHtProperties contains the inherited properties. Here we
|
||
|
|
add the ones relevant to this item. AProp are TfrxHtProperties gleaned from the
|
||
|
|
Style= attribute.}
|
||
|
|
var
|
||
|
|
OldSize: Double;
|
||
|
|
NoHoverVisited: Boolean;
|
||
|
|
|
||
|
|
//-- BG ------------------------------------------------------ 12.06.2016 --
|
||
|
|
procedure MergeAttrs(const Attributes: TfrxHtAttributeList);
|
||
|
|
{Merge Attributes in this TfrxHtProperties.}
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
A: TfrxHtAttribute;
|
||
|
|
// T: TElemSymb;
|
||
|
|
begin
|
||
|
|
if (Attributes <> nil) and (Attributes.Count > 0) then
|
||
|
|
begin
|
||
|
|
for I := 0 to Attributes.Count - 1 do
|
||
|
|
begin
|
||
|
|
A := Attributes[I];
|
||
|
|
case A.Which of
|
||
|
|
AlignSy:
|
||
|
|
case Sym of
|
||
|
|
DivSy,
|
||
|
|
H1Sy..H6Sy,
|
||
|
|
PSy,
|
||
|
|
ColSy,
|
||
|
|
ColGroupSy,
|
||
|
|
THeadSy..TFootSy,
|
||
|
|
TDSy, THSy, TRSy:
|
||
|
|
if A.Name = 'char' then
|
||
|
|
Props[TextAlign] := 'right'
|
||
|
|
else
|
||
|
|
Props[TextAlign] := A.Name;
|
||
|
|
end;
|
||
|
|
|
||
|
|
atDirSy: Props[TextDirection] := A.Name;
|
||
|
|
|
||
|
|
// BackgroundSy: Props[BackgroundImage] := 'url(' + A.Name + ')';
|
||
|
|
// BGColorSy: Props[BackgroundColor] := A.Name;
|
||
|
|
|
||
|
|
BorderSy:
|
||
|
|
begin
|
||
|
|
Props[BorderTopWidth] := A.Name;
|
||
|
|
Props[BorderRightWidth] := A.Name;
|
||
|
|
Props[BorderBottomWidth] := A.Name;
|
||
|
|
Props[BorderLeftWidth] := A.Name;
|
||
|
|
end;
|
||
|
|
|
||
|
|
BorderColorSy:
|
||
|
|
begin
|
||
|
|
Props[BorderTopColor] := A.Name;
|
||
|
|
Props[BorderRightColor] := A.Name;
|
||
|
|
Props[BorderBottomColor] := A.Name;
|
||
|
|
Props[BorderLeftColor] := A.Name;
|
||
|
|
end;
|
||
|
|
|
||
|
|
// CellPaddingSy:
|
||
|
|
// begin
|
||
|
|
// Props[MarginTop] := A.Name;
|
||
|
|
// Props[MarginRight] := A.Name;
|
||
|
|
// Props[MarginBottom] := A.Name;
|
||
|
|
// Props[MarginLeft] := A.Name;
|
||
|
|
// end;
|
||
|
|
|
||
|
|
CellSpacingSy:
|
||
|
|
begin
|
||
|
|
Props[BorderSpacingHorz] := A.Name;
|
||
|
|
Props[BorderSpacingVert] := A.Name;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//ColorSy:;
|
||
|
|
//HeightSy:;
|
||
|
|
//HSpaceSy:;
|
||
|
|
//LeftMarginSy:;
|
||
|
|
//LinkSy:;
|
||
|
|
//TopMarginSy:;
|
||
|
|
//MarginHeightSy:;
|
||
|
|
//MarginWidthSy:;
|
||
|
|
|
||
|
|
//StartSy,
|
||
|
|
//TypeSy,
|
||
|
|
|
||
|
|
VAlignSy: Props[VerticalAlign] := A.Name;
|
||
|
|
|
||
|
|
//ValueSy:;
|
||
|
|
//VLinkSy:;
|
||
|
|
//VSpaceSy:;
|
||
|
|
//WidthSy:;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Merge(Source: TfrxHtProperties; Reverse: Boolean = False);
|
||
|
|
var
|
||
|
|
Index: ThtPropIndices;
|
||
|
|
Wt: Integer;
|
||
|
|
S1: ThtString;
|
||
|
|
begin
|
||
|
|
for Index := Low(Index) to High(Index) do
|
||
|
|
begin
|
||
|
|
if Reverse then
|
||
|
|
begin
|
||
|
|
if (Props[Index] <> Unassigned) and not VarIsIntNull(Props[Index]) then
|
||
|
|
continue;
|
||
|
|
end;
|
||
|
|
if Important[Index] and not Source.Important[Index] then
|
||
|
|
continue;
|
||
|
|
if VarIsStr(Source.Props[Index]) and (Source.Props[Index] = 'inherit') then
|
||
|
|
continue;
|
||
|
|
if (VarType(Source.Props[Index]) <> varEmpty) and (Vartype(Source.Props[Index]) <> varNull) then
|
||
|
|
case Index of
|
||
|
|
MarginTop..BorderSpacingVert:
|
||
|
|
if VarIsStr(Source.Props[Index]) then // if VarType(Source.Props[Index]) = VarString then
|
||
|
|
begin
|
||
|
|
Props[Index] := Source.Props[Index];
|
||
|
|
Important[Index] := Source.Important[Index];
|
||
|
|
Originals[Index] := True;
|
||
|
|
end
|
||
|
|
else if Source.Props[Index] <> IntNull then
|
||
|
|
begin
|
||
|
|
Props[Index] := Source.Props[Index];
|
||
|
|
Important[Index] := Source.Important[Index];
|
||
|
|
Originals[Index] := True;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TextDecoration:
|
||
|
|
begin
|
||
|
|
Important[Index] := Source.Important[Index];
|
||
|
|
Originals[Index] := True;
|
||
|
|
S1 := Props[Index];
|
||
|
|
if (S1 = 'none') or (Length(S1) = 0) or (Source.Props[Index] = 'none') then
|
||
|
|
Props[Index] := Source.Props[Index]
|
||
|
|
else if Pos(Source.Props[Index], S1) = 0 then
|
||
|
|
Props[Index] := S1 + SpcChar + Source.Props[Index];
|
||
|
|
if InLink then
|
||
|
|
begin
|
||
|
|
with FIObj.Info do
|
||
|
|
if Props[Index] = 'none' then
|
||
|
|
iStyle := iStyle - [fsStrikeOut, fsUnderline]
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if Pos('underline', Props[Index]) > 0 then
|
||
|
|
Include(iStyle, fsUnderline);
|
||
|
|
if Pos('line-through', Props[Index]) > 0 then
|
||
|
|
Include(iStyle, fsStrikeOut);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
FontFamily, FontSize, FontStyle, FontWeight, Color, BackgroundColor, LetterSpacing:
|
||
|
|
begin
|
||
|
|
Important[Index] := Source.Important[Index];
|
||
|
|
Originals[Index] := True;
|
||
|
|
Props[Index] := Source.Props[Index];
|
||
|
|
if InLink then
|
||
|
|
with FIObj.Info do
|
||
|
|
case Index of
|
||
|
|
FontFamily:
|
||
|
|
begin
|
||
|
|
S1 := ReadFontName(Props[Index]);
|
||
|
|
if S1 <> '' then
|
||
|
|
iName := S1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
FontSize:
|
||
|
|
iSize := FontSizeConv(Props[Index], iSize, DefPointSize);
|
||
|
|
|
||
|
|
Color:
|
||
|
|
iColor := Props[Index];
|
||
|
|
|
||
|
|
BackgroundColor:
|
||
|
|
ibgColor := Props[Index];
|
||
|
|
|
||
|
|
FontStyle:
|
||
|
|
if (Props[Index] = 'italic') or (Props[Index] = 'oblique') then
|
||
|
|
iStyle := iStyle + [fsItalic]
|
||
|
|
else if Props[Index] = 'normal' then
|
||
|
|
iStyle := iStyle - [fsItalic];
|
||
|
|
|
||
|
|
FontWeight:
|
||
|
|
if Pos('bold', Props[Index]) > 0 then
|
||
|
|
iStyle := iStyle + [fsBold]
|
||
|
|
else if Pos('normal', Props[Index]) > 0 then
|
||
|
|
iStyle := iStyle - [fsBold]
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Wt := StrToIntDef(Props[Index], 0);
|
||
|
|
if Wt >= 600 then
|
||
|
|
iStyle := iStyle + [fsBold];
|
||
|
|
end;
|
||
|
|
|
||
|
|
LetterSpacing:
|
||
|
|
iCharExtra := Props[Index];
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Props[Index] := Source.Props[Index];
|
||
|
|
Important[Index] := Source.Important[Index];
|
||
|
|
Originals[Index] := True; {it's defined for this item, not inherited}
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function CheckForContextual(I: Integer): Boolean;
|
||
|
|
{process contextual selectors}
|
||
|
|
var
|
||
|
|
J, K, N: Integer;
|
||
|
|
A: array[1..20] of record
|
||
|
|
Tg, Cl, ID, PS: ThtString;
|
||
|
|
gt: Boolean;
|
||
|
|
end;
|
||
|
|
MustMatchParent: Boolean;
|
||
|
|
|
||
|
|
procedure Split(S: ThtString);
|
||
|
|
var
|
||
|
|
I, J: Integer;
|
||
|
|
begin
|
||
|
|
N := 1; {N is number of selectors in contextual ThtString}
|
||
|
|
I := Pos(' ', S);
|
||
|
|
while (I > 0) and (N < 20) do
|
||
|
|
begin
|
||
|
|
A[N].Tg := System.Copy(S, 1, I - 1);
|
||
|
|
Delete(S, 1, I);
|
||
|
|
S := Trim(S);
|
||
|
|
Inc(N);
|
||
|
|
I := Pos(' ', S);
|
||
|
|
end;
|
||
|
|
|
||
|
|
A[N].Tg := S;
|
||
|
|
if N >= 2 then
|
||
|
|
while Length(A[2].Tg) > 0 do
|
||
|
|
begin
|
||
|
|
case A[2].Tg[1] of
|
||
|
|
'0'..'9':
|
||
|
|
Delete(A[2].Tg, 1, 1); {remove the sort digit}
|
||
|
|
else
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for I := 1 to N do
|
||
|
|
begin
|
||
|
|
J := Pos('>', A[I].Tg);
|
||
|
|
if I > 1 then
|
||
|
|
A[I - 1].gt := J > 0;
|
||
|
|
if J > 0 then
|
||
|
|
Delete(A[I].Tg, J, 1);
|
||
|
|
J := Pos(':', A[I].Tg);
|
||
|
|
if J > 0 then
|
||
|
|
begin
|
||
|
|
A[I].PS := System.Copy(A[I].Tg, J + 1, Length(A[I].Tg));
|
||
|
|
A[I].Tg := System.Copy(A[I].Tg, 1, J - 1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
A[I].PS := '';
|
||
|
|
J := Pos('#', A[I].Tg);
|
||
|
|
if J > 0 then
|
||
|
|
begin
|
||
|
|
A[I].ID := System.Copy(A[I].Tg, J + 1, Length(A[I].Tg));
|
||
|
|
A[I].Tg := System.Copy(A[I].Tg, 1, J - 1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
A[I].ID := '';
|
||
|
|
J := Pos('.', A[I].Tg);
|
||
|
|
if J > 0 then
|
||
|
|
begin
|
||
|
|
A[I].Cl := System.Copy(A[I].Tg, J + 1, Length(A[I].Tg));
|
||
|
|
A[I].Tg := System.Copy(A[I].Tg, 1, J - 1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
A[I].Cl := '';
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function PartOf(const S1, S2: ThtString): Boolean;
|
||
|
|
{see if all classes in S1 are present in S2. Classes are separated by '.'}
|
||
|
|
var
|
||
|
|
SL1, SL2: ThtStringList;
|
||
|
|
J, X: Integer;
|
||
|
|
|
||
|
|
function FormStringList(S: ThtString): ThtStringList;
|
||
|
|
{construct a ThtStringList from classes in ThtString S}
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
Result := ThtStringList.Create;
|
||
|
|
Result.Sorted := True;
|
||
|
|
I := Pos('.', S);
|
||
|
|
while I >= 1 do
|
||
|
|
begin
|
||
|
|
Result.Add(System.Copy(S, 1, I - 1));
|
||
|
|
Delete(S, 1, I);
|
||
|
|
I := Pos('.', S);
|
||
|
|
end;
|
||
|
|
Result.Add(S);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin {PartOf}
|
||
|
|
SL1 := FormStringList(S1);
|
||
|
|
try
|
||
|
|
SL2 := FormStringList(S2);
|
||
|
|
try
|
||
|
|
Result := True; {assume all will be found}
|
||
|
|
for J := 0 to SL1.Count - 1 do
|
||
|
|
if not SL2.Find(SL1[J], X) then
|
||
|
|
begin
|
||
|
|
Result := False; {one is missing, return False}
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
SL2.Free;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
SL1.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
Split(Styles[I]); //split contextual selectors into parts in array A
|
||
|
|
if (A[1].Tg <> Tag) and (A[1].Cl <> AClass) and (A[1].PS <> PSeudo) then
|
||
|
|
Exit
|
||
|
|
else
|
||
|
|
Result := True;
|
||
|
|
if (N > 1) //it's a contextual selector. N is count of selectors
|
||
|
|
and ((A[1].Tg = Tag) or (A[1].Tg = ''))
|
||
|
|
and ((A[1].Cl = AClass) or (A[1].Cl = ''))
|
||
|
|
and ((A[1].ID = AnID) or (A[1].ID = ''))
|
||
|
|
and ((A[1].PS = PSeudo) or (A[1].PS = '') and (PSeudo = 'link')) then
|
||
|
|
begin //look thru the stack to see if this contextual selector is appropriate
|
||
|
|
K := 2; //K is selector index in the sequence
|
||
|
|
J := ParentIndexInPropStack; //PropStack.Count - 2; // start on stack item below this one
|
||
|
|
MustMatchParent := A[1].gt;
|
||
|
|
while (K <= N) and (J >= 1) do
|
||
|
|
begin
|
||
|
|
with PropStack[J] do
|
||
|
|
if ((A[K].Tg = PropTag) or (A[K].Tg = ''))
|
||
|
|
and ((A[K].Cl = PropClass) or (A[K].Cl = '') or PartOf(A[K].Cl, PropClass))
|
||
|
|
and ((A[K].ID = PropID) or (A[K].ID = ''))
|
||
|
|
and ((A[K].PS = PropPseudo) or (A[K].PS = '')) then
|
||
|
|
begin
|
||
|
|
if K = N then //all parts of contextual selector match
|
||
|
|
Merge(Styles.Objects[I] as TfrxHtProperties);
|
||
|
|
MustMatchParent := A[K].gt;
|
||
|
|
Inc(K);
|
||
|
|
end
|
||
|
|
else if MustMatchParent then
|
||
|
|
Break; {Didn't match}
|
||
|
|
Dec(J);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure MergeItems(const Item: ThtString; Reverse: Boolean = False);
|
||
|
|
{look up items in the Style list. If found, merge them in this TfrxHtProperties.
|
||
|
|
Items may be duplicated in which case the last has priority. Items may be
|
||
|
|
simple tags like 'p', 'blockquote', 'em', etc or they may be more complex
|
||
|
|
like p.class, em#id, a.class:link, etc}
|
||
|
|
var
|
||
|
|
X, Y: Integer;
|
||
|
|
begin
|
||
|
|
if Styles.Find(Item, X) then
|
||
|
|
begin
|
||
|
|
if Reverse then
|
||
|
|
begin
|
||
|
|
// Reverse is used to set unassigned values only.
|
||
|
|
Y := X;
|
||
|
|
Inc(X);
|
||
|
|
while (X < Styles.Count) and (Styles[X] = Item) do
|
||
|
|
begin //duplicates, last one has highest priority
|
||
|
|
Inc(X);
|
||
|
|
end;
|
||
|
|
// merge in reverse order
|
||
|
|
while X > Y do
|
||
|
|
begin
|
||
|
|
Dec(X);
|
||
|
|
Merge(Styles.Objects[X] as TfrxHtProperties, Reverse);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Merge(Styles.Objects[X] as TfrxHtProperties);
|
||
|
|
Inc(X);
|
||
|
|
while (X < Styles.Count) and (Styles[X] = Item) do
|
||
|
|
begin //duplicates, last one has highest priority
|
||
|
|
Merge(Styles.Objects[X] as TfrxHtProperties);
|
||
|
|
Inc(X);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//BG, 09.09.2010: extracted from below
|
||
|
|
procedure MergeContextuals(Style: ThtString);
|
||
|
|
var
|
||
|
|
IX: Integer;
|
||
|
|
begin
|
||
|
|
Styles.Find(Style, IX); //place to start
|
||
|
|
try
|
||
|
|
while (IX < Styles.Count) and (Pos(Style, Styles[IX]) = 1) and CheckForContextual(IX) do
|
||
|
|
Inc(IX);
|
||
|
|
except
|
||
|
|
raise;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if (VarType(Props[FontSize]) in VarNum) and (Props[FontSize] > 0.0) then {should be true}
|
||
|
|
OldSize := Props[FontSize]
|
||
|
|
else
|
||
|
|
OldSize := DefPointSize;
|
||
|
|
|
||
|
|
{Some hover and visited items adequately taken care of when link processed}
|
||
|
|
NoHoverVisited := (Pseudo = '') or ((Pseudo <> 'hover') and (Pseudo <> 'visited'));
|
||
|
|
|
||
|
|
// in the following, lowest priority on top, highest towards bottom.
|
||
|
|
|
||
|
|
if (Tag = 'a') and ((Pseudo = 'link') or (Pseudo = 'visited')) then
|
||
|
|
MergeItems('::' + Pseudo); {default Pseudo definition}
|
||
|
|
|
||
|
|
if NoHoverVisited then
|
||
|
|
MergeItems(Tag);
|
||
|
|
|
||
|
|
MergeAttrs(Attributes);
|
||
|
|
|
||
|
|
if Pseudo <> '' then
|
||
|
|
MergeItems(':' + Pseudo);
|
||
|
|
|
||
|
|
if (AClass <> '') and NoHoverVisited then
|
||
|
|
begin
|
||
|
|
MergeItems('.' + AClass);
|
||
|
|
MergeItems(Tag + '.' + AClass);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if Pseudo <> '' then
|
||
|
|
begin
|
||
|
|
MergeItems(Tag + ':' + Pseudo);
|
||
|
|
if AClass <> '' then
|
||
|
|
begin
|
||
|
|
MergeItems('.' + AClass + ':' + Pseudo);
|
||
|
|
MergeItems(Tag + '.' + AClass + ':' + Pseudo);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if AnID <> '' then
|
||
|
|
begin
|
||
|
|
MergeItems('#' + AnID);
|
||
|
|
MergeItems(Tag + '#' + AnID);
|
||
|
|
if AClass <> '' then
|
||
|
|
MergeItems('.' + AClass + '#' + AnID);
|
||
|
|
if Pseudo <> '' then
|
||
|
|
begin
|
||
|
|
MergeItems('#' + AnID + ':' + Pseudo);
|
||
|
|
MergeItems(Tag + '#' + AnID + ':' + Pseudo);
|
||
|
|
end;
|
||
|
|
if AClass <> '' then
|
||
|
|
begin
|
||
|
|
MergeItems(Tag + '.' + AClass + '#' + AnID);
|
||
|
|
if Pseudo <> '' then
|
||
|
|
begin
|
||
|
|
MergeItems('.' + AClass + '#' + AnID + ':' + Pseudo);
|
||
|
|
MergeItems(Tag + '.' + AClass + '#' + AnID + ':' + Pseudo);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{process the entries in Styles to see if they are contextual selectors}
|
||
|
|
if NoHoverVisited then
|
||
|
|
MergeContextuals(Tag + ' ');
|
||
|
|
|
||
|
|
if Pseudo <> '' then
|
||
|
|
MergeContextuals(':' + Pseudo + ' ');
|
||
|
|
|
||
|
|
if (AClass <> '') and NoHoverVisited then
|
||
|
|
begin
|
||
|
|
MergeContextuals('.' + AClass + ' ');
|
||
|
|
MergeContextuals(Tag + '.' + AClass + ' ');
|
||
|
|
end;
|
||
|
|
|
||
|
|
if Pseudo <> '' then
|
||
|
|
begin
|
||
|
|
MergeContextuals(Tag + ':' + Pseudo + ' ');
|
||
|
|
if AClass <> '' then
|
||
|
|
begin
|
||
|
|
MergeContextuals('.' + AClass + ':' + Pseudo + ' ');
|
||
|
|
MergeContextuals(Tag + '.' + AClass + ':' + Pseudo + ' ');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if AnID <> '' then
|
||
|
|
begin
|
||
|
|
MergeContextuals('#' + AnID + ' ');
|
||
|
|
MergeContextuals(Tag + '#' + AnID + ' ');
|
||
|
|
if AClass <> '' then
|
||
|
|
MergeContextuals('.' + AClass + '#' + AnID + ' ');
|
||
|
|
if Pseudo <> '' then
|
||
|
|
begin
|
||
|
|
MergeContextuals('#' + AnID + ':' + Pseudo + ' ');
|
||
|
|
MergeContextuals(Tag + '#' + AnID + ':' + Pseudo + ' ');
|
||
|
|
end;
|
||
|
|
if AClass <> '' then
|
||
|
|
begin
|
||
|
|
MergeContextuals(Tag + '.' + AClass + '#' + AnID + ' ');
|
||
|
|
if Pseudo <> '' then
|
||
|
|
begin
|
||
|
|
MergeContextuals('.' + AClass + '#' + AnID + ':' + Pseudo + ' ');
|
||
|
|
MergeContextuals(Tag + '.' + AClass + '#' + AnID + ':' + Pseudo + ' ');
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if AProp <> nil then //the Style= attribute
|
||
|
|
Merge(AProp);
|
||
|
|
|
||
|
|
if (Tag = 'a') and not ((Pseudo = 'hover') or (Pseudo = 'active')) then
|
||
|
|
// BG, 02.02.2013: github-issue 25: Multiple pseudo elements can apply
|
||
|
|
// Just assign defaults for what is still unassigned:
|
||
|
|
MergeItems('::' + Pseudo, True); {default Pseudo definition}
|
||
|
|
|
||
|
|
if not (VarType(Props[FontSize]) in varNum) then {if still a ThtString, hasn't been converted}
|
||
|
|
Props[FontSize] := FontSizeConv(Props[FontSize], OldSize, FDefPointSize);
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
BClass, S: ThtString;
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
BClass := Trim(AClass);
|
||
|
|
I := Pos('.', BClass);
|
||
|
|
if I <= 0 then
|
||
|
|
CombineX(Styles, Tag, BClass, AnID, PSeudo, '', AProp) {0 or 1 Class}
|
||
|
|
else
|
||
|
|
begin {more than one class}
|
||
|
|
repeat
|
||
|
|
S := System.Copy(BClass, 1, I - 1);
|
||
|
|
CombineX(Styles, Tag, S, AnID, PSeudo, '', nil);
|
||
|
|
Delete(BClass, 1, I);
|
||
|
|
BClass := Trim(BClass);
|
||
|
|
I := Pos('.', BClass);
|
||
|
|
until I <= 0;
|
||
|
|
CombineX(Styles, Tag, BClass, AnID, PSeudo, '', AProp);
|
||
|
|
CombineX(Styles, Tag, AClass, AnID, PSeudo, '', AProp);
|
||
|
|
end;
|
||
|
|
PropSym := Sym;
|
||
|
|
PropTag := Tag;
|
||
|
|
PropClass := AClass;
|
||
|
|
PropID := AnID;
|
||
|
|
PropPseudo := Pseudo;
|
||
|
|
PropStyle := AProp;
|
||
|
|
if ATitle <> '' then
|
||
|
|
PropTitle := ATitle;
|
||
|
|
if PSeudo = 'link' then
|
||
|
|
begin
|
||
|
|
if not Assigned(FIObj) then
|
||
|
|
FIObj := TFontInfoObj.Create;
|
||
|
|
CalcLinkFontInfo(Styles, PropStack.Count - 1);
|
||
|
|
InLink := True;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtProperties.GetFont: TfrxHtFont;
|
||
|
|
var
|
||
|
|
Font: TfrxHtFontInfo;
|
||
|
|
begin {call only if all things valid}
|
||
|
|
if TheFont = nil then
|
||
|
|
begin
|
||
|
|
GetSingleFontInfo(Font);
|
||
|
|
TheFont := frxAllMyFonts.GetFontLike(Font);
|
||
|
|
end;
|
||
|
|
Result := TheFont;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------LowerCaseUnquotedStr}
|
||
|
|
{Imporant: In many CSS values, a quoted string or anything
|
||
|
|
in parathesis should be left in it's original case.
|
||
|
|
Such a substring may be case-sensitive.
|
||
|
|
|
||
|
|
Examples include URI filenames and Base64-encoded data.
|
||
|
|
}
|
||
|
|
function LowerCaseUnquotedStr(const S : THtString) : THtString;
|
||
|
|
var
|
||
|
|
Top: ThtChar;
|
||
|
|
MoreStack: ThtString;
|
||
|
|
LCh : ThtChar;
|
||
|
|
idx, len : Integer;
|
||
|
|
|
||
|
|
procedure Push(Ch: ThtChar);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
if Top <> EofChar then
|
||
|
|
begin
|
||
|
|
I := Length(MoreStack) + 1;
|
||
|
|
SetLength(MoreStack, I);
|
||
|
|
MoreStack[I] := Top;
|
||
|
|
end;
|
||
|
|
Top := Ch;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure Pop;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
I := Length(MoreStack);
|
||
|
|
if I > 0 then
|
||
|
|
begin
|
||
|
|
Top := MoreStack[I];
|
||
|
|
SetLength(MoreStack, I - 1);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Top := EofChar;
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
if (Pos('''',S) = 0) and (Pos('(',S)=0) and (Pos('"',S) = 0) then
|
||
|
|
begin
|
||
|
|
Result := LowerCase(S);
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
len := Length(S);
|
||
|
|
SetLength(Result,len);
|
||
|
|
for idx := 1 to Len do begin
|
||
|
|
LCh := S[idx];
|
||
|
|
case LCh of
|
||
|
|
'(' :
|
||
|
|
begin
|
||
|
|
if LCh = Top then
|
||
|
|
Pop
|
||
|
|
else
|
||
|
|
Push(LCh);
|
||
|
|
end;
|
||
|
|
'''','"' :
|
||
|
|
begin
|
||
|
|
Push(LCh);
|
||
|
|
end;
|
||
|
|
')' :
|
||
|
|
begin
|
||
|
|
if LCh = Top then
|
||
|
|
Pop;
|
||
|
|
end;
|
||
|
|
'A'..'Z' :
|
||
|
|
begin
|
||
|
|
if Top = EofChar then
|
||
|
|
LCh := ThtChar(Word(LCh) or $0020);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Result[idx] := LCh;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------RemoveQuotes}
|
||
|
|
|
||
|
|
function RemoveQuotes(const S: ThtString): ThtString;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
{if ThtString is a quoted ThtString, remove the quotes (either ' or ")}
|
||
|
|
var
|
||
|
|
L: Integer;
|
||
|
|
begin
|
||
|
|
L := Length(S);
|
||
|
|
if (L >= 2) and (S[L] = S[1]) and ((S[1] = '''') or (S[1] = '"')) then
|
||
|
|
Result := Copy(S, 2, Length(S) - 2)
|
||
|
|
else
|
||
|
|
Result := S;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------ReadFontName}
|
||
|
|
|
||
|
|
function ReadFontName(S: ThtString): ThtString;
|
||
|
|
const
|
||
|
|
AMax = 5;
|
||
|
|
var
|
||
|
|
S1: ThtString;
|
||
|
|
Done: Boolean;
|
||
|
|
|
||
|
|
function NextFontName: ThtString;
|
||
|
|
const
|
||
|
|
Generic1: array[1..AMax] of ThtString = ('serif' , 'monospace', 'sans-serif', 'cursive' , 'helvetica');
|
||
|
|
Generic2: array[1..AMax] of ThtString = (FontSerif, FontMono , FontSans , FontCursive, FontHelvet );
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
I := Pos(',', S); {read up to the comma}
|
||
|
|
if I > 0 then
|
||
|
|
begin
|
||
|
|
Result := Trim(System.Copy(S, 1, I - 1));
|
||
|
|
Delete(S, 1, I);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin {last item}
|
||
|
|
Result := Trim(S);
|
||
|
|
S := '';
|
||
|
|
end;
|
||
|
|
|
||
|
|
for I := 1 to AMax do
|
||
|
|
if htCompareText(Result, Generic1[I]) = 0 then
|
||
|
|
begin
|
||
|
|
Result := Generic2[I];
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
|
||
|
|
Result := RemoveQuotes(Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
Done := False;
|
||
|
|
S1 := NextFontName;
|
||
|
|
while (S1 <> '') and not Done do
|
||
|
|
begin
|
||
|
|
Done := Screen.Fonts.IndexOf( htStringToString(S1) ) >= 0;
|
||
|
|
if Done then
|
||
|
|
Result := S1
|
||
|
|
else
|
||
|
|
S1 := NextFontName;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------TfrxHtProperties.GetSingleFontInfo}
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.GetSingleFontInfo(var Font: TfrxHtFontInfo);
|
||
|
|
var
|
||
|
|
Wt: Integer;
|
||
|
|
Style: TFontStyles;
|
||
|
|
|
||
|
|
begin {call only if all things valid}
|
||
|
|
Font.ibgColor := FontBG;
|
||
|
|
Font.iColor := Props[Color];
|
||
|
|
Style := [];
|
||
|
|
if Pos('bold', Props[FontWeight]) > 0 then
|
||
|
|
Include(Style, fsBold)
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Wt := StrToIntDef(Props[FontWeight], 0);
|
||
|
|
if Wt >= 600 then
|
||
|
|
Include(Style, fsBold);
|
||
|
|
end;
|
||
|
|
if (Props[FontStyle] = 'italic') or (Props[FontStyle] = 'oblique') then
|
||
|
|
Include(Style, fsItalic);
|
||
|
|
if Pos('underline', Props[TextDecoration]) > 0 then
|
||
|
|
Include(Style, fsUnderline);
|
||
|
|
if Pos('line-through', Props[TextDecoration]) > 0 then
|
||
|
|
Include(Style, fsStrikeOut);
|
||
|
|
Font.iStyle := Style;
|
||
|
|
Font.iSize := Props[FontSize];
|
||
|
|
Font.iCharset := CharSet;
|
||
|
|
Font.iCharExtra := Props[LetterSpacing];
|
||
|
|
Font.iName := ReadFontName(Props[FontFamily]);
|
||
|
|
if Font.iName = '' then
|
||
|
|
Font.iName := DefFontname;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.CalcLinkFontInfo(Styles: TfrxHtStyleList; I: Integer);
|
||
|
|
{I is index in PropStack for this item}
|
||
|
|
|
||
|
|
procedure InsertNewProp(N: Integer; const Pseudo: ThtString);
|
||
|
|
begin
|
||
|
|
PropStack.Insert(N, TfrxHtProperties.Create(PropStack));
|
||
|
|
PropStack[N].Inherit('', PropStack[N - 1]);
|
||
|
|
PropStack[N].Combine(Styles, PropSym, PropTag, PropClass, PropID, Pseudo, PropTitle, PropStyle, nil {PropAttr}, N - 1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
begin
|
||
|
|
PropStack[I].SetFontBG;
|
||
|
|
GetSingleFontInfo(FIObj.Info);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.GetFontInfo(AFI: TFontInfoObj);
|
||
|
|
begin
|
||
|
|
AFI.Assign(FIObj);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.GetVMarginArrayDefBorder(var MArray: ThtVMarginArray; const ADefColor : Variant);
|
||
|
|
var
|
||
|
|
I: ThtPropIndices;
|
||
|
|
BS: ThtBorderStyle;
|
||
|
|
NewColor : TColor;
|
||
|
|
LVal : THtString;
|
||
|
|
begin
|
||
|
|
for I := Low(MArray) to High(MArray) do
|
||
|
|
case I of
|
||
|
|
BorderTopStyle..BorderLeftStyle:
|
||
|
|
begin
|
||
|
|
BS := MArray[I];
|
||
|
|
GetBorderStyle(I, BS);
|
||
|
|
MArray[I] := BS;
|
||
|
|
end;
|
||
|
|
|
||
|
|
BorderTopColor..BorderLeftColor:
|
||
|
|
begin
|
||
|
|
if TryStrToColor(Props[I],False,NewColor) then
|
||
|
|
MArray[I] := Props[I]
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
LVal := Props[I];
|
||
|
|
if LVal = CurColor_Val then
|
||
|
|
// 'currentColor'
|
||
|
|
MArray[I] := Props[frxHTMLStyleUn.Color]
|
||
|
|
else
|
||
|
|
MArray[I] := ADefColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
end
|
||
|
|
else
|
||
|
|
MArray[I] := Props[I];
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.GetVMarginArray(var MArray: ThtVMarginArray);
|
||
|
|
{From: http://www.w3.org/TR/CSS21/box.html#x49
|
||
|
|
|
||
|
|
If an element's border color is not specified with a
|
||
|
|
border property, user agents must use the value of the
|
||
|
|
element's 'color' property as the computed value for
|
||
|
|
the border color.
|
||
|
|
}
|
||
|
|
begin
|
||
|
|
GetVMarginArrayDefBorder(MArray,Props[frxHTMLStyleUn.Color]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.AddPropertyByIndex(Index: ThtPropIndices; PropValue: ThtString; IsImportant: Boolean);
|
||
|
|
var
|
||
|
|
NewColor: TColor;
|
||
|
|
WhiteSpaceStyle : ThtWhiteSpaceStyle;
|
||
|
|
begin
|
||
|
|
case Index of
|
||
|
|
BorderTopColor..BorderLeftColor:
|
||
|
|
if TryStrToColor(PropValue, False, NewColor) then
|
||
|
|
Props[Index] := NewColor
|
||
|
|
else if LowerCase(PropValue) = CurColorStr then
|
||
|
|
Props[Index] := CurColor_Val;
|
||
|
|
|
||
|
|
Color, BackgroundColor:
|
||
|
|
if TryStrToColor(PropValue, False, NewColor) then
|
||
|
|
Props[Index] := NewColor
|
||
|
|
else if Index = Color then
|
||
|
|
Props[Index] := clBlack
|
||
|
|
else
|
||
|
|
Props[Index] := clNone;
|
||
|
|
|
||
|
|
Visibility:
|
||
|
|
if PropValue = 'visible' then
|
||
|
|
Props[Visibility] := viVisible
|
||
|
|
else if PropValue = 'hidden' then
|
||
|
|
Props[Visibility] := viHidden;
|
||
|
|
|
||
|
|
TextTransform:
|
||
|
|
if PropValue = 'uppercase' then
|
||
|
|
Props[TextTransform] := txUpper
|
||
|
|
else if PropValue = 'lowercase' then
|
||
|
|
Props[TextTransform] := txLower
|
||
|
|
else
|
||
|
|
Props[TextTransform] := txNone;
|
||
|
|
|
||
|
|
WordWrap:
|
||
|
|
if PropValue = 'break-word' then
|
||
|
|
Props[WordWrap] := PropValue
|
||
|
|
else
|
||
|
|
Props[WordWrap] := 'normal';
|
||
|
|
|
||
|
|
piWhiteSpace:
|
||
|
|
if TryStrToWhiteSpace(PropValue,WhiteSpaceStyle) then
|
||
|
|
Props[piWhiteSpace] := PropValue;
|
||
|
|
|
||
|
|
FontVariant:
|
||
|
|
if PropValue = 'small-caps' then
|
||
|
|
Props[FontVariant] := PropValue
|
||
|
|
else if PropValue = 'normal' then
|
||
|
|
Props[FontVariant] := 'normal';
|
||
|
|
|
||
|
|
else
|
||
|
|
Props[Index] := PropValue;
|
||
|
|
end;
|
||
|
|
|
||
|
|
Important[Index] := IsImportant;
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtProperties.AddPropertyByName(const PropName, PropValue: ThtString; IsImportant: Boolean);
|
||
|
|
var
|
||
|
|
Index: ThtPropIndices;
|
||
|
|
begin
|
||
|
|
if TryStrToPropIndex(PropName, Index) then
|
||
|
|
AddPropertyByIndex(Index, PropValue, IsImportant);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TfrxHtStyleList }
|
||
|
|
|
||
|
|
constructor TfrxHtStyleList.Create;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
Sorted := True;
|
||
|
|
Duplicates := dupAccept;
|
||
|
|
SeqNo := 10;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TfrxHtStyleList.Destroy;
|
||
|
|
begin
|
||
|
|
Clear;
|
||
|
|
inherited Destroy;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtStyleList.Clear;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
for I := 0 to Count - 1 do
|
||
|
|
TfrxHtProperties(Objects[I]).Free;
|
||
|
|
SeqNo := 10;
|
||
|
|
inherited;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtStyleList.GetSeqNo: ThtString;
|
||
|
|
begin
|
||
|
|
{used to help sort contextual items by entry sequence}
|
||
|
|
// BG, 23.05.2013: Without fixed width for the number string entries 12 and 111 are sorted literally:
|
||
|
|
// 'ul 111'
|
||
|
|
// 'ul 12'.
|
||
|
|
// With fixed width the sort order is:
|
||
|
|
// 'ul 00012'
|
||
|
|
// 'ul 00111'
|
||
|
|
Result := htString(Format('%.5d', [SeqNo]));
|
||
|
|
Inc(SeqNo);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure FixBordProps(AProp, BodyProp : TfrxHtProperties);
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var i : ThtPropIndices;
|
||
|
|
begin
|
||
|
|
for i := BorderTopColor to BorderLeftColor do
|
||
|
|
AProp.Props[I] := BodyProp.Props[I];
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtStyleList.AddModifyProp(const Selector, Prop, Value: ThtString; IsImportant: Boolean);
|
||
|
|
{strings are all lowercase here}
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
PropIndex: ThtPropIndices;
|
||
|
|
Propty: TfrxHtProperties;
|
||
|
|
NewColor: TColor;
|
||
|
|
NewProp: Boolean;
|
||
|
|
begin
|
||
|
|
if TryStrToPropIndex(Prop, PropIndex) then
|
||
|
|
begin
|
||
|
|
I := -1;
|
||
|
|
if not Find(Selector, I) then
|
||
|
|
begin
|
||
|
|
NewProp := True;
|
||
|
|
Propty := TfrxHtProperties.Create(); {newly created property}
|
||
|
|
Propty.DefPointSize := FDefPointSize;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Propty := TfrxHtProperties(Objects[I]); {modify existing property}
|
||
|
|
NewProp := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if PropIndex = Color then
|
||
|
|
begin
|
||
|
|
if TryStrToColor(Value, False, NewColor) then
|
||
|
|
begin
|
||
|
|
if Selector = ':link' then
|
||
|
|
begin {changed the defaults to be the same as link}
|
||
|
|
ModifyLinkColor('hover', NewColor);
|
||
|
|
ModifyLinkColor('visited', NewColor);
|
||
|
|
end
|
||
|
|
else if Selector = ':visited' then
|
||
|
|
ModifyLinkColor('hover', NewColor);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
Propty.AddPropertyByIndex(PropIndex, Value, IsImportant);
|
||
|
|
|
||
|
|
if NewProp then
|
||
|
|
AddObject(Selector, Propty); {it's a newly created property}
|
||
|
|
if Pos(':hover', Selector) > 0 then
|
||
|
|
LinksActive := True;
|
||
|
|
if Selector = 'a' then
|
||
|
|
begin
|
||
|
|
AddModifyProp('::link', Prop, Value, IsImportant); {also applies to ::link}
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtStyleList.AddObject(const S: ThtString; AObject: TObject): Integer;
|
||
|
|
begin
|
||
|
|
Result := inherited AddObject(S, AObject);
|
||
|
|
TfrxHtProperties(AObject).PropTag := S;
|
||
|
|
TfrxHtProperties(AObject).FDefPointSize := DefPointSize;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtStyleList.AddDuplicate(const Tag: ThtString; Prop: TfrxHtProperties): TfrxHtProperties;
|
||
|
|
begin
|
||
|
|
Result := TfrxHtProperties.Create(Prop.PropStack);
|
||
|
|
Result.Copy(Prop);
|
||
|
|
AddObject(Tag, Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtStyleList.ModifyLinkColor(Pseudo: ThtString; AColor: TColor);
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
I := -1;
|
||
|
|
if Find('::' + Pseudo, I) then {the defaults}
|
||
|
|
with TfrxHtProperties(Objects[I]) do
|
||
|
|
Props[Color] := AColor;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfrxHtStyleList.Initialize(const FontName, PreFontName: ThtString; PointSize: Double;
|
||
|
|
AColor, AHotspot, AVisitedColor, AActiveColor: TColor; LinkUnderline: Boolean;
|
||
|
|
ACodePage: TBuffCodePage; ACharSet: TFontCharSet; MarginHeight, MarginWidth: Integer);
|
||
|
|
type
|
||
|
|
ListTypes = (ul, ol, menu, dir, dl, dd, blockquote);
|
||
|
|
const
|
||
|
|
ListStr: array[Low(ListTypes)..High(ListTypes)] of ThtString =
|
||
|
|
('ul', 'ol', 'menu', 'dir', 'dl', 'dd', 'blockquote');
|
||
|
|
var
|
||
|
|
HIndex: Integer;
|
||
|
|
Properties: TfrxHtProperties;
|
||
|
|
J: ListTypes;
|
||
|
|
//F: Double;
|
||
|
|
|
||
|
|
begin
|
||
|
|
Clear;
|
||
|
|
DefPointSize := PointSize;
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.DefFontname := FontName;
|
||
|
|
Properties.Props[FontFamily] := FontName;
|
||
|
|
Properties.Props[FontSize] := PointSize;
|
||
|
|
Properties.Props[FontStyle] := 'none';
|
||
|
|
Properties.Props[FontWeight] := 'normal';
|
||
|
|
// Properties.Props[TextAlign] := 'left';
|
||
|
|
Properties.Props[TextDecoration] := 'none';
|
||
|
|
Properties.Props[TextTransform] := txNone;
|
||
|
|
Properties.Props[WordWrap] := 'normal';
|
||
|
|
Properties.Props[piWhiteSpace] := 'normal';
|
||
|
|
Properties.Props[FontVariant] := 'normal';
|
||
|
|
Properties.Props[Color] := AColor;
|
||
|
|
Properties.Props[MarginTop] := MarginHeight;
|
||
|
|
Properties.Props[MarginBottom] := MarginHeight;
|
||
|
|
Properties.Props[MarginLeft] := MarginWidth;
|
||
|
|
Properties.Props[MarginRight] := MarginWidth;
|
||
|
|
Properties.Props[Visibility] := viVisible;
|
||
|
|
Properties.Props[LetterSpacing] := 0;
|
||
|
|
Properties.Props[BoxSizing] := ContentBox;
|
||
|
|
Properties.CodePage := ACodePage;
|
||
|
|
Properties.CharSet := ACharSet;
|
||
|
|
AddObject('default', Properties);
|
||
|
|
FDefProp := Properties;
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[Color] := AHotSpot or PalRelative;
|
||
|
|
if LinkUnderline then
|
||
|
|
Properties.Props[TextDecoration] := 'underline'
|
||
|
|
else
|
||
|
|
Properties.Props[TextDecoration] := 'none';
|
||
|
|
AddObject('::link', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[Color] := AVisitedColor or PalRelative;
|
||
|
|
AddObject('::visited', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[Color] := AActiveColor or PalRelative;
|
||
|
|
AddObject('::hover', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
AddObject('null', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontFamily] := PreFontName;
|
||
|
|
Properties.Props[FontSize] := PointSize * 10.0 / 12.0;
|
||
|
|
Properties.Props[FontStyle] := 'none';
|
||
|
|
Properties.Props[FontWeight] := 'normal';
|
||
|
|
Properties.Props[TextDecoration] := 'none';
|
||
|
|
Properties.Props[piWhiteSpace] := 'pre';
|
||
|
|
AddObject('pre', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[MarginTop] := AutoParagraph;
|
||
|
|
Properties.Props[MarginBottom] := AutoParagraph;
|
||
|
|
AddObject('p', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[MarginTop] := 0;
|
||
|
|
AddObject('p 11pre', Properties);
|
||
|
|
|
||
|
|
for J := Low(ListTypes) to High(ListTypes) do
|
||
|
|
begin
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
case J of
|
||
|
|
ol, ul, menu, dir:
|
||
|
|
begin
|
||
|
|
Properties.Props[ListStyleType] := 'blank';
|
||
|
|
Properties.Props[MarginTop] := AutoParagraph;
|
||
|
|
Properties.Props[MarginBottom] := AutoParagraph;
|
||
|
|
Properties.Props[MarginLeft] := IntNull;
|
||
|
|
Properties.Props[PaddingLeft] := ListIndent;
|
||
|
|
end;
|
||
|
|
|
||
|
|
dl:
|
||
|
|
begin
|
||
|
|
Properties.Props[ListStyleType] := 'none';
|
||
|
|
Properties.Props[MarginLeft] := 0;
|
||
|
|
Properties.Props[MarginTop] := 0;
|
||
|
|
Properties.Props[MarginBottom] := 0;
|
||
|
|
Properties.Props[MarginLeft] := 0;
|
||
|
|
end;
|
||
|
|
|
||
|
|
blockquote:
|
||
|
|
begin
|
||
|
|
Properties.Props[MarginTop] := AutoParagraph;
|
||
|
|
Properties.Props[MarginBottom] := ParagraphSpace;
|
||
|
|
Properties.Props[MarginLeft] := ListIndent;
|
||
|
|
end;
|
||
|
|
|
||
|
|
dd:
|
||
|
|
begin
|
||
|
|
Properties.Props[MarginTop] := 0;
|
||
|
|
Properties.Props[MarginBottom] := 0;
|
||
|
|
Properties.Props[MarginLeft] := ListIndent;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
AddObject(ListStr[J], Properties);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontFamily] := PrefontName;
|
||
|
|
Properties.Props[FontSize] := '0.83em'; {10.0 / 12.0;}
|
||
|
|
AddObject('code', Properties);
|
||
|
|
AddDuplicate('tt', Properties);
|
||
|
|
AddDuplicate('kbd', Properties);
|
||
|
|
AddDuplicate('samp', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontWeight] := 'bold';
|
||
|
|
AddObject('b', Properties);
|
||
|
|
AddDuplicate('strong', Properties);
|
||
|
|
AddDuplicate('th', Properties);
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[TextAlign] := 'none';
|
||
|
|
AddObject('table', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontSize] := '0.83em';
|
||
|
|
Properties.Props[VerticalAlign] := 'super';
|
||
|
|
AddObject('sup', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontSize] := '0.83em';
|
||
|
|
Properties.Props[VerticalAlign] := 'sub';
|
||
|
|
AddObject('sub', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontSize] := '1.17em';
|
||
|
|
AddObject('big', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontSize] := '0.83em';
|
||
|
|
AddObject('small', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontStyle] := 'italic';
|
||
|
|
AddObject('i', Properties);
|
||
|
|
AddDuplicate('em', Properties);
|
||
|
|
AddDuplicate('cite', Properties);
|
||
|
|
AddDuplicate('var', Properties);
|
||
|
|
AddDuplicate('dfn', Properties);
|
||
|
|
|
||
|
|
AddDuplicate('address', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[TextDecoration] := 'underline';
|
||
|
|
AddObject('u', Properties);
|
||
|
|
AddDuplicate('ins',Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[TextDecoration] := 'line-through';
|
||
|
|
AddObject('s', Properties);
|
||
|
|
AddDuplicate('strike', Properties);
|
||
|
|
AddDuplicate('del',Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[TextAlign] := 'center';
|
||
|
|
AddObject('center', Properties);
|
||
|
|
AddDuplicate('caption', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontFamily] := 'Arial Unicode MS, Arial';
|
||
|
|
Properties.Props[FontSize] := '10pt';
|
||
|
|
Properties.Props[FontStyle] := 'none';
|
||
|
|
Properties.Props[FontWeight] := 'normal';
|
||
|
|
Properties.Props[TextAlign] := 'left';
|
||
|
|
Properties.Props[TextDecoration] := 'none';
|
||
|
|
Properties.Props[Color] := AColor;
|
||
|
|
AddObject('input', Properties);
|
||
|
|
AddDuplicate('select', Properties);
|
||
|
|
|
||
|
|
Properties := AddDuplicate('textarea', Properties);
|
||
|
|
Properties.Props[FontFamily] := PreFontName;
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[MarginLeft] := 0;
|
||
|
|
Properties.Props[MarginRight] := 0;
|
||
|
|
Properties.Props[MarginTop] := 10;
|
||
|
|
Properties.Props[MarginBottom] := 10;
|
||
|
|
AddObject('hr', Properties);
|
||
|
|
|
||
|
|
for HIndex := 1 to 6 do
|
||
|
|
begin
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
//F := PointSize / 12.0;
|
||
|
|
case HIndex of
|
||
|
|
1: Properties.Props[FontSize] := '2em';
|
||
|
|
2: Properties.Props[FontSize] := '1.5em';
|
||
|
|
3: Properties.Props[FontSize] := '1.17em';
|
||
|
|
else
|
||
|
|
Properties.Props[FontSize] := '1em';
|
||
|
|
end;
|
||
|
|
case HIndex of
|
||
|
|
4: Properties.Props[MarginTop] := '1.67em';
|
||
|
|
5: Properties.Props[MarginTop] := '1.5em';
|
||
|
|
6: Properties.Props[MarginTop] := '1.12em';
|
||
|
|
else
|
||
|
|
Properties.Props[MarginTop] := 19;
|
||
|
|
end;
|
||
|
|
Properties.Props[MarginBottom] := Properties.Props[MarginTop];
|
||
|
|
Properties.Props[FontWeight] := 'bolder';
|
||
|
|
AddObject( htString('h' + IntToStr(HIndex)), Properties);
|
||
|
|
end;
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[FontStyle] := 'none';
|
||
|
|
Properties.Props[BackgroundColor] := $00FFFF;
|
||
|
|
Properties.Props[Color] := $000000;
|
||
|
|
AddObject('mark', Properties);
|
||
|
|
|
||
|
|
Properties := TfrxHtProperties.Create;
|
||
|
|
Properties.Props[ frxHTMLStyleUn.BorderBottomStyle ] := 'dotted';
|
||
|
|
Properties.Props[ frxHTMLStyleUn.BorderBottomWidth ] := '1px';
|
||
|
|
AddObject('abbr', Properties);
|
||
|
|
AddDuplicate('acronym',Properties);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TfrxHtPropStack }
|
||
|
|
|
||
|
|
function TfrxHtPropStack.GetProp(Index: Integer): TfrxHtProperties;
|
||
|
|
begin
|
||
|
|
Result := Get(Index); //TfrxHtProperties(inherited Items[Index]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfrxHtPropStack.Last: TfrxHtProperties;
|
||
|
|
begin
|
||
|
|
Result := Get(Count - 1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
const
|
||
|
|
NumColors = 178;
|
||
|
|
Colors: array[1..NumColors] of ThtString = (
|
||
|
|
'none', 'transparent',
|
||
|
|
|
||
|
|
'black', 'maroon', 'green', 'olive', 'navy', 'purple', 'teal', 'gray',
|
||
|
|
'silver', 'red', 'lime', 'yellow', 'blue', 'fuchsia', 'aqua', 'white',
|
||
|
|
'aliceblue', 'antiquewhite', 'aquamarine', 'azure', 'beige',
|
||
|
|
'bisque', 'blanchedalmond', 'blueviolet', 'brown', 'burlywood',
|
||
|
|
'cadetblue', 'chartreuse', 'chocolate', 'coral', 'cornflowerblue',
|
||
|
|
'cornsilk', 'crimson', 'cyan', 'darkblue', 'darkcyan',
|
||
|
|
'darkgoldenrod', 'darkgray', 'darkgreen', 'darkkhaki', 'darkmagenta',
|
||
|
|
'darkolivegreen', 'darkorange', 'darkorchid', 'darkred', 'darksalmon',
|
||
|
|
'darkseagreen', 'darkslateblue', 'darkslategray', 'darkturquoise', 'darkviolet',
|
||
|
|
'deeppink', 'deepskyblue', 'dimgray', 'dodgerblue', 'firebrick',
|
||
|
|
'floralwhite', 'forestgreen', 'gainsboro', 'ghostwhite', 'gold',
|
||
|
|
'goldenrod', 'greenyellow', 'honeydew', 'hotpink', 'indianred',
|
||
|
|
'indigo', 'ivory', 'khaki', 'lavender', 'lavenderblush',
|
||
|
|
'lawngreen', 'lemonchiffon', 'lightblue', 'lightcoral', 'lightcyan',
|
||
|
|
'lightgoldenrodyellow', 'lightgreen', 'lightgray', 'lightpink', 'lightsalmon',
|
||
|
|
'lightseagreen', 'lightskyblue', 'lightslategray', 'lightsteelblue', 'lightyellow',
|
||
|
|
'limegreen', 'linen', 'magenta', 'mediumaquamarine', 'mediumblue',
|
||
|
|
'mediumorchid', 'mediumpurple', 'mediumseagreen', 'mediumslateblue', 'mediumspringgreen',
|
||
|
|
'mediumturquoise', 'mediumvioletred', 'midnightblue', 'mintcream', 'mistyrose',
|
||
|
|
'moccasin', 'navajowhite', 'oldlace', 'olivedrab', 'orange',
|
||
|
|
'orangered', 'orchid', 'palegoldenrod', 'palegreen', 'paleturquoise',
|
||
|
|
'palevioletred', 'papayawhip', 'peachpuff', 'peru', 'pink',
|
||
|
|
'plum', 'powderblue', 'rosybrown', 'royalblue', 'saddlebrown',
|
||
|
|
'salmon', 'sandybrown', 'seagreen', 'seashell', 'sienna',
|
||
|
|
'skyblue', 'slateblue', 'slategray', 'snow', 'springgreen',
|
||
|
|
'steelblue', 'tan', 'thistle', 'tomato', 'turquoise',
|
||
|
|
'violet', 'wheat', 'whitesmoke', 'yellowgreen',
|
||
|
|
|
||
|
|
'grey', 'darkgrey', 'darkslategrey', 'dimgrey', 'lightgrey', 'lightslategrey', 'slategrey',
|
||
|
|
'rebeccapurple', //CSS4 tribute to Eric Meyer's daughter, Rebecca, died of cancer on her sixth birthday
|
||
|
|
'background', 'activecaption', 'inactivecaption', 'menu', 'window',
|
||
|
|
'windowframe', 'menutext', 'windowtext', 'captiontext', 'activeborder',
|
||
|
|
'inactiveborder', 'appworkSpace', 'highlight', 'hightlighttext', 'buttonface',
|
||
|
|
'buttonshadow', 'graytext', 'buttontext', 'inactivecaptiontext', 'buttonhighlight',
|
||
|
|
'threeddarkshadow', 'threedlightshadow', 'infotext', 'infobackground', 'scrollbar',
|
||
|
|
'threedface', 'threedhighlight', 'threedshadow');
|
||
|
|
|
||
|
|
ColorValues: array[1..NumColors] of TColor = (clNone, clNone,
|
||
|
|
clBLACK, clMAROON, clGREEN, clOLIVE, clNAVY, clPURPLE, clTEAL, clGRAY,
|
||
|
|
clSILVER, clRED, clLIME, clYELLOW, clBLUE, clFUCHSIA, clAQUA, clWHITE,
|
||
|
|
$FFF8F0, $D7EBFA, $D4FF7F, $FFFFF0, $DCF5F5,
|
||
|
|
$C4E4FF, $CDEBFF, $E22B8A, $2A2AA5, $87B8DE,
|
||
|
|
$A09E5F, $00FF7F, $1E69D2, $507FFF, $ED9564,
|
||
|
|
$DCF8FF, $3614DC, $FFFF00, $8B0000, $8B8B00,
|
||
|
|
$0B86B8, $A9A9A9, $006400, $6BB7BD, $8B008B,
|
||
|
|
$2F6B55, $008CFF, $CC3299, $00008B, $7A96E9,
|
||
|
|
$8FBC8F, $8B3D48, $4F4F2F, $D1CE00, $D30094,
|
||
|
|
$9314FF, $FFBF00, $696969, $FF901E, $2222B2,
|
||
|
|
$F0FAFF, $228B22, $DCDCDC, $FFF8F8, $00D7FF,
|
||
|
|
$20A5DA, $2FFFAD, $F0FFF0, $B469FF, $5C5CCD,
|
||
|
|
$82004B, $F0FFFF, $8CE6F0, $FAE6E6, $F5F0FF,
|
||
|
|
$00FC7C, $CDFAFF, $E6D8AD, $8080F0, $FFFFE0,
|
||
|
|
$D2FAFA, $90EE90, $D3D3D3, $C1B6FF, $7AA0FF,
|
||
|
|
$AAB220, $FACE87, $998877, $DEC4B0, $E0FFFF,
|
||
|
|
$32CD32, $E6F0FA, $FF00FF, $AACD66, $CD0000,
|
||
|
|
$D355BA, $DB7093, $71B33C, $EE687B, $9AFA00,
|
||
|
|
$CCD148, $8515C7, $701919, $FAFFF5, $E1E4FF,
|
||
|
|
$B5E4FF, $ADDEFF, $E6F5FD, $238E6B, $00A5FF,
|
||
|
|
$0045FF, $D670DA, $AAE8EE, $98FB98, $EEEEAF,
|
||
|
|
$9370DB, $D5EFFF, $B9DAFF, $3F85CD, $CBC0FF,
|
||
|
|
$DDA0DD, $E6E0B0, $8F8FBC, $E16941, $13458B,
|
||
|
|
$7280FA, $60A4F4, $578B2E, $EEF5FF, $2D52A0,
|
||
|
|
$EBCE87, $CD5A6A, $908070, $FAFAFF, $7FFF00,
|
||
|
|
$B48246, $8CB4D2, $D8BFD8, $4763FF, $D0E040,
|
||
|
|
$EE82EE, $B3DEF5, $F5F5F5, $32CD9A,
|
||
|
|
clGray, $A9A9A9, $4F4F2F, $696969, $D3D3D3, $998877, $908070,
|
||
|
|
$663399,
|
||
|
|
clBackground, clActiveCaption, clInactiveCaption, clMenu, clWindow,
|
||
|
|
clWindowFrame, clMenuText, clWindowText, clCaptionText, clActiveBorder,
|
||
|
|
clInactiveBorder, clAppWorkSpace, clHighlight, clHighlightText, clBtnFace,
|
||
|
|
clBtnShadow, clGrayText, clBtnText, clInactiveCaptionText, clBtnHighlight,
|
||
|
|
cl3DDkShadow, clBtnHighlight, clInfoText, clInfoBk, clScrollBar,
|
||
|
|
clBtnFace, cl3DLight, clBtnShadow);
|
||
|
|
|
||
|
|
var
|
||
|
|
ColorStrings: ThtStringList;
|
||
|
|
|
||
|
|
function SortedColors: ThtStringList;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
// Put the Colors into a sorted StringList for faster access.
|
||
|
|
if ColorStrings = nil then
|
||
|
|
begin
|
||
|
|
ColorStrings := ThtStringList.Create;
|
||
|
|
for I := 1 to NumColors do
|
||
|
|
ColorStrings.AddObject(Colors[I], @ColorValues[I]);
|
||
|
|
ColorStrings.Sort;
|
||
|
|
end;
|
||
|
|
Result := ColorStrings;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function OpacityFromStr(S : ThtString) : Byte;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var LErr : Integer;
|
||
|
|
LR : Real;
|
||
|
|
begin
|
||
|
|
Val(S,LR,LErr);
|
||
|
|
if LErr <> 0 then begin
|
||
|
|
Result := 255;
|
||
|
|
end else begin
|
||
|
|
Result := Trunc(255 * LR);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TryStrToColor(S: ThtString; NeedPound: Boolean; out Color: TColor): Boolean;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var LDummy : Byte;
|
||
|
|
begin
|
||
|
|
Result := ColorAndOpacityFromString(S,NeedPound,Color,LDummy);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function ColorAndOpacityFromString(S: ThtString; NeedPound: Boolean; out Color: TColor; out VOpacity : Byte): Boolean;
|
||
|
|
{Translate StyleSheet color ThtString to Color. If NeedPound is true, a '#' sign
|
||
|
|
is required to preceed a hexidecimal value.}
|
||
|
|
const
|
||
|
|
LastS: ThtString = '?&%@';
|
||
|
|
LastColor: TColor = 0;
|
||
|
|
|
||
|
|
var
|
||
|
|
I, Rd, Bl: Integer;
|
||
|
|
S1: ThtString;
|
||
|
|
|
||
|
|
function FindHSLColor(S: ThtString): Boolean;
|
||
|
|
type
|
||
|
|
Colors = (hue, saturation, luminance);
|
||
|
|
var
|
||
|
|
I, J: Integer;
|
||
|
|
var
|
||
|
|
A: array[hue..luminance] of ThtString;
|
||
|
|
C: array[hue..luminance] of Integer;
|
||
|
|
K: Colors;
|
||
|
|
begin
|
||
|
|
I := Pos('(', S);
|
||
|
|
J := Pos(')', S);
|
||
|
|
if (I > 0) and (J > 0) then
|
||
|
|
begin
|
||
|
|
S := Copy(S, 1, J - 1);
|
||
|
|
S := Trim(Copy(S, I + 1, 255));
|
||
|
|
for K := hue to saturation do
|
||
|
|
begin
|
||
|
|
I := Pos(',', S);
|
||
|
|
A[K] := Trim(Copy(S, 1, I - 1));
|
||
|
|
S := Trim(Copy(S, I + 1, 255));
|
||
|
|
end;
|
||
|
|
I := Pos(',', S);
|
||
|
|
if I > 0 then begin
|
||
|
|
A[luminance] := Trim(Copy(S, 1, I - 1));
|
||
|
|
S := Trim(Copy(S, I + 1, 255));
|
||
|
|
VOpacity := OpacityFromStr(S);
|
||
|
|
end else begin
|
||
|
|
A[luminance] := S;
|
||
|
|
VOpacity := 255;
|
||
|
|
end;
|
||
|
|
|
||
|
|
C[hue] := StrToIntDef( htStringToString(A[hue]), 0);
|
||
|
|
while C[hue] >= 360 do begin
|
||
|
|
C[hue] := C[hue] - 360;
|
||
|
|
end;
|
||
|
|
while C[hue] < 0 do begin
|
||
|
|
C[hue] := C[hue] + 360;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for K := saturation to luminance do begin
|
||
|
|
I := Pos('%', A[K]);
|
||
|
|
if I > 0 then begin
|
||
|
|
Delete(A[K], I, 1);
|
||
|
|
end;
|
||
|
|
C[K] := StrToIntDef( htStringToString(A[K]), 0);
|
||
|
|
if C[K] > 100 then begin
|
||
|
|
C[K] := 100;
|
||
|
|
end;
|
||
|
|
if C[K] < 0 then begin
|
||
|
|
C[K] := 0;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
Color := HSL2Color(C[hue],C[saturation],C[luminance]);
|
||
|
|
Result := True;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function FindRGBColor(S: ThtString): Boolean;
|
||
|
|
type
|
||
|
|
Colors = (red, green, blue);
|
||
|
|
var
|
||
|
|
A: array[red..blue] of ThtString;
|
||
|
|
C: array[red..blue] of Integer;
|
||
|
|
I, J: Integer;
|
||
|
|
K: Colors;
|
||
|
|
|
||
|
|
begin
|
||
|
|
I := Pos('(', S);
|
||
|
|
J := Pos(')', S);
|
||
|
|
if (I > 0) and (J > 0) then
|
||
|
|
begin
|
||
|
|
S := copy(S, 1, J - 1);
|
||
|
|
S := Trim(Copy(S, I + 1, 255));
|
||
|
|
for K := Red to Green do
|
||
|
|
begin
|
||
|
|
I := Pos(',', S);
|
||
|
|
A[K] := Trim(copy(S, 1, I - 1));
|
||
|
|
S := Trim(Copy(S, I + 1, 255));
|
||
|
|
end;
|
||
|
|
I := Pos(',', S);
|
||
|
|
if I > 0 then begin
|
||
|
|
A[blue] := Trim(copy(S, 1, I - 1));
|
||
|
|
S := Trim(Copy(S, I + 1, 255));
|
||
|
|
VOpacity := OpacityFromStr(S);
|
||
|
|
end else begin
|
||
|
|
A[blue] := S;
|
||
|
|
VOpacity := 255;
|
||
|
|
end;
|
||
|
|
|
||
|
|
for K := Red to Blue do
|
||
|
|
begin
|
||
|
|
I := Pos('%', A[K]);
|
||
|
|
if I > 0 then
|
||
|
|
begin
|
||
|
|
Delete(A[K], I, 1);
|
||
|
|
try
|
||
|
|
C[K] := Round( StrToFloat( htStringToString(A[K])) * 2.55);
|
||
|
|
except
|
||
|
|
C[K] := 0;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
C[K] := StrToIntDef( htStringToString(A[K]), 0);
|
||
|
|
C[K] := Max(0, Min(255, C[K]));
|
||
|
|
end;
|
||
|
|
Color := (C[Blue] shl 16) or (C[Green] shl 8) or C[Red];
|
||
|
|
Result := True;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//BG, 26.08.2009: exceptions are very slow
|
||
|
|
var
|
||
|
|
Int: Integer;
|
||
|
|
Idx : Integer;
|
||
|
|
//BG, 26.08.2009
|
||
|
|
begin
|
||
|
|
//Opacity is not supported with # hexidecimal notation or color names
|
||
|
|
VOpacity := 255;
|
||
|
|
if S = '' then
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
S := Lowercase(Trim(S));
|
||
|
|
if S = LastS then
|
||
|
|
begin {inquiries often come in pairs, this saves some recomputing}
|
||
|
|
Color := LastColor;
|
||
|
|
Result := True;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
I := Pos('hsl',S);
|
||
|
|
if I > 0 then begin
|
||
|
|
Result := FindHSLColor(Copy(S, I + 3, 255));
|
||
|
|
if Result then
|
||
|
|
begin
|
||
|
|
LastS := S1;
|
||
|
|
LastColor := Color;
|
||
|
|
end;
|
||
|
|
exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
I := Pos('rgb', S);
|
||
|
|
if (I = 0) and (S[1] <> '#') then
|
||
|
|
begin
|
||
|
|
Idx := -1;
|
||
|
|
if SortedColors.Find(S, Idx) then
|
||
|
|
begin
|
||
|
|
Color := PColor(SortedColors.Objects[Idx])^;
|
||
|
|
Result := True;
|
||
|
|
LastS := S;
|
||
|
|
LastColor := Color;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
S1 := S;
|
||
|
|
if (I > 0) then
|
||
|
|
Result := FindRGBColor(Copy(S, I + 3, 255))
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
// try
|
||
|
|
I := Pos('#', S);
|
||
|
|
if I > 0 then
|
||
|
|
while I > 0 do {sometimes multiple ##}
|
||
|
|
begin
|
||
|
|
Delete(S, 1, I);
|
||
|
|
I := Pos('#', S);
|
||
|
|
end
|
||
|
|
else if NeedPound then
|
||
|
|
begin
|
||
|
|
Result := False;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
S := Trim(S);
|
||
|
|
if Length(S) <= 3 then
|
||
|
|
for I := Length(S) downto 1 do
|
||
|
|
Insert(S[I], S, I); {Double each character}
|
||
|
|
Result := TryStrToInt('$' + htStringToString(S), Int);
|
||
|
|
if Result then
|
||
|
|
begin
|
||
|
|
{ok, but bytes are backwards!}
|
||
|
|
Rd := Int and $FF;
|
||
|
|
Bl := Int and $FF0000;
|
||
|
|
Color := (Int and $00FF00) + (Rd shl 16) + (Bl shr 16) or PalRelative;
|
||
|
|
end;
|
||
|
|
// except
|
||
|
|
// Result := False;
|
||
|
|
// end;
|
||
|
|
end;
|
||
|
|
if Result then
|
||
|
|
begin
|
||
|
|
LastS := S1;
|
||
|
|
LastColor := Color;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//BG, 14.07.2010:
|
||
|
|
function DecodeSize(const Str: ThtString; out V: extended; out U: ThtString): Boolean;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var
|
||
|
|
I, J, L: Integer;
|
||
|
|
begin
|
||
|
|
U := '';
|
||
|
|
Val(Str, V, I);
|
||
|
|
Result := I <> 1;
|
||
|
|
if Result then
|
||
|
|
begin
|
||
|
|
L := Length(Str);
|
||
|
|
if I = 0 then
|
||
|
|
I := L + 1;
|
||
|
|
J := Pos('e', Str); {'e' would be legal for Val but not for us}
|
||
|
|
if (J > 0) and (I > J) then
|
||
|
|
I := J;
|
||
|
|
if I <= L then
|
||
|
|
begin
|
||
|
|
Val(Copy(Str, 1, I - 1), V, J);
|
||
|
|
U := Trim(Copy(Str, I, L - I + 1)); // text after number, maybe a unit
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function IncFontSize(OldSize: Double; Increment: ThtFontSizeIncrement): Double;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
var
|
||
|
|
OldIndex, NewIndex: Byte;
|
||
|
|
D1, D2: Double;
|
||
|
|
begin
|
||
|
|
// get nearest old font size index
|
||
|
|
OldIndex := 4;
|
||
|
|
D1 := OldSize - FontConv[OldIndex];
|
||
|
|
repeat
|
||
|
|
case Sign(D1) of
|
||
|
|
-1:
|
||
|
|
begin
|
||
|
|
Dec(OldIndex);
|
||
|
|
D2 := OldSize - FontConv[OldIndex];
|
||
|
|
if D2 >= 0 then
|
||
|
|
begin
|
||
|
|
if Abs(D1) < Abs(D2) then
|
||
|
|
Inc(OldIndex);
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
D1 := D2;
|
||
|
|
end;
|
||
|
|
|
||
|
|
1:
|
||
|
|
begin
|
||
|
|
Inc(OldIndex);
|
||
|
|
D2 := OldSize - FontConv[OldIndex];
|
||
|
|
if D2 <= 0 then
|
||
|
|
begin
|
||
|
|
if Abs(D1) > Abs(D2) then
|
||
|
|
Dec(OldIndex);
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
D1 := D2;
|
||
|
|
end;
|
||
|
|
|
||
|
|
else
|
||
|
|
break;
|
||
|
|
end;
|
||
|
|
until (OldIndex = 1) or (OldIndex = 7);
|
||
|
|
|
||
|
|
NewIndex := OldIndex + Increment;
|
||
|
|
if NewIndex < 1 then
|
||
|
|
begin
|
||
|
|
Inc(OldIndex, 1 - NewIndex);
|
||
|
|
NewIndex := 1;
|
||
|
|
end
|
||
|
|
else if NewIndex > 7 then
|
||
|
|
begin
|
||
|
|
Dec(OldIndex, NewIndex - 7);
|
||
|
|
NewIndex := 7;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if OldIndex = NewIndex then
|
||
|
|
Result := OldSize
|
||
|
|
else
|
||
|
|
Result := OldSize * FontConv[NewIndex] / FontConv[OldIndex];
|
||
|
|
end;
|
||
|
|
|
||
|
|
function FontSizeConv(const Str: ThtString; OldSize, DefPointSize : Double): Double;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
{given a font-size ThtString, return the point size}
|
||
|
|
var
|
||
|
|
V, VScreen: extended;
|
||
|
|
U: ThtString;
|
||
|
|
begin
|
||
|
|
if DecodeSize(Str, V, U) then
|
||
|
|
begin
|
||
|
|
VScreen := V / Screen.PixelsPerInch;
|
||
|
|
|
||
|
|
if (U = 'px') or (U = '') then
|
||
|
|
Result := VScreen * 72.0
|
||
|
|
else if U = 'in' then
|
||
|
|
Result := VScreen * 72.0 * 96.0
|
||
|
|
else if U = 'cm' then
|
||
|
|
Result := VScreen * 72.0 * 96.0 / 2.54
|
||
|
|
else if U = 'mm' then
|
||
|
|
Result := VScreen * 72.0 * 96.0 / 25.4
|
||
|
|
else if U = 'pt' then
|
||
|
|
Result := VScreen * 96.0
|
||
|
|
else if U = 'pc' then
|
||
|
|
Result := VScreen * 72.0 * 16
|
||
|
|
|
||
|
|
else if U = 'em' then
|
||
|
|
Result := V * OldSize
|
||
|
|
else if U = 'ex' then
|
||
|
|
Result := V * OldSize * 0.5 {1/2 of em}
|
||
|
|
else if U = '%' then
|
||
|
|
Result := V * OldSize / 100
|
||
|
|
|
||
|
|
else
|
||
|
|
Result := DefPointSize;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
U := Str;
|
||
|
|
if U = 'smaller' then
|
||
|
|
Result := IncFontSize(OldSize, -1) // CSS1: 0.75 * OldSize
|
||
|
|
else if U = 'larger' then
|
||
|
|
Result := IncFontSize(OldSize, 1) // CSS1: 1.25 * OldSize
|
||
|
|
else if U = 'xx-small' then
|
||
|
|
Result := FontConv[1]
|
||
|
|
else if U = 'x-small' then
|
||
|
|
Result := FontConv[1] // same size xx-small (IE and Firefox do it).
|
||
|
|
else if U = 'small' then
|
||
|
|
Result := FontConv[2]
|
||
|
|
else if U = 'medium' then // 'medium' is the user's preferred font size.
|
||
|
|
Result := FontConv[3]
|
||
|
|
else if U = 'large' then
|
||
|
|
Result := FontConv[4]
|
||
|
|
else if U = 'x-large' then
|
||
|
|
Result := FontConv[5]
|
||
|
|
else if U = 'xx-large' then
|
||
|
|
Result := FontConv[6]
|
||
|
|
else
|
||
|
|
Result := DefPointSize;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{----------------LengthConv}
|
||
|
|
|
||
|
|
function LengthConv(const Str: ThtString; Relative: Boolean; Base, EmSize, ExSize, Default: Integer): Integer;
|
||
|
|
{$ifdef UseInline} inline; {$endif}
|
||
|
|
{given a length ThtString, return the appropriate pixel value. Base is the
|
||
|
|
base value for percentage. EmSize, ExSize for units relative to the font.
|
||
|
|
Relative makes a numerical entry relative to Base.
|
||
|
|
Default returned if no match.}
|
||
|
|
var
|
||
|
|
V: Extended;
|
||
|
|
U: ThtString;
|
||
|
|
begin
|
||
|
|
if DecodeSize(Str, V, U) then
|
||
|
|
begin
|
||
|
|
{U the units}
|
||
|
|
if Relative and (U = '') then
|
||
|
|
V := V * Base
|
||
|
|
else if (U = 'px') or (U = '') then
|
||
|
|
V := V
|
||
|
|
|
||
|
|
else if U = 'in' then
|
||
|
|
V := V * 96.0
|
||
|
|
else if U = 'cm' then
|
||
|
|
V := V * 96.0 / 2.54
|
||
|
|
else if U = 'mm' then
|
||
|
|
V := V * 96.0 / 25.4
|
||
|
|
else if U = 'pt' then
|
||
|
|
V := V * 96.0 / 72.0
|
||
|
|
else if U = 'pc' then
|
||
|
|
V := V * 16
|
||
|
|
|
||
|
|
else if U = '%' then
|
||
|
|
V := V * Base / 100
|
||
|
|
else if U = 'em' then
|
||
|
|
V := V * EmSize
|
||
|
|
else if U = 'ex' then
|
||
|
|
V := V * ExSize
|
||
|
|
|
||
|
|
else
|
||
|
|
V := Default;
|
||
|
|
|
||
|
|
Result := Trunc(V); // BG, 14.12.2011: issue 104: avoid too wide "50%". Replace Round() with Trunc().
|
||
|
|
end
|
||
|
|
else
|
||
|
|
// anything else but a number, maybe 'auto'
|
||
|
|
Result := Default;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure CalcAutoMinMaxConstraints(W, H, MinW, MaxW, MinH, MaxH: Integer; out ResW, ResH: Integer);
|
||
|
|
// solving min/max constraint violations as described in CSS 2.1
|
||
|
|
|
||
|
|
procedure AdjustMinMax(var Min, Max: Integer);
|
||
|
|
begin
|
||
|
|
if Min < 0 then
|
||
|
|
Min := 0;
|
||
|
|
if Max < 0 then
|
||
|
|
Max := MaxInt;
|
||
|
|
if Max < Min then
|
||
|
|
Max := Min;
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
FacW, FacH: Double;
|
||
|
|
begin
|
||
|
|
AdjustMinMax(MinW, MaxW);
|
||
|
|
AdjustMinMax(MinH, MaxH);
|
||
|
|
|
||
|
|
{
|
||
|
|
if (w > max-width)
|
||
|
|
if (h < min-height)
|
||
|
|
max-width min-height
|
||
|
|
else if (h > max-height)
|
||
|
|
if (max-width/w > max-height/h)
|
||
|
|
max(max-height * w/h, min-width) max-height
|
||
|
|
else
|
||
|
|
max-width max(min-height, max-width * h/w)
|
||
|
|
else
|
||
|
|
max-width max(min-height, max-width * h/w)
|
||
|
|
}
|
||
|
|
if W > MaxW then
|
||
|
|
begin
|
||
|
|
if H < MinH then
|
||
|
|
begin
|
||
|
|
ResW := MaxW;
|
||
|
|
ResH := MinH;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
FacW := MaxW / W;
|
||
|
|
if H > MaxH then
|
||
|
|
begin
|
||
|
|
FacH := MaxH / H;
|
||
|
|
if FacW > FacH then
|
||
|
|
begin
|
||
|
|
ResH := MaxH;
|
||
|
|
ResW := Max(Round(FacH * W), MinW);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
ResW := MaxW;
|
||
|
|
ResH := Max(Round(FacW * H), MinH);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{
|
||
|
|
if (w < min-width)
|
||
|
|
if (h > max-height)
|
||
|
|
min-width max-height
|
||
|
|
else if (h < min-height)
|
||
|
|
if (min-width/w <= min-height/h)
|
||
|
|
min(max-width, min-height * w/h) min-height
|
||
|
|
else
|
||
|
|
min-width min(min-width * h/w, max-height)
|
||
|
|
else
|
||
|
|
min-width min(min-width * h/w, max-height)
|
||
|
|
}
|
||
|
|
if W < MinW then
|
||
|
|
begin
|
||
|
|
if H > MaxH then
|
||
|
|
begin
|
||
|
|
ResW := MinW;
|
||
|
|
ResH := MaxH;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
FacW := MinW / W;
|
||
|
|
if H < MinH then
|
||
|
|
begin
|
||
|
|
FacH := MinH / H;
|
||
|
|
if FacW <= FacH then
|
||
|
|
begin
|
||
|
|
ResH := MinH;
|
||
|
|
ResW := Min(Round(FacH * W), MaxW);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
ResW := MinW;
|
||
|
|
ResH := Min(Round(FacW * H), MaxH);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ h > max-height max(max-height * w/h, min-width) max-height }
|
||
|
|
if H > MaxH then
|
||
|
|
begin
|
||
|
|
ResH := MaxH;
|
||
|
|
ResW := Max((MaxH * W) div H, MinW);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ h < min-height min(min-height * w/h, max-width) min-height }
|
||
|
|
if H < MinH then
|
||
|
|
begin
|
||
|
|
ResH := MinH;
|
||
|
|
ResW := Min((MinH * W) div H, MaxW);
|
||
|
|
Exit
|
||
|
|
end;
|
||
|
|
|
||
|
|
ResW := W;
|
||
|
|
ResH := H;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
finalization
|
||
|
|
FreeAndNil(ColorStrings);
|
||
|
|
FreeAndNil(PropertyStrings);
|
||
|
|
end.
|