paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-09-14 14:19:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

Turbopower_ipro: Refactor unit ipHtml by extracting parser into separate unit.

Browse Source
This commit is contained in:
wp_xyz 2022-05-27 12:25:20 +02:00
parent 4e92b0a028
commit 4a9da60a1d
10 changed files with 4898 additions and 267 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

836
components/turbopower_ipro/ipcss.pas Normal file
View File

@ -0,0 +1,836 @@
unit IpCSS;
{$mode objfpc}{$H+}
interface
uses
Classes, Contnrs, SysUtils, Graphics,
IpHtmlProp, IpHtmlUtils;
type
TCSSGroup = class
end;
TCSSFontStyle = (cfsNormal, cfsItalic, cfsOblique, cfsInherit);
TCSSFontWeight = (cfwNormal, cfwBold, cfwBolder, cfwLighter, cfw100, cfw200,
cfw300, cfw400 , cfw500, cfw600, cfw700, cfw800, cfw900);
TCSSFontVariant = (cfvNormal, cfvSmallCaps, cfvInherit);
TCSSBorderStyle = (cbsNone, cbsHidden, cbsDotted, cbsDashed, cbsSolid, cbsDouble,
cbsGroove, cbsRidge, cbsInset, cbsOutset);
TCSSMarginStyle = (cmsNone,
cmsAuto, // use default
cmsPx, // pixel
cmsPt, cmsEm, cmsPercent // currently not supported
);
TCSSMargin = record
Style: TCSSMarginStyle;
Size: single; // negative values are allowed (not implemented)
end;
TCSSLengthType = (cltUndefined, cltAbsolute, cltPercent);
TCSSLength = record
LengthValue: Integer;
LengthType: TCSSLengthType
end;
{ TCSSFont }
TCSSFont = class
private
FFamily: String;
FSize: String;
FStyle: TCSSFontStyle;
FWeight: TCSSFontWeight;
published
property Name: String read FFamily write FFamily;
property Size: String read FSize write FSize;
property Style: TCSSFontStyle read FStyle write FStyle;
//proprety Variant: TCSSFontVariant
property Weight: TCSSFontWeight read FWeight write FWeight;
end;
{ TCSSBorder }
TCSSBorder = class
private
FColor: TColor;
FStyle: TCSSBorderStyle;
FWidth: Integer;
public
constructor Create;
published
property Color: TColor read FColor write FColor;
property Style: TCSSBorderStyle read FStyle write FStyle;
property Width: Integer read FWidth write FWidth;
end;
{ TCSSProps represents a set of properties from the CSS stylesheet, for
example everything within one selector or the contents of a style attribute
or even many applicable CSS styles for one node merged into one. It has
methods for parsing CSS text and for merging two such objects into one}
TCSSProps = class
private
FBorder: TCSSBorder;
FClassIDs: TStringList;
FBGColor: TColor;
FBorderBottom: TCSSBorderStyle;
FBorderLeft: TCSSBorderStyle;
FBorderRight: TCSSBorderStyle;
FBorderTop: TCSSBorderStyle;
FColor: TColor;
FFont: TCSSFont;
FAlignment: TIpHtmlAlign;
FMarginBottom: TCSSMargin;
FMarginLeft: TCSSMargin;
FMarginRight: TCSSMargin;
FMarginTop: TCSSMargin;
FWidth: TCSSLength;
function GetCommandArgs(ACommand: String): TStringList;
function GetCommandName(ACommand: String): String;
public
property MarginTop: TCSSMargin read FMarginTop write FMarginTop;
property MarginLeft: TCSSMargin read FMarginLeft write FMarginLeft;
property MarginBottom: TCSSMargin read FMarginBottom write FMarginBottom;
property MarginRight: TCSSMargin read FMarginRight write FMarginRight;
property Width: TCSSLength read FWidth write FWidth;
published
property Font: TCSSFont read FFont write FFont;
property Color: TColor read FColor write FColor;
property BGColor: TColor read FBGColor write FBGColor;
property Border: TCSSBorder read FBorder write FBorder;
property BorderTop: TCSSBorderStyle read FBorderTop write FBorderTop;
property BorderLeft: TCSSBorderStyle read FBorderLeft write FBorderLeft;
property BorderBottom: TCSSBorderStyle read FBorderBottom write FBorderBottom;
property BorderRight: TCSSBorderStyle read FBorderRight write FBorderRight;
property Alignment: TIpHtmlAlign read FAlignment write FAlignment;
public
constructor Create;
destructor Destroy; override;
procedure ReadCommands(ACommands: TStrings);
procedure MergeAdditionalProps(AProps: TCSSProps);
end;
{ TCSSGlobalProps serves as a global list of TCSSProps objects, it is
populated when parsing the CSS and then used to look up the CSS styles
for a certain CSS selector (the selector is supplied as a string and it
returns a reference to the TCSSProps object for this selector). The
contained TCSSProps objects are created and owned by TCSSGlobalProps }
TCSSGlobalProps = class
FElements: TFPObjectHashTable;
protected
{$IFDEF IP_LAZARUS_DBG}
procedure DoDumpProps(Item: TObject; const Key: String; var Continue: Boolean);
{$ENDIF}
public
constructor Create;
destructor Destroy; override;
{$IFDEF IP_LAZARUS_DBG}
procedure DumpProps;
{$ENDIF}
function GetPropsObject(ATagName: String; AClassID: String = ''; CreateIfNotExist: Boolean = False): TCSSProps;
end;
TCSSReader = class
FStream: TStream;
FGlobalProps: TCSSGlobalProps;
function GetStatementElements(AStatement: String): TStringList;
function GetStatementCommands(AStatement: String): TStringList;
function CheckIsComment: Boolean;
procedure EatWhiteSpace;
procedure ParseCSS;
procedure EatComment;
function FindStatement(out AStatement: String): Boolean;
function EOF: Boolean;
constructor Create(AStream: TStream; AGlobalProps: TCSSGlobalProps);
end;
function SeparateCommands(Commands: String): TStringList;
implementation
uses
LazStringUtils;
function ForceRange(x, xmin, xmax: Integer): Integer;
begin
if x < xmin then
Result := xmin
else if x > xmax then
Result := xmax
else
Result := x;
end;
function IsWhiteSpace(AChar: Char; ExcludeSpaces: Boolean = False): Boolean;
begin
Result := AChar in [#9, #10, #11, #13];
if not Result and not ExcludeSpaces then
Result := AChar = ' ';
end;
function StrToCSSLength(AValue: String): TCssLength;
var
P, Err: Integer;
begin
P := Pos('%', AValue);
if P <> 0 then begin
Result.LengthType := cltPercent;
Delete(AValue, P, 1);
end else
Result.LengthType := cltAbsolute;
val(AValue, Result.LengthValue, Err);
if (Err <> 0) or (Result.LengthValue < 0) then
Result.LengthType := cltUndefined
else if (Result.LengthType = cltPercent) and (Result.LengthValue > 100) then
Result.LengthValue := 100;
end;
function SeparateCommands(Commands: String): TStringList;
var
i, fpos1, fpos2: Integer;
Command: String;
begin
Result := TStringList.Create;
FPos1 := 1;
for i := 1 to Length(Commands) do
begin
if Commands[i] = ';' then
begin
Command := Copy(Commands, FPos1, i-FPos1);
FPos1 := i+1;
for FPos2 := Length(Command) downto 1 do
if IsWhiteSpace(Command[FPos2], True) then
Delete(Command, FPos2, 1);
Result.Add(Trim(Command));
end;
end;
Command := Trim(Copy(Commands, FPos1, Length(Commands)));
if Command <> '' then
begin
Result.Add(Command);
end;
end;
function FontWeightFromString(S: String): TCSSFontWeight;
begin
Result := cfwNormal;
S := trim(S);
case S[1] of
'1': if S = '100' then Result := cfw100;
'2': if S = '200' then Result := cfw200;
'3': if S = '300' then Result := cfw300;
'4': if S = '400' then Result := cfw400;
'5': if S = '500' then Result := cfw500;
'6': if S = '600' then Result := cfw600;
'7': if S = '700' then Result := cfw700;
'8': if S = '800' then Result := cfw800;
'9': if S = '900' then Result := cfw900;
'B','b': if CompareText(S, 'bold') = 0 then Result := cfwBold
else if CompareText(S, 'bolder') = 0 then Result := cfwBolder;
'L','l': if CompareText(S, 'lighter') = 0 then Result := cfwLighter;
end;
end;
function SizePxFromString(S: String): Integer;
begin
S := Copy(S, 1, PosI('px', S)-1);
Result := StrToIntDef(S, 0);
end;
function StrToCssMargin(const S: string): TCSSMargin;
var
i: SizeInt;
begin
Result.Style:=cmsAuto;
Result.Size:=0;
if (S='') or (CompareText(S,'auto')=0) then exit;
i:=PosI('px',S);
if i>0 then begin
Result.Style:=cmsPx;
Result.Size:=StrToIntDef(copy(S,1,i-1),0);
exit;
end;
i:=PosI('em',S);
if i>0 then begin
Result.Style:=cmsEm;
Result.Size:=StrToIntDef(copy(S,1,i-1),0);
exit;
end;
i:=Pos('%',S);
if i>0 then begin
Result.Style:=cmsPercent;
Result.Size:=StrToIntDef(copy(S,1,i-1),0);
exit;
end;
// a number without unit is px
Result.Style:=cmsPx;
Result.Size:=StrToIntDef(S,0);
end;
function CSSFontStyleFromName(S: String): TCSSFontStyle;
begin
Result := cfsNormal;
if length(s)<2 then exit;
case S[2] of
'b': if S = 'oblique' then Result := cfsOblique;
'n': if S = 'inherit' then Result := cfsInherit;
't': if S = 'italic' then Result := cfsItalic;
end;
end;
function BorderStyleFromString(S: String): TCSSBorderStyle;
begin
Result := cbsNone;
S := LowerCase(S);
case S[1] of
'd':
if S = 'dotted' then
Result := cbsDotted
else
if S = 'dashed' then
Result := cbsDashed
else
if S = 'double' then
Result := cbsDouble;
'g': if S = 'groove' then Result := cbsGroove;
'h': if S = 'hidden' then Result := cbsHidden;
'i': if S = 'inset' then Result := cbsInset;
'o': if S = 'outset' then Result := cbsOutset;
'r': if S = 'ridge' then Result := cbsRidge;
's': if S = 'solid' then Result := cbsSolid;
end;
end;
{ TCSSReader }
function TCSSReader.GetStatementElements(AStatement: String): TStringList;
var
i, fpos: Integer;
Elements : String;
Element: String;
ElementClass: String;
begin
Result := TStringList.Create;
fpos := Pos('{', AStatement);
if fpos > 0 then
begin
Elements := Copy(AStatement,1,fpos-1);
for i := Length(Elements) downto 1 do
if IsWhiteSpace(Elements[i]) then
Delete(Elements, i, 1);
Result.Delimiter := ',';
Result.DelimitedText := Elements;
end;
for i := 0 to Result.Count-1 do begin
{$IFDEF CSS_CASESENSITIVE_CLASSID}
Element := Result[i];
{$ELSE}
Element := LowerCase(Result[i]);
{$ENDIF}
ElementClass := '';
fpos := Pos('.', Element);
if fpos = 0 then
begin
Result.Objects[i] := FGlobalProps.GetPropsObject(Element, '', True);
end
else begin
{$IFDEF CSS_CASESENSITIVE_CLASSID}
ElementClass := Copy(Element, FPos+1, Length(Element));
Element := Copy(Element, 1, FPos-1);
{$ELSE}
ElementClass := LowerCase(Copy(Element, FPos+1, Length(Element)));
Element := LowerCase(Copy(Element, 1, FPos-1));
{$ENDIF}
Result.Objects[i] := FGlobalProps.GetPropsObject(Element, ElementClass, True);
end;
end;
end;
function TCSSReader.GetStatementCommands(AStatement: String): TStringList;
var
fpos1, fpos2: Integer;
Commands: String;
begin
fpos1 := Pos('{', AStatement)+1;
fpos2 := Pos('}', AStatement)-1;
Commands := Copy(AStatement, fpos1, fpos2-fpos1+1);
Result := SeparateCommands(Commands);
end;
function TCSSProps.GetCommandArgs(ACommand: String): TStringList;
var
i: Integer;
WantArg: Boolean;
Arg: String;
Start: Integer;
Quote: char;
WantChar: Boolean;
WantPar: Boolean;
Len: Integer;
begin
Result := TStringList.Create;
Start := Pos(':', ACommand)+1;
WantArg := True;
WantPar := false;
Quote := #0;
for i := Start to Length(ACommand) do
begin
if (Quote = #0) and (ACommand[i] in ['"','''']) then
begin
Quote := ACommand[i];
Start := i+1;
continue;
end;
if Quote<>#0 then begin
if ACommand[i]=Quote then begin
Quote:=#0;
Arg := Copy(ACommand, Start, i-Start);
Result.Add(Arg);
end;
continue;
end;
if WantArg then
begin
if IsWhiteSpace(ACommand[i]) then
Continue;
Start := i;
WantArg := False;
continue;
end
else // we have an arg we are reading ...
begin
WantChar:=not (ACommand[i] in [';',' ',#9]);
if ACommand[i] = '(' then WantPar := True;
if ACommand[i] = ')' then WantPar := False;
if (i<Length(ACommand)) and (WantChar or WantPar)
then
continue;
WantArg := True;
Len:=i-Start;
if WantChar then inc(Len);
Arg := Copy(ACommand, Start, Len);
Result.Add(Arg);
end;
end;
end;
function TCSSProps.GetCommandName(ACommand: String): String;
begin
Result := Copy(ACommand, 1, Pos(':', ACommand)-1);
end;
function TCSSReader.CheckIsComment: Boolean;
begin
Result := False;
if EOF then
exit;
Result := char(FStream.ReadByte) = '*';
if not Result then
FStream.Position := FStream.Position-1;
end;
procedure TCSSReader.EatWhiteSpace;
var
Buf: char;
//comment: integer;
begin
//comment:=0;
while not EOF do
begin
Buf := char(FStream.ReadByte);
if (Buf = '/') and not EOF then
begin
if CheckIsComment then
begin
EatComment;
Buf := ' ';
end;
end;
if (IsWhiteSpace(Buf) = False) then
begin
FStream.Position := FStream.Position-1;
break;
end;
end;
end;
procedure TCSSReader.ParseCSS;
var
Statement: String;
Elements: TStringList;
Commands: TStringList;
Element: TCSSProps;
I: Integer;
begin
while FindStatement(Statement) do begin
Elements := GetStatementElements(Statement);
Commands := GetStatementCommands(Statement);
try
for I := 0 to Elements.Count-1 do
begin
Element := TCSSProps(Elements.Objects[I]);
Element.ReadCommands(Commands);
end;
finally
Elements.Free;
Commands.Free;
end;
end;
end;
procedure TCSSReader.EatComment;
var
Buf: array[0..1] of char;
begin
Buf := #0#0;
while (EOF = False) and (Buf <> '*/') do
begin
Buf[0] := Buf[1];
FStream.Read(Buf[1], 1);
end;
end;
function TCSSReader.FindStatement(out AStatement: String): Boolean;
var
Buf: char;
Buf1: string;
RCount: Integer;
FStart, FEnd: Integer;
begin
Result := False;
EatWhiteSpace;
AStatement := '';
SetLength(Buf1,1023);
FStart := FStream.Position;
while not EOF do
begin
Buf := Char(FStream.ReadByte);
FEnd := FStream.Position;
if (Buf = '/') and CheckIsComment then
begin
FStream.Position := FStart;
if length(Buf1)<FEnd-FStart then
setlength(Buf1,FEnd-FStart);
RCount := FStream.Read(Buf1[1], FEnd-FStart-1);
AStatement := AStatement + Copy(Buf1,0,RCount);
FStream.Position := FEnd+1;
EatComment;
FStart := FStream.Position;
end
else if Buf = '}' then
begin
Result := True;
FStream.Position := FStart;
if length(Buf1)<FEnd-FStart then
setlength(Buf1,FEnd-FStart);
RCount := FStream.Read(Buf1[1], FEnd-FStart);
AStatement := AStatement + Copy(Buf1,0,RCount);
break;
end;
end;
end;
function TCSSReader.EOF: Boolean;
begin
Result := FStream.Position >= FStream.Size;
end;
constructor TCSSReader.Create(AStream: TStream; AGlobalProps: TCSSGlobalProps);
begin
inherited Create;
FStream := AStream;
FGlobalProps:= AGlobalProps;
end;
{ TCSSProps }
constructor TCSSProps.Create;
begin
FFont := TCSSFont.Create;
FBGColor := clNone;
FColor := clNone;
FAlignment := haUnknown;
FBorder := TCSSBorder.Create;
FWidth.LengthType := cltUndefined;
end;
destructor TCSSProps.Destroy;
var
i: Integer;
begin
if Assigned(FClassIDs) then
begin
for i := 0 to FClassIDs.Count-1 do
FClassIDs.Objects[i].Free;
FClassIDs.Free;
end;
FFont.Free;
FBorder.Free;
inherited Destroy;
end;
procedure TCSSProps.ReadCommands(ACommands: TStrings);
var
Args: TStringlist;
ACommand: String;
Cmd: String;
I: Integer;
begin
for I := 0 to ACommands.Count-1 do
begin
ACommand := ACommands[I];
if ACommand='' then continue;
Cmd := LowerCase(GetCommandName(ACommand));
if Cmd='' then continue;
Args := GetCommandArgs(ACommand);
try
case Cmd[1] of
'c': if Cmd = 'color' then
if Args.Count > 0 then
Color := ColorFromString(Args[0])
else
Color := clDefault;
'b': if Cmd = 'background-color' then begin
if Args.Count > 0 then
BGColor := ColorFromString(Args[0])
else
BGColor := clDefault;
end else
if Cmd = 'background' then
begin
if Args.Count > 0 then BGColor := ColorFromString(Args[0]);
if Args.Count > 1 then ; // background image
if Args.Count > 2 then ; // background image repeat
if Args.Count > 3 then ; // background attachment
if Args.Count > 4 then ; // background position
end
else if Cmd = 'border' then
begin
if Args.Count > 0 then Border.Width := SizePxFromString(Args[0]);
if Args.Count > 1 then Border.Style := BorderStyleFromString(Args[1]);
if Args.Count > 2 then Border.Color := ColorFromString(Args[2]);
end
else if Cmd = 'border-width' then
begin
if Args.Count > 0 then Border.Width := SizePxFromString(Args[0]);
end
else if Cmd = 'border-color' then
begin
if Args.Count > 0 then Border.Color := ColorFromString(Args[0]);
end
else if Cmd = 'border-style' then
begin
if Args.Count > 0 then Border.Style := BorderStyleFromString(Args[0]);
end;
'm':
if Cmd = 'margin-top' then begin
if Args.Count > 0 then MarginTop := StrToCssMargin(Args[0]);
end
else if Cmd = 'margin-left' then begin
if Args.Count > 0 then MarginLeft := StrToCssMargin(Args[0]);
end
else if Cmd = 'margin-bottom' then begin
if Args.Count > 0 then MarginBottom := StrToCssMargin(Args[0]);
end else if Cmd = 'margin-right' then begin
if Args.Count > 0 then MarginRight := StrToCssMargin(Args[0]);
end else if Cmd = 'margin' then begin
case Args.Count of
1:begin
// 1 arg: all four the same
MarginTop := StrToCssMargin(Args[0]);
MarginBottom := MarginTop;
MarginLeft := MarginTop;
MarginRight := MarginTop;
end;
2:begin
// 2 args: top+bottom and left+right
MarginTop := StrToCssMargin(Args[0]);
MarginBottom := MarginTop;
MarginLeft := StrToCssMargin(Args[1]);
MarginRight := MarginLeft;
end;
3:begin
// 3 args: top right bottom
MarginTop := StrToCssMargin(Args[0]);
MarginRight := StrToCssMargin(Args[1]);
MarginBottom := StrToCssMargin(Args[2]);
end;
4:begin
// 4 args: top right bottom left
MarginTop := StrToCssMargin(Args[0]);
MarginRight := StrToCssMargin(Args[1]);
MarginBottom := StrToCssMargin(Args[2]);
MarginLeft := StrToCssMargin(Args[3]);
end;
end;
end;
't': if (Cmd = 'text-align') then
begin
if Args.Count > 0 then Alignment := GetAlignmentForStr(Args[0]);
end;
'f':
if (Length(Cmd) > 7) and (Args.Count > 0) then
case Cmd[7] of
'a': if (Cmd = 'font-family') then
Font.Name := Args.CommaText; //Args[0];
'i': if (Cmd = 'font-size') then
Font.Size := Args[0];
't': if (Cmd = 'font-style') then
Font.Style := CSSFontStyleFromName(Args[0]);
'e': if (Cmd = 'font-weight') then
Font.Weight := FontWeightFromString(Args[0]);
end;
'w':
if (Cmd = 'width') and (Args.Count > 0) then
FWidth := StrToCSSLength(Args[0]);
end;
finally
Args.Free;
end;
end;
end;
procedure TCSSProps.MergeAdditionalProps(AProps: TCSSProps);
begin
if AProps.Color <> clNone then Color := AProps.Color;
if AProps.BGColor <> clNone then BGColor := AProps.BGColor;
if AProps.Alignment <> haUnknown then Alignment := AProps.Alignment;
if AProps.Font.Name <> '' then Font.Name := AProps.Font.Name;
if AProps.Font.Size <> '' then Font.Size := AProps.Font.Size;
if AProps.Font.Style <> cfsNormal then Font.Style := AProps.Font.Style;
if AProps.Font.Weight <> cfwNormal then Font.Weight := AProps.Font.Weight;
if AProps.MarginBottom.Style <> cmsNone then
FMarginBottom.Style := AProps.MarginBottom.Style;
if AProps.MarginBottom.Size <> 0 then
FMarginBottom.Size := AProps.MarginBottom.Size;
if AProps.MarginLeft.Style <> cmsNone then
FMarginLeft.Style := AProps.MarginLeft.Style;
if AProps.MarginLeft.Size <> 0 then
FMarginLeft.Size := AProps.MarginLeft.Size;
if AProps.MarginRight.Style <> cmsNone then
FMarginRight.Style := AProps.MarginRight.Style;
if AProps.MarginRight.Size <> 0 then
FMarginRight.Size := AProps.MarginRight.Size;
if AProps.MarginTop.Style <> cmsNone then
FMarginTop.Style := AProps.MarginTop.Style;
if AProps.MarginTop.Size <> 0 then
FMarginTop.Size := AProps.MarginTop.Size;
if AProps.Width.LengthType <> cltUndefined then
FWidth := AProps.Width;
end;
{ TCSSGlobalProps }
constructor TCSSGlobalProps.Create;
begin
FElements := TFPObjectHashTable.Create(True);
end;
destructor TCSSGlobalProps.Destroy;
begin
FElements.Free;
inherited Destroy;
end;
{$IFDEF IP_LAZARUS_DBG}
procedure TCSSGlobalProps.DoDumpProps(Item: TObject; const Key: String; var Continue: Boolean);
var
lProp: TCSSProps;
begin
lProp := TCSSProps(Item);
WriteLn('CSS for >>>: ', Key);
WriteLn(' Color : ', lProp.Color);
WriteLn(' BgColor : ', lProp.BGColor);
WriteLn(' Font : ', lProp.Font.Name, ':', lProp.Font.FFamily, ':', lProp.Font.Size);
WriteLn(' Align : ' + GetEnumName(TypeInfo(TIpHtmlAlign), ord(lProp.Alignment)));
end;
procedure TCSSGlobalProps.DumpProps;
begin
FElements.Iterate(DoDumpProps);
end;
{$endif}
function TCSSGlobalProps.GetPropsObject(ATagName: String;
AClassID: String; CreateIfNotExist: Boolean): TCSSProps;
var
Selector: String;
procedure Lookup(const AName: String);
begin
if length(AClassID) > 0 then
{$IFDEF CSS_CASESENSITIVE_CLASSID}
Selector := AName + '.' + AClassID
{$ELSE}
Selector := AName + '.' + Lowercase(AClassID)
{$ENDIF}
else
Selector := AName;
// The css selectors are already lowercase, this is
// already done in the css parser. And the html parser
// can only deliver its own built-in tag names anyways.
// Also the names are not expected to be longer than
// ShortString (this would need to be a ridiculously
// long ClassID), should this ever happen then
// it would be silently truncated in the following
// type conversion to ShortString.
Result := TCSSProps(FElements.Items[Selector]);
end;
begin
Result := nil;
if (length(AClassID) = 0) and (length(ATagName) = 0) then
exit;
Lookup(ATagName);
if (Result=nil) and not CreateIfNotExist then
Lookup('*');
if (Result = nil) and CreateIfNotExist then
begin
Result := TCSSProps.Create;
FElements.Add(Selector, Result);
end;
end;
{ TCSSBorder }
constructor TCSSBorder.Create;
begin
inherited Create;
FWidth := -1;
FColor := clBlack;
FStyle := cbsNone;
end;
end.
end.

449
components/turbopower_ipro/iphtml.pas
View File

@ -72,7 +72,7 @@ uses
{$ENDIF}
TypInfo,
GraphUtil, Controls, StdCtrls, ExtCtrls, Buttons, Forms, ClipBrd, Dialogs,
IpConst, IpStrms, IpUtils, iphtmlprop, IpMsg;
IpConst, IpStrms, IpUtils, iphtmlprop, IpMsg, IpCSS, IpHtmlUtils;
type
{Note: Some of the code below relies on the fact that
@ -80,6 +80,9 @@ type
{$I iphtmlgenerated.inc}
type
TParmValueArray = array[TIpHtmlAttributesSet] of string;
const
IPMAXFRAMES = 256; {maximum number of frames in a single frameset}
MAXINTS = 4096; {buffer size - this should be way more than needed}
@ -105,9 +108,9 @@ type
TIpAbstractHtmlDataProvider = class;
{$DEFINE CSS_INTERFACE}
{$I ipcss.inc}
{$UNDEF CSS_INTERFACE}
// {$DEFINE CSS_INTERFACE}
//{$I ipcss.inc}
// {$UNDEF CSS_INTERFACE}
TIpHtmlInteger = class(TPersistent)
{ Integer property which can be scaled}
@ -373,19 +376,19 @@ type
procedure AddArea(const R: TRect);
procedure BuildAreaList; virtual;
procedure ClearAreaList; virtual;
procedure ParseBaseProps(aOwner : TIpHtml);
function SelectCSSFont(const aFont: string): string;
procedure ApplyCSSProps(const ACSSProps: TCSSProps; const props: TIpHtmlProps);
function ElementName: String;
function GetAlign: TIpHtmlAlign; virtual;
function GetFontSizeFromCSS(CurrentFontSize:Integer; aFontSize: string):Integer;
procedure SetAlign(const Value: TIpHtmlAlign); virtual;
procedure SetId(const Value: string); virtual;
property ElementName: String read FElementName write FElementName;
public
constructor Create(ParentNode : TIpHtmlNode);
destructor Destroy; override;
procedure LoadAndApplyCSSProps; virtual;
procedure MakeVisible; override;
procedure ParseBaseProps(aOwner : TIpHtml);
property InlineCSS: TCSSProps read FInlineCSSProps write FInlineCSSProps;
property Align: TIpHtmlAlign read GetAlign write SetAlign;
property ClassId : string read FClassId write FClassId;
@ -569,10 +572,10 @@ type
procedure SetFace(const Value: string);
protected
procedure ApplyProps(const RenderProps: TIpHtmlProps); override;
procedure SizeChanged(Sender: TObject);
public
constructor Create(ParentNode : TIpHtmlNode);
destructor Destroy; override;
procedure SizeChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -616,6 +619,7 @@ type
procedure Enqueue; override;
procedure LoadAndApplyCSSProps; override;
procedure SetProps(const RenderProps: TIpHtmlProps); override;
property ElementName;
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -750,10 +754,10 @@ type
FVersion: string;
FDir: TIpHtmlDirection;
protected
function HasBodyNode : Boolean;
procedure CalcMinMaxHtmlWidth(const RenderProps: TIpHtmlProps; var Min, Max: Integer);
function GetHeight(const RenderProps: TIpHtmlProps; const Width: Integer): Integer;
public
function HasBodyNode : Boolean;
procedure Layout(const RenderProps: TIpHtmlProps; const TargetRect : TRect);
procedure Render(RenderProps: TIpHtmlProps);
{$IFDEF HTML_RTTI}
@ -874,9 +878,9 @@ type
function Successful: Boolean; override;
procedure AddValues(NameList, ValueList : TStringList); override;
procedure Reset; override;
procedure WidthChanged(Sender: TObject);
public
destructor Destroy; override;
procedure WidthChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -1041,7 +1045,6 @@ type
SizeWidth : TIpHtmlPixels;
FDim : TSize;
function GrossDrawRect: TRect;
procedure WidthChanged(Sender: TObject);
public
constructor Create(ParentNode : TIpHtmlNode);
destructor Destroy; override;
@ -1049,6 +1052,7 @@ type
procedure CalcMinMaxWidth(var Min, Max: Integer); override;
procedure Enqueue; override;
function GetDim(ParentWidth: Integer): TSize; override;
procedure WidthChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -1160,7 +1164,6 @@ type
procedure UnloadImage;
function GrossDrawRect: TRect;
function GetHint: string; override;
procedure DimChanged(Sender: TObject);
procedure InvalidateSize; override;
public
constructor Create(ParentNode : TIpHtmlNode);
@ -1170,6 +1173,7 @@ type
procedure CalcMinMaxWidth(var Min, Max: Integer); override;
function GetDim(ParentWidth: Integer): TSize; override;
procedure ImageChange(NewPicture : TPicture); override;
procedure DimChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -1202,9 +1206,9 @@ type
FAlignment: TIpHtmlImageAlign;
protected
function GetHint: string; override;
procedure WidthChanged(Sender: TObject);
public
destructor Destroy; override;
procedure WidthChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -1242,9 +1246,9 @@ type
FVSpace: Integer;
FWidth: TIpHtmlLength;
protected
procedure WidthChanged(Sender: TObject);
public
destructor Destroy; override;
procedure WidthChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -1456,7 +1460,6 @@ type
procedure SetRect(TargetRect: TRect); override;
procedure InvalidateSize; override;
function GetColCount: Integer;
procedure WidthChanged(Sender: TObject);
public
FCaption : TIpHtmlNodeCAPTION;
BorderRect : TRect;
@ -1470,6 +1473,7 @@ type
procedure Enqueue; override;
function GetDim(ParentWidth: Integer): TSize; override;
procedure LoadAndApplyCSSProps; override;
procedure WidthChanged(Sender: TObject);
{$IFDEF HTML_RTTI}
published
{$ENDIF}
@ -1622,7 +1626,6 @@ type
FVAlign: TIpHtmlVAlign3;
protected
procedure AppendSelection(var S: String; var Completed: Boolean); override;
procedure DimChanged(Sender: TObject);
function GetAlign: TIpHtmlAlign; override;
procedure SetAlign(const Value: TIpHtmlAlign); override;
public
@ -1633,6 +1636,7 @@ type
procedure LoadAndApplyCSSProps; override;
procedure Render(RenderProps: TIpHtmlProps); override;
procedure CalcMinMaxPropWidth(RenderProps: TIpHtmlProps; var Min, Max: Integer); override;
procedure DimChanged(Sender: TObject);
public
property PadRect : TRect read FPadRect write FPadRect;
{$IFDEF HTML_RTTI}
@ -1869,6 +1873,12 @@ type
property Align : TIpHtmlVAlignment2 read FAlign write FAlign;
end;
TIpHtmlBasicParser = class
public
function Execute: Boolean; virtual; abstract;
function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string; virtual; abstract;
end;
TIpHtmlRenderDevice = (rdScreen, rdPrinter, rdPreview);
TWriteCharProvider = procedure(C : AnsiChar) of object;
@ -1945,23 +1955,24 @@ type
FRenderDev: TIpHtmlRenderDevice;
FCSS: TCSSGlobalProps;
FDocCharset: string;
FHasBOM: boolean;
// FHasBOM: boolean;
FTabList: TIpHtmlTabList;
FNeedResize: Boolean;
FParser: TIpHtmlBasicParser;
protected
CharStream : TStream;
CurToken : TIpHtmlToken;
ParmValueArray : array[TIpHtmlAttributesSet] of string;
// CurToken : TIpHtmlToken;
// ParmValueArray: TParmValueArray;
FHtml : TIpHtmlNodeHtml;
CharStack : array [0..7] of AnsiChar;
LastWasSpace: Boolean;
LastWasClose: Boolean;
CharSP : Integer;
// CharStack : array [0..7] of AnsiChar;
// LastWasSpace: Boolean;
// LastWasClose: Boolean;
// CharSP : Integer;
FFlagErrors : Boolean;
IndexPhrase : string;
TokenBuffer : TIpHtmlToken;
// IndexPhrase : string;
// TokenBuffer : TIpHtmlToken;
FPageRect : TRect;
HaveToken : Boolean;
// HaveToken : Boolean;
FClientRect : TRect; {the coordinates of the paint rectangle}
FPageViewRect : TRect; {the current section of the page}
FPageViewBottom : Integer; {the lower end of the page, may be different from PageViewRect.Bottom }
@ -1982,17 +1993,17 @@ type
NameList : TStringList;
IdList: TStringList;
GifQueue : TFPList;
InPre : Integer;
InBlock : Integer;
// InPre : Integer;
// InBlock : Integer;
MapList : TFPList;
AreaList : TFPList;
DefaultImage : TPicture;
MapImgList : TFPList;
GlobalPos, LineNumber, LineOffset : Integer;
// GlobalPos, LineNumber, LineOffset : Integer;
PaintBufferBitmap : TBitmap;
PaintBuffer : TCanvas;
TokenStringBuf : PChar; {array[16383] of AnsiChar;}
TBW : Integer;
// TokenStringBuf : PChar; {array[16383] of AnsiChar;}
// TBW : Integer;
Destroying : Boolean;
FAllSelected : Boolean;
RectList : TFPList;
@ -2002,17 +2013,17 @@ type
FControlList : TFPList;
FCurURL : string;
DoneLoading : Boolean;
ListLevel : Integer;
// ListLevel : Integer;
PropACache : TIpHtmlPropsAList;
PropBCache : TIpHtmlPropsBList;
RenderCanvas : TCanvas;
FPageHeight : Integer;
StartPos : Integer;
// StartPos : Integer;
FFixedTypeface: string;
FDefaultTypeFace: string;
FDefaultFontSize: integer;
ParmBuf: PChar;
ParmBufSize: Integer;
// ParmBuf: PChar;
// ParmBufSize: Integer;
FControlParent: TWinControl;
procedure ResetCanvasData;
procedure ResetWordLists;
@ -2022,123 +2033,123 @@ type
function CheckKnownURL(URL: string): boolean;
procedure ReportReference(URL: string);
procedure PaintSelection;
function IsWhiteSpace: Boolean;
function GetTokenString: string;
procedure ReportError(const ErrorMsg: string);
procedure ReportExpectedError(const ErrorMsg: string);
procedure ReportExpectedToken(const Token: TIpHtmlToken);
procedure EnsureClosure(const EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
// function IsWhiteSpace: Boolean;
// function GetTokenString: string;
// procedure ReportError(const ErrorMsg: string);
// procedure ReportExpectedError(const ErrorMsg: string);
// procedure ReportExpectedToken(const Token: TIpHtmlToken);
// procedure EnsureClosure(const EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
function NewElement(EType : TElementType; Own: TIpHtmlNode) : PIpHtmlElement;
function BuildStandardEntry(EType: TElementType): PIpHtmlElement;
function BuildLinefeedEntry(EType: TElementType; AHeight: Integer): PIpHtmlElement;
function ParseDir: TIpHtmlDirection;
procedure ParseSPAN(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseQ(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseINS(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseDEL(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseTABLE(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseTableBody(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseTableRows(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseColGroup(Parent: TIpHtmlNode);
function ParseFrameScrollingProp: TIpHtmlFrameScrolling;
function ParseObjectValueType: TIpHtmlObjectValueType;
procedure ParseFrameSet(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseFrame(Parent : TIpHtmlNode);
procedure ParseIFrame(Parent : TIpHtmlNode);
procedure ParseNOFRAMES(Parent : TIpHtmlNode);
function ParseButtonType: TIpHtmlButtonType;
procedure ParseNoscript(Parent: TIpHtmlNode);
procedure ParseLEFT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseBLINK(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseRIGHT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure PutToken(Token: TIpHtmlToken);
procedure ParseParagraph(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseListItems(Parent : TIpHtmlNodeCore;
EndToken: TIpHtmlToken; const EndTokens : TIpHtmlTokenSet;
DefaultListStyle : TIpHtmlULType);
procedure ParseUnorderedList(Parent: TIpHtmlNode;
EndToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
procedure ParseOrderedList(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
procedure ParseDefinitionList(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseDefListItems(Parent: TIpHtmlNode;
const EndTokens: TIpHtmlTokenSet);
procedure ParsePre(ParentNode : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseDIV(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseCENTER(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseBLOCKQUOTE(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseHR(Parent: TIpHtmlNode);
procedure ParseFontStyle(Parent: TIpHtmlNode;
StartToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
procedure ParsePhraseElement(Parent: TIpHtmlNode;
StartToken, EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
procedure ParseAnchor(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
procedure ParseIMG(Parent : TIpHtmlNode);
procedure ParseApplet(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
procedure ParseOBJECT(Parent : TIpHtmlNode);
procedure ParseBasefont(Parent: TIpHtmlNode);
procedure ParseBR(Parent : TIpHtmlNode);
procedure ParseNOBR(Parent: TIpHtmlNode);
procedure ParseMAP(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// function ParseDir: TIpHtmlDirection;
// procedure ParseSPAN(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseQ(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseINS(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseDEL(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseTABLE(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseTableBody(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseTableRows(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseColGroup(Parent: TIpHtmlNode);
// function ParseFrameScrollingProp: TIpHtmlFrameScrolling;
// function ParseObjectValueType: TIpHtmlObjectValueType;
// procedure ParseFrameSet(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseFrame(Parent : TIpHtmlNode);
// procedure ParseIFrame(Parent : TIpHtmlNode);
// procedure ParseNOFRAMES(Parent : TIpHtmlNode);
// function ParseButtonType: TIpHtmlButtonType;
// procedure ParseNoscript(Parent: TIpHtmlNode);
// procedure ParseLEFT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseBLINK(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseRIGHT(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure PutToken(Token: TIpHtmlToken);
// procedure ParseParagraph(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseListItems(Parent : TIpHtmlNodeCore;
// EndToken: TIpHtmlToken; const EndTokens : TIpHtmlTokenSet;
// DefaultListStyle : TIpHtmlULType);
// procedure ParseUnorderedList(Parent: TIpHtmlNode;
// EndToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
// procedure ParseOrderedList(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
// procedure ParseDefinitionList(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseDefListItems(Parent: TIpHtmlNode;
// const EndTokens: TIpHtmlTokenSet);
// procedure ParsePre(ParentNode : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseDIV(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseCENTER(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseBLOCKQUOTE(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseHR(Parent: TIpHtmlNode);
// procedure ParseFontStyle(Parent: TIpHtmlNode;
// StartToken : TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
// procedure ParsePhraseElement(Parent: TIpHtmlNode;
// StartToken, EndToken: TIpHtmlToken; const EndTokens: TIpHtmlTokenSet);
// procedure ParseAnchor(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
// procedure ParseIMG(Parent : TIpHtmlNode);
// procedure ParseApplet(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
// procedure ParseOBJECT(Parent : TIpHtmlNode);
// procedure ParseBaseFont(Parent: TIpHtmlNode);
// procedure ParseBR(Parent : TIpHtmlNode);
// procedure ParseNOBR(Parent: TIpHtmlNode);
// procedure ParseMAP(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
function FindAttribute(const AttrNameSet: TIpHtmlAttributesSet): string;
function ColorFromString(S: string): TColor;
function ParseAlignment: TIpHtmlAlign;
function ParseCellAlign(Default : TIpHtmlAlign) : TIpHtmlAlign;
function ParseFrameProp(Default: TIpHtmlFrameProp) : TIpHtmlFrameProp;
function ParseRules(Default : TIpHtmlRules) : TIpHtmlRules;
function ParseULStyle(Default : TIpHtmlULType): TIpHtmlULType;
function ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean;
function ParseInteger(const AttrNameSet: TIpHtmlAttributesSet;
aDefault : Integer): Integer;
function ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet;
aDefault: Integer): TIpHtmlInteger;
function ParsePixels(const AttrNameSet: TIpHtmlAttributesSet;
const aDefault: string): TIpHtmlPixels;
function ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet;
const aDefault: string): TIpHtmlLength;
function ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet;
const aDefault: string): TIpHtmlMultiLength;
function ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet;
const aDefault: string): TIpHtmlMultiLengthList;
function ParseOLStyle(Default: TIpHtmlOLStyle): TIpHtmlOLStyle;
function ParseImageAlignment(aDefault: TIpHtmlImageAlign): TIpHtmlImageAlign;
function ParseVAlignment : TIpHtmlVAlign;
function ParseVAlignment2 : TIpHtmlVAlignment2;
function ParseVAlignment3 : TIpHtmlVAlign3;
function ParseRelSize{(const Default: string)}: TIpHtmlRelSize;
function ParseBRClear: TIpHtmlBreakClear;
function ParseShape: TIpHtmlMapShape;
function NextChar : AnsiChar;
// function ColorFromString(S: string): TColor;
// function ParseAlignment: TIpHtmlAlign;
// function ParseCellAlign(Default : TIpHtmlAlign) : TIpHtmlAlign;
// function ParseFrameProp(Default: TIpHtmlFrameProp) : TIpHtmlFrameProp;
// function ParseRules(Default : TIpHtmlRules) : TIpHtmlRules;
// function ParseULStyle(Default : TIpHtmlULType): TIpHtmlULType;
// function ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean;
// function ParseInteger(const AttrNameSet: TIpHtmlAttributesSet;
// aDefault : Integer): Integer;
// function ParseHtmlInteger2(const AttrNameSet: TIpHtmlAttributesSet;
// aDefault: Integer): TIpHtmlInteger;
// function ParsePixels(const AttrNameSet: TIpHtmlAttributesSet;
// const aDefault: string): TIpHtmlPixels;
// function ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet;
// const aDefault: string): TIpHtmlLength;
// function ParseHyperMultiLength(const AttrNameSet: TIpHtmlAttributesSet;
// const aDefault: string): TIpHtmlMultiLength;
// function ParseHyperMultiLengthList(const AttrNameSet: TIpHtmlAttributesSet;
// const aDefault: string): TIpHtmlMultiLengthList;
// function ParseOLStyle(Default: TIpHtmlOLStyle): TIpHtmlOLStyle;
// function ParseImageAlignment(aDefault: TIpHtmlImageAlign): TIpHtmlImageAlign;
// function ParseVAlignment : TIpHtmlVAlign;
// function ParseVAlignment2 : TIpHtmlVAlignment2;
// function ParseVAlignment3 : TIpHtmlVAlign3;
// function ParseRelSize{(const Default: string)}: TIpHtmlRelSize;
// function ParseBRClear: TIpHtmlBreakClear;
// function ParseShape: TIpHtmlMapShape;
// function NextChar : AnsiChar;
procedure Parse;
procedure ParseHtml;
function GetChar: AnsiChar;
procedure ClearParmValueArray;
procedure ParmValueArrayAdd(const sName, sValue: string);
function HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer;
procedure NextToken;
procedure PutChar(Ch: AnsiChar);
procedure ParseHead(Parent : TIpHtmlNode);
procedure ParseHeadItems(Parent : TIpHtmlNode);
procedure ParseTitle(Parent: TIpHtmlNode);
procedure ParseScript(Parent : TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
procedure ParseStyle(ParentNode : TIpHtmlNode);
procedure ParseIsIndex;
procedure ParseBase;
procedure ParseLink(Parent : TIpHtmlNode);
procedure ParseMeta(Parent : TIpHtmlNode);
procedure ParseBody(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseStyleSheet(Parent: TIpHtmlNode; HRef: String);
procedure ParseBodyText(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseBlock(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseInline(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseHeader(Parent : TIpHtmlNode; EndToken : TIpHtmlToken; Size : Integer);
procedure ParseText(const EndTokens: TIpHtmlTokenSet; Parent: TIpHtmlNode);
procedure ParseFont(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
procedure ParseAddress(Parent: TIpHtmlNode);
procedure ParseForm(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
function ParseMethod: TIpHtmlFormMethod;
procedure ParseTableRow(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
function ParseInputType : TIpHtmlInputType;
procedure ParseFormFields(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
// procedure ParseHtml;
// function GetChar: AnsiChar;
// procedure ClearParmValueArray;
// procedure ParmValueArrayAdd(const sName, sValue: string);
// function HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer;
// procedure NextToken;
// procedure PutChar(Ch: AnsiChar);
// procedure ParseHead(Parent : TIpHtmlNode);
// procedure ParseHeadItems(Parent : TIpHtmlNode);
// procedure ParseTitle(Parent: TIpHtmlNode);
// procedure ParseScript(Parent : TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
// procedure ParseStyle(ParentNode : TIpHtmlNode);
// procedure ParseIsIndex;
// procedure ParseBase;
// procedure ParseLink(Parent : TIpHtmlNode);
// procedure ParseMeta(Parent : TIpHtmlNode);
// procedure ParseBody(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseStyleSheet(Parent: TIpHtmlNode; HRef: String);
// procedure ParseBodyText(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseBlock(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseInline(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseHeader(Parent : TIpHtmlNode; EndToken : TIpHtmlToken; Size : Integer);
// procedure ParseText(const EndTokens: TIpHtmlTokenSet; Parent: TIpHtmlNode);
// procedure ParseFont(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// procedure ParseAddress(Parent: TIpHtmlNode);
// procedure ParseForm(Parent: TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
// function ParseMethod: TIpHtmlFormMethod;
// procedure ParseTableRow(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
// function ParseInputType : TIpHtmlInputType;
// procedure ParseFormFields(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
procedure InvalidateRect(R : TRect);
procedure SetDefaultProps;
function BuildPath(const Ext: string): string;
@ -2148,11 +2159,11 @@ type
procedure ClearGifQueue;
procedure StartGifPaint(Target: TCanvas);
procedure ClearAreaLists;
procedure NextRealToken;
procedure SkipTextTokens;
// procedure NextRealToken;
// procedure SkipTextTokens;
procedure BuildAreaList;
procedure ClearAreaList;
procedure NextNonBlankToken;
// procedure NextNonBlankToken;
procedure Get(const URL: string);
procedure Post(const URL: string; FormData: TIpFormDataEntity);
procedure ClearRectList;
@ -2212,7 +2223,6 @@ type
procedure CheckImage(Picture: TPicture);
{$ENDIF}
function GetSelectionBlocks(out StartSelIndex,EndSelIndex: Integer): boolean;
property CSS: TCSSGlobalProps read FCSS write FCSS;
function getControlCount:integer;
function getControl(i:integer):TIpHtmlNode;
public
@ -2221,6 +2231,7 @@ type
function PagePtToScreen(const Pt: TPoint): TPoint;
function PageRectToScreen(const Rect: TRect; var ScreenRect: TRect): Boolean;
procedure AddRect(const R: TRect; AElement: PIpHtmlElement; ABlock: TIpHtmlNodeBlock);
procedure FixMissingBodyTag;
procedure LoadFromStream(S : TStream);
procedure Render(TargetCanvas: TCanvas; TargetPageRect : TRect;
UsePaintBuffer: Boolean; const TopLeft: TPoint); overload;
@ -2233,6 +2244,8 @@ type
{$ENDIF}
property AllSelected : Boolean read FAllSelected;
property Body: TIpHtmlNodeBODY read FBody;
property CSS: TCSSGlobalProps read FCSS write FCSS;
property DataProvider: TIpAbstractHtmlDataProvider read FDataProvider;
property FlagErrors : Boolean read FFlagErrors write FFlagErrors;
property FixedTypeface: string read FFixedTypeface write FFixedTypeface;
property DefaultTypeFace: string read FDefaultTypeFace write FDefaultTypeFace;
@ -2400,9 +2413,6 @@ type
protected
function DoGetHtmlStream(const URL: string;
PostData: TIpFormDataEntity) : TStream; virtual; abstract;
function DoGetStream(const URL: string): TStream; virtual; abstract;
{-provider assumes ownership of returned TStream and will free it when
done using it.}
function DoCheckURL(const URL: string;
var ContentType: string): Boolean; virtual; abstract;
procedure DoLeave(Html: TIpHtml); virtual; abstract;
@ -2410,8 +2420,13 @@ type
procedure DoGetImage(Sender: TIpHtmlNode; const URL: string;
var Picture: TPicture); virtual; abstract;
function CanHandle(const URL: string): Boolean; virtual; abstract;
// renamed New,Old to NewURL, OldURL
public
// The following methods were protected in the original but had to be made
// public to cooperate with the TIpHtmlParser
function BuildURL(const OldURL, NewURL: string): string; virtual; abstract;
{ provider assumes ownership of returned TStream and will free it when
done using it. }
function DoGetStream(const URL: string): TStream; virtual; abstract;
end;
TIpHtmlEnumerator = procedure(Document: TIpHtml) of object;
@ -2835,8 +2850,6 @@ type
TIdFindNodeCriteria = function(ACurrNode: TIpHtmlNodeCore; const AParamStr: string): Boolean;
const
NAnchorChar = #3 ; {character used to represent an Anchor }
var
// true during print preview only, public to let print preview unit access it
ScaleFonts : Boolean = False;
@ -2856,7 +2869,8 @@ function NoBreakToSpace(const S: string): string;
procedure SetWordRect(Element: PIpHtmlElement; const Value: TRect);
function CalcMultiLength(const List: TIpHtmlMultiLengthList;
Avail: Integer; var Sections: Integer): TIntArr;
function GetAlignmentForStr(str: string; pDefault: TIpHtmlAlign = haDefault): TIpHtmlAlign;
//function GetAlignmentForStr(str: string; pDefault: TIpHtmlAlign = haDefault): TIpHtmlAlign;
procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False);
function dbgs(et: TElementType): string; overload;
function GetNextSiblingNode(ANode: TIpHtmlNode): TIpHtmlNode;
@ -2877,11 +2891,11 @@ uses
{$IFDEF Html_Print}
Printers, PrintersDlgs, IpHtmlPv,
{$ENDIF}
ipHtmlBlockLayout, ipHtmlTableLayout;
ipHtmlParser, ipHtmlBlockLayout, ipHtmlTableLayout;
{$R *.res}
{$I ipcss.inc}
//{$I ipcss.inc}
var
FlatSB_GetScrollInfo: function(hWnd: HWND; BarFlag: Integer;
@ -2896,9 +2910,9 @@ var
const
MaxElements = 1024*1024;
ShyChar = #1; {character used to represent soft-hyphen in strings}
NbspChar = #2; {character used to represent no-break space in strings}
NbspUtf8 = #194#160; {utf8 code of no-break space character}
// ShyChar = #1; {character used to represent soft-hyphen in strings}
// NbspChar = #2; {character used to represent no-break space in strings}
// NbspUtf8 = #194#160; {utf8 code of no-break space character}
WheelDelta = 8;
const
@ -3168,7 +3182,7 @@ begin
end;
end;
end;
*)
function GetAlignmentForStr(str: string;
pDefault: TIpHtmlAlign = haDefault) : TIpHtmlAlign;
@ -3191,7 +3205,7 @@ begin
else Result := pDefault;
end;
end;
*)
{$IFDEF Html_Print}
procedure GetRelativeAspect(PrinterDC : hDC);
var
@ -3283,7 +3297,7 @@ begin
end;
end;
*)
(*
const
CodeCount = 126;
{Sorted by Size where size is Length(Name).
@ -3521,7 +3535,7 @@ begin
if P <> 0 then
ExpandEscapes(Result);
end;
*)
function NoBreakToSpace(const S: string): string;
var
P, n : Integer;
@ -4784,7 +4798,7 @@ begin
FHtml := TIpHtmlNodeHtml.Create(nil);
FHtml.FOwner := Self;
end;
(*
function TIpHtml.NextChar : AnsiChar;
begin
Result:=#0;
@ -4800,7 +4814,9 @@ begin
{write(Result);}
end;
end;
*)
(*
procedure TIpHtml.ReportError(const ErrorMsg: string);
begin
raise Exception.CreateFmt(SHtmlLineError, [ErrorMsg, LineNumber, LineOffset]);
@ -4822,7 +4838,7 @@ begin
break;
end;
end;
*)
procedure TIpHtml.ReportReferences(Node : TIpHtmlNode);
var
i : Integer;
@ -4849,9 +4865,11 @@ begin
FHasFrames := False;
Clear;
CharStream := S;
{
GlobalPos := 0;
LineNumber := 1;
LineOffset := 0;
}
Parse;
ReportReferences(HtmlNode);
finally
@ -4860,6 +4878,7 @@ begin
end;
end;
(*
function TIpHtml.GetChar : AnsiChar;
var
Trimming,
@ -4895,7 +4914,9 @@ begin
until Done;
LastWasClose := Result = '>';
end;
*)
(*
procedure TIpHtml.PutChar(Ch : AnsiChar);
begin
if (CharSP >= sizeof(CharStack)) then
@ -4903,7 +4924,7 @@ begin
CharStack[CharSP] := Ch;
Inc(CharSP);
end;
*)
function AnsiToEscape(const S: string): string;
{- returns the string with & escapes}
var
@ -4929,7 +4950,7 @@ begin
Dec(i);
end;
end;
(*
procedure TIpHtml.PutToken(Token : TIpHtmlToken);
begin
if HaveToken then
@ -4948,7 +4969,7 @@ begin
Exit;
Result := True;
end;
*)
procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False);
var
R, W : Integer;
@ -4991,7 +5012,7 @@ begin
end;
Target[w] := #0;
end;
(*
function TIpHtml.GetTokenString: string;
begin
TokenStringBuf[TBW] := #0;
@ -5005,7 +5026,8 @@ begin
for n:=Low(ParmValueArray) to High(ParmValueArray) do
setLength(ParmValueArray[n],0);
end;
*)
(*
procedure TIpHtml.ParmValueArrayAdd(const sName, sValue: string);
var
vFirst, vLast, vPivot: Integer;
@ -5033,7 +5055,9 @@ begin
vFirst := Succ(vPivot);
end;
end;
*)
(*
function TIpHtml.HtmlTokenListIndexOf(const TokenString: PAnsiChar): integer;
var
vFirst: Integer;
@ -5672,6 +5696,7 @@ begin
ReportExpectedToken(IpHtmlTagPend);
end;
procedure TIpHtml.ParseAddress(Parent : TIpHtmlNode);
var
NewPara : TIpHtmlNodeADDRESS;
@ -6095,6 +6120,7 @@ begin
EnsureClosure(IpHtmlTagSPANend, EndTokens);
end;
procedure TIpHtml.ParseCENTER(Parent : TIpHtmlNode; const EndTokens: TIpHtmlTokenSet);
var
CurContainer : TIpHtmlNodeDIV;
@ -6363,6 +6389,7 @@ begin
NextToken;
end;
procedure TIpHtml.ParseApplet(Parent: TIpHtmlNode; const EndTokens : TIpHtmlTokenSet);
var
CurApplet : TIpHtmlNodeAPPLET;
@ -6934,12 +6961,15 @@ begin
Dec(InBlock);
end;
end;
*)
function TIpHtml.FindAttribute(const AttrNameSet : TIpHtmlAttributesSet) : string;
begin
Result := ParmValueArray[AttrNameSet];
if FParser <> nil then
Result := FParser.FindAttribute(AttrNameSet)
else
Result := '';
end;
(*
function TIpHtml.ParseInteger(const AttrNameSet: TIpHtmlAttributesSet; aDefault : Integer): Integer;
var
S : string;
@ -6995,6 +7025,7 @@ begin
ReportError(SHtmlInvInt);
end;
function TIpHtml.ParsePixels(const AttrNameSet: TIpHtmlAttributesSet;
const aDefault: string): TIpHtmlPixels;
var
@ -7018,7 +7049,7 @@ begin
end;
end;
end;
*
function TIpHtml.ParseHyperLength(const AttrNameSet: TIpHtmlAttributesSet;
const aDefault: string): TIpHtmlLength;
var
@ -7130,7 +7161,7 @@ begin
B := E + 1;
end;
end;
*)
function CalcMultiLength(const List: TIpHtmlMultiLengthList;
Avail: Integer; var Sections: Integer): TIntArr;
var
@ -7202,12 +7233,13 @@ begin
end;
until S = 0;
end;
(*
function TIpHtml.ParseBoolean(const AttrNameSet: TIpHtmlAttributesSet): Boolean;
begin
Result := length(ParmValueArray[AttrNameSet]) > 0;
end;
const
TIpHtmlOLStyleNames : array[TIpHtmlOLStyle] of char = (
'1', 'a', 'A', 'i', 'I');
@ -7286,6 +7318,7 @@ begin
end;
end;
const
TIpHtmlImageAlignNames : array[TIpHtmlImageAlign] of string = (
'TOP', 'MIDDLE', 'BOTTOM', 'LEFT', 'RIGHT', 'CENTER');
@ -7589,7 +7622,49 @@ begin
ParseBody(HtmlNode, [IpHtmlTagEof]); {may not be present}
end;
end;
*)
procedure TIpHtml.FixMissingBodyTag;
var
i: Integer;
node: TIpHtmlNode;
begin
{ Does the HTML include a body node? }
if not FHtml.HasBodyNode then
{ No. Create a body node under FHtml. }
with FHtml do
begin
with TIpHtmlNodeBODY.Create(FHtml) do
LoadAndApplyCSSProps;
{ Make each of FHtml's current children the children of the Body node. }
for i := Pred(ChildCount) downto 0 do
begin
node := ChildNode[i];
if node <> Body then
begin
FChildren.Remove(node);
node.FParentNode := Body;
Body.FChildren.Insert(0, node);
end;
end;
end;
end;
procedure TIpHtml.Parse;
begin
FParser := TIpHtmlParser.Create(Self, CharStream);
try
if FParser.Execute then begin
FTitleNode := TIpHtmlParser(FParser).TitleNode;
FCurFrameSet := TIpHtmlParser(FParser).FrameSet;
FDocCharSet := TIpHtmlParser(FParser).DocCharSet;
FHasFrames := TIpHtmlParser(FParser).HasFrames;
end;
finally
FreeAndNil(FParser);
end;
end;
(*
procedure TIpHtml.Parse;
var
ch1,ch2,ch3: AnsiChar;
@ -7649,7 +7724,7 @@ begin
end;
end;
end;
*)
constructor TIpHtml.Create;
var
TmpBitmap: TGraphic;
@ -7799,7 +7874,7 @@ begin
PropBCache.Free;
inherited;
end;
(*
function TIpHtml.ParseFrameProp(Default : TIpHtmlFrameProp): TIpHtmlFrameProp;
var
S : string;
@ -7896,6 +7971,7 @@ begin
ReportError(SHtmlInvAlign);
end;
end;
*)
procedure TIpHtml.SetDefaultProps;
begin
@ -9062,7 +9138,7 @@ end;
function FindInnerBlock(Node : TIpHTMLNode): TIpHtmlNodeBlock;
begin
while not (Node is TIpHtmlNodeBlock) do
while (Node <> nil) and not (Node is TIpHtmlNodeBlock) do
Node := Node.FParentNode;
Result := TIpHtmlNodeBlock(Node);
end;
@ -9078,6 +9154,8 @@ var
begin
FEscapedText := Value;
Block := FindInnerBlock(Self);
if Block = nil then
exit;
{we need to clear the queue so that it will be built again}
Block.FLayouter.ClearWordList;
@ -12405,7 +12483,7 @@ begin
begin
if InlineCSS = nil then
InlineCSS := TCSSProps.Create;
Commands := SeperateCommands(Style);
Commands := SeparateCommands(Style);
InlineCSS.ReadCommands(Commands);
Commands.Free;
end;
@ -12608,11 +12686,6 @@ begin
end;
end;
function TIpHtmlNodeCore.ElementName: String;
begin
Result := FElementName;
end;
function TIpHtmlNodeCore.GetAlign: TIpHtmlAlign;
begin
Result := Props.Alignment;

2
components/turbopower_ipro/iphtmlblocklayout.pas
View File

@ -7,7 +7,7 @@ interface
uses
types, Classes, SysUtils, LCLPRoc, LCLIntf, Graphics,
IpUtils, IpHtml, iphtmlprop;
IpUtils, IpHtml, IpHtmlProp, IpHtmlUtils;
type

3060
components/turbopower_ipro/iphtmlparser.pas Normal file
View File

File diff suppressed because it is too large Load Diff

2
components/turbopower_ipro/iphtmlprop.pas
View File

@ -1,4 +1,4 @@
unit iphtmlprop;
unit IpHtmlProp;
{$mode objfpc}{$H+}

592
components/turbopower_ipro/iphtmlutils.pas Normal file
View File

@ -0,0 +1,592 @@
unit IpHtmlUtils;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Graphics,
IpHtmlProp;
const
ShyChar = #1; {character used to represent soft-hyphen in strings}
NbspChar = #2; {character used to represent no-break space in strings}
NAnchorChar = #3 ; {character used to represent an Anchor }
NbspUtf8 = #194#160; {utf8 code of no-break space character}
LF = #10;
CR = #13;
function ColorFromString(S: String): TColor;
function TryColorFromString(S: String; out AColor: TColor; out AErrMsg: String): Boolean;
function GetAlignmentForStr(S: string; ADefault: TIpHtmlAlign = haDefault): TIpHtmlAlign;
function EscapeToAnsi(const S: string): string;
//procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False);
implementation
uses
Translations, LazUTF8,
IpConst,IpUtils;
const
htmlNamedColors: array[0..140] of record
s: string;
c: TColor;
end = ( // alphabetically ordered
(s:'ALICEBLUE'; c:$FFF8F0),
(s:'ANTIQUEWHITE'; c:$D7EBFA),
(s:'AQUA'; c: $FFFF00),
(s:'AQUAMARINE'; c:$D4FF7F),
(s:'AZURE'; c:$FFFFF0),
(s:'BEIGE'; c:$DCF5F5),
(s:'BISQUE'; c:$C4E4FF),
(s:'BLACK'; c:clBlack),
(s:'BLANCHEDALMOND'; c:$CDEBFF),
(s:'BLUE'; c:$FF0000),
(s:'BLUEVIOLET'; c:$E22B8A),
(s:'BROWN'; c:$2A2AA5),
(s:'BURLYWOOD'; c:$87B8DE),
(s:'CADETBLUE'; c:$A09E5F),
(s:'CHARTREUSE'; c:$00FF7F),
(s:'CHOCOLATE'; c:$1E69D2),
(s:'CORAL'; c:$507FFF),
(s:'CORNFLOWERBLUE'; c:$ED9564),
(s:'CORNSILK'; c:$DCF8FF),
(s:'CRIMSON'; c:$3C14DC),
(s:'CYAN'; c: $FFFF00),
(s:'DARKBLUE'; c:$8B0000),
(s:'DARKCYAN'; c:$8B8B00),
(s:'DARKGOLDENROD'; c:$0B86B8),
(s:'DARKGRAY'; c:$A9A9A9),
(s:'DARKGREEN'; c:$006400),
(s:'DARKKHAKI'; c:$6BB7BD),
(s:'DARKMAGENTA'; c:$8B008B),
(s:'DARKOLIVEGREEN'; c:$2F6B55),
(s:'DARKORANGE'; c:$008CFF),
(s:'DARKORCHID'; c:$CC3299),
(s:'DARKRED'; c:$00008B),
(s:'DARKSALMON'; c:$7A96E9),
(s:'DARKSEAGREEN'; c:$8FBC8F),
(s:'DARKSLATEBLUE' ; c:$8B3D48),
(s:'DARKSLATEGRAY'; c:$4F4F2F),
(s:'DARKTURQUOISE'; c:$D1CE00),
(s:'DARKVIOLET'; c:$D30094),
(s:'DARKYELLOW'; c:$008080),
(s:'DEEPPINK'; c:$9314FF),
(s:'DEEPSKYBLUE'; c:$FFBF00),
(s:'DIMGRAY'; c:$696969),
(s:'DODGERBLUE'; c:$FF901E),
(s:'FIREBRICK'; c:$2222B2),
(s:'FLORALWHITE'; c:$F0FAFF),
(s:'FORESTGREEN'; c:$228B22),
(s:'FUCHSIA'; c:$FF00FF),
(s:'GAINSBORO'; c:$DCDCDC),
(s:'GHOSTWHITE'; c:$FFF8F8),
(s:'GOLD'; c:$00D7FF),
(s:'GOLDENROD'; c:$20A5DA),
(s:'GRAY'; c:$808080),
(s:'GREEN'; c:$008000),
(s:'GREENYELLOW'; c:$2FFFAD),
(s:'HONEYDEW'; c:$F0FFF0),
(s:'HOTPINK'; c:$B469FF),
(s:'INDIANRED'; c:$5C5CCD),
(s:'INDIGO'; c:$82004B),
(s:'IVORY'; c:$F0FFFF),
(s:'KHAKI'; c:$8CE6F0),
(s:'LAVENDER'; c:$FAE6E6),
(s:'LAVENDERBLUSH'; c:$F5F0FF),
(s:'LAWNGREEN'; c:$00FC7C),
(s:'LEMONCHIFFON'; c:$CDFAFF),
(s:'LIGHTBLUE'; c:$E6D8AD),
(s:'LIGHTCORAL'; c:$8080F0),
(s:'LIGHTCYAN'; c:$FFFFE0),
(s:'LIGHTGOLDENRODYELLOW'; c:$D2FAFA),
(s:'LIGHTGREEN'; c:$90EE90),
(s:'LIGHTGREY'; c:$D3D3D3),
(s:'LIGHTPINK'; c:$C1B6FF),
(s:'LIGHTSALMON'; c:$7AA0FF),
(s:'LIGHTSEAGREEN'; c:$AAB220),
(s:'LIGHTSKYBLUE'; c:$FACE87),
(s:'LIGHTSLATEGRAY'; c:$998877),
(s:'LIGHTSTEELBLUE'; c:$DEC4B0),
(s:'LIGHTYELLOW'; c:$E0FFFF),
(s:'LIME'; c:$00FF00),
(s:'LIMEGREEN'; c:$32CD32),
(s:'LINEN'; c:$E6F0FA),
(s:'MAGENTA'; c:$FF00FF),
(s:'MAROON'; c:$000080),
(s:'MEDIUMAQUAMARINE'; c:$AACD66),
(s:'MEDIUMBLUE'; c:$CD0000),
(s:'MEDIUMORCHID'; c:$D355BA),
(s:'MEDIUMPURPLE'; c:$DB7093),
(s:'MEDIUMSEAGREEN'; c:$71B33C),
(s:'MEDIUMSLATEBLUE'; c:$EE687B),
(s:'MEDIUMSPRINGGREEN'; c:$9AFA00),
(s:'MEDIUMTURQUOISE'; c:$CCD148),
(s:'MEDIUMVIOLETRED'; c:$8515C7),
(s:'MIDNIGHTBLUE'; c:$701919),
(s:'MINTCREAM'; c:$FAFFF5),
(s:'MISTYROSE'; c:$E1E4FF),
(s:'MOCCASIN'; c:$B5E4FF),
(s:'NAVAJOWHITE'; c:$ADDEFF),
(s:'NAVY'; c:$800000),
(s:'OLDLACE'; c:$E6F5FD),
(s:'OLIVE'; c:$008080),
(s:'OLIVEDRAB'; c:$238E6B),
(s:'ORANGE'; c:$00A5FF),
(s:'ORANGERED'; c:$0045FF),
(s:'ORCHID'; c:$D670DA),
(s:'PALEGOLDENROD'; c:$AAE8EE),
(s:'PALEGREEN'; c:$98FB98),
(s:'PALETURQUOISE'; c:$EEEEAF),
(s:'PALEVIOLETRED'; c:$9370DB),
(s:'PAPAYAWHIP'; c:$D5EFFF),
(s:'PEACHPUFF'; c:$B9DAFF),
(s:'PERU'; c:$3F85CD),
(s:'PINK'; c:$CBC0FF),
(s:'PLUM'; c:$DDA0DD),
(s:'POWDERBLUE'; c:$E6E0B0),
(s:'PURPLE'; c:$800080),
(s:'RED'; c:$0000FF),
(s:'ROSYBROWN'; c:$8F8FBC),
(s:'ROYALBLUE'; c:$901604),
(s:'SADDLEBROWN'; c:$13458B),
(s:'SALMON'; c:$7280FA),
(s:'SANDYBROWN'; c:$60A4F4),
(s:'SEAGREEN'; c:$578B2E),
(s:'SEASHELL'; c:$EEF5FF),
(s:'SIENNA'; c:$2D52A0),
(s:'SILVER'; c:$C0C0C0),
(s:'SKYBLUE'; c:$EBCE87),
(s:'SLATEBLUE'; c:$CD5A6A),
(s:'SLATEGRAY'; c:$908070),
(s:'SNOW'; c:$FAFAFF),
(s:'SPRINGGREEN'; c:$7FFF00),
(s:'STEELBLUE'; c:$B48246),
(s:'TAN'; c:$8CB4D2),
(s:'TEAL'; c:$808000),
(s:'THISTLE'; c:$D8BFD8),
(s:'TOMATO'; c:$4763FF),
(s:'TURQUOISE'; c:$D0E040),
(s:'VIOLET'; c:$EE82EE),
(s:'WHEAT'; c:$B3DEF5),
(s:'WHITE'; c:$FFFFFF),
(s:'WHITESMOKE'; c:$F5F5F5),
(s:'YELLOW'; c:$00FFFF),
(s:'YELLOWGREEN'; c:$32CD9A)
);
function BinSearchNamedColor(const AColorStr: string; var AColor: TColor): boolean;
var
First: Integer;
Last: Integer;
Pivot: Integer;
begin
First := Low(htmlNamedColors); //Sets the first item of the range
Last := High(htmlNamedColors); //Sets the last item of the range
Result := False; //Initializes the Found flag (Not found yet)
//If First > Last then the searched item doesn't exist
//If the item is found the loop will stop
while (First <= Last) {and (not Result)} do
begin
//Gets the middle of the selected range
Pivot := (First + Last) div 2;
//Compares the String in the middle with the searched one
if htmlNamedColors[Pivot].s = AColorStr then
begin
Result := True;
AColor := htmlNamedColors[Pivot].c;
exit;
end
//If the Item in the middle has a bigger value than
//the searched item, then select the first half
else if htmlNamedColors[Pivot].s > AColorStr then
Last := Pivot - 1
//else select the second half
else
First := Pivot + 1;
end;
end;
function TryColorFromString(S: String; out AColor: TColor; out AErrMsg: String): Boolean;
var
R, G, B, Err: Integer;
begin
Result := false;
AColor := clNone;
if S = '' then
begin
Result := true;
Exit;
end;
S := UpperCase(S);
if S[1] = '#' then
begin
if Length(S) <> 7 then
begin
AErrMsg := SHtmlInvColor + S;
Result := false;
end
else begin
val('$'+Copy(S,2,2), R, Err);
if Err <> 0 then
R := 255;
val('$'+Copy(S,4,2), G, Err);
if Err <> 0 then
G := 255;
val('$'+Copy(S,6,2), B, Err);
if Err <> 0 then
B := 255;
AColor := RGBToColor(R, G, B);
Result := true;
end;
end else
if BinSearchNamedColor(S, AColor) then
begin
Result := true;
exit;
end else
if Length(S) = 6 then
try
val('$'+Copy(S,1,2), R, Err);
if Err <> 0 then
R := 255;
val('$'+Copy(S,3,2), G, Err);
if Err <> 0 then
G := 255;
val('$'+Copy(S,5,2), B, Err);
if Err <> 0 then
B := 255;
AColor := RGBToColor(R, G, B);
Result := true;
except
AErrMsg := SHtmlInvColor + S;
end;
end;
function ColorFromString(S: String): TColor;
var
msg: String;
begin
if not TryColorFromString(S, Result, msg) then
Result := clNone;
end;
function GetAlignmentForStr(S: string;
ADefault: TIpHtmlAlign = haDefault): TIpHtmlAlign;
begin
S := UpperCase(S);
if Length(S) = 0 then
begin
Result := ADefault;
exit;
end;
case S[1] of
'C','M':
if S = 'CHAR' then
Result := haChar
else if (S = 'CENTER') or (S = 'MIDDLE') then
Result := haCenter;
'J':
if S = 'JUSTIFY' then Result := haJustify;
'L':
if (S = 'LEFT') then Result := haLeft;
'R':
if S = 'RIGHT' then Result := haRight;
else
Result := ADefault;
end;
end;
const
CodeCount = 126;
{Sorted by Size where size is Length(Name).
Make sure you respect this when adding new items}
Codes: array[0..Pred(CodeCount)] of record
Size: Integer;
Name: String;
Value: String;
ValueUtf8: String; //UTF8 DiBo33
end = (
(Size: 2; Name: 'gt'; Value: '>'; ValueUtf8: #$3E),
(Size: 2; Name: 'lt'; Value: '<'; ValueUtf8: #$3C),
(Size: 3; Name: 'amp'; Value: '&'; ValueUtf8: #$26),
(Size: 3; Name: 'deg'; Value: #176; ValueUtf8: #$C2#$B0),
(Size: 3; Name: 'ETH'; Value: #208; ValueUtf8: #$C3#$90),
(Size: 3; Name: 'eth'; Value: #240; ValueUtf8: #$C3#$B0),
(Size: 3; Name: 'not'; Value: #172; ValueUtf8: #$C2#$AC),
(Size: 3; Name: 'reg'; Value: #174; ValueUtf8: #$C2#$AE),
(Size: 3; Name: 'shy'; Value: ShyChar; ValueUtf8: ShyChar),
(Size: 3; Name: 'uml'; Value: #168; ValueUtf8: #$C2#$A8),
(Size: 3; Name: 'yen'; Value: #165; ValueUtf8: #$C2#$A5),
(Size: 4; Name: 'Auml'; Value: #196; ValueUtf8: #$C3#$84),
(Size: 4; Name: 'auml'; Value: #228; ValueUtf8: #$C3#$A4),
(Size: 4; Name: 'bull'; Value: #149; ValueUtf8: #$E2#$80#$A2),
(Size: 4; Name: 'cent'; Value: #162; ValueUtf8: #$C2#$A2),
(Size: 4; Name: 'circ'; Value: '^'; ValueUtf8: #$5E),
(Size: 4; Name: 'copy'; Value: #169; ValueUtf8: #$C2#$A9),
(Size: 4; Name: 'Euml'; Value: #203; ValueUtf8: #$C3#$8B),
(Size: 4; Name: 'euml'; Value: #235; ValueUtf8: #$C3#$AB),
(Size: 4; Name: 'euro'; Value: #128; ValueUtf8: #$E2#$82#$AC),
(Size: 4; Name: 'fnof'; Value: #131; ValueUtf8: #$C6#$92),
(Size: 4; Name: 'Iuml'; Value: #207; ValueUtf8: #$C3#$8F),
(Size: 4; Name: 'iuml'; Value: #239; ValueUtf8: #$C3#$AF),
(Size: 4; Name: 'macr'; Value: #175; ValueUtf8: #$C2#$AF),
(Size: 4; Name: 'nbsp'; Value: NbspChar; ValueUtf8: NbspChar),
(Size: 4; Name: 'ordf'; Value: #170; ValueUtf8: #$C2#$AA),
(Size: 4; Name: 'ordm'; Value: #186; ValueUtf8: #$C2#$BA),
(Size: 4; Name: 'Ouml'; Value: #214; ValueUtf8: #$C3#$96),
(Size: 4; Name: 'ouml'; Value: #246; ValueUtf8: #$C3#$B6),
(Size: 4; Name: 'para'; Value: #182; ValueUtf8: #$C2#$B6),
(Size: 4; Name: 'quot'; Value: '"'; ValueUtf8: #$22),
(Size: 4; Name: 'sect'; Value: #167; ValueUtf8: #$C2#$A7),
(Size: 4; Name: 'sup1'; Value: #185; ValueUtf8: #$C2#$B9),
(Size: 4; Name: 'sup2'; Value: #178; ValueUtf8: #$C2#$B2),
(Size: 4; Name: 'sup3'; Value: #179; ValueUtf8: #$C2#$B3),
(Size: 4; Name: 'Uuml'; Value: #220; ValueUtf8: #$C3#$9C),
(Size: 4; Name: 'uuml'; Value: #252; ValueUtf8: #$C3#$BC),
(Size: 4; Name: 'Yuml'; Value: #159; ValueUtf8: #$C5#$B8),
(Size: 4; Name: 'yuml'; Value: #255; ValueUtf8: #$C3#$BF),
(Size: 5; Name: 'Acirc'; Value: #194; ValueUtf8: #$C3#$82),
(Size: 5; Name: 'acirc'; Value: #226; ValueUtf8: #$C3#$A2),
(Size: 5; Name: 'acute'; Value: #180; ValueUtf8: #$C2#$B4),
(Size: 5; Name: 'AElig'; Value: #198; ValueUtf8: #$C3#$86),
(Size: 5; Name: 'aelig'; Value: #230; ValueUtf8: #$C3#$A6),
(Size: 5; Name: 'Aring'; Value: #197; ValueUtf8: #$C3#$85),
(Size: 5; Name: 'aring'; Value: #229; ValueUtf8: #$C3#$A5),
(Size: 5; Name: 'cedil'; Value: #184; ValueUtf8: #$C2#$B8),
(Size: 5; Name: 'Ecirc'; Value: #202; ValueUtf8: #$C3#$8A),
(Size: 5; Name: 'ecirc'; Value: #234; ValueUtf8: #$C3#$AA),
(Size: 5; Name: 'frasl'; Value: '/'; ValueUtf8: #$2F),
(Size: 5; Name: 'Icirc'; Value: #206; ValueUtf8: #$C3#$8E),
(Size: 5; Name: 'icirc'; Value: #238; ValueUtf8: #$C3#$AE),
(Size: 5; Name: 'iexcl'; Value: #161; ValueUtf8: #$C2#$A1),
(Size: 5; Name: 'laquo'; Value: #171; ValueUtf8: #$C2#$AB),
(Size: 5; Name: 'ldquo'; Value: #147; ValueUtf8: #$E2#$80#$9C),
(Size: 5; Name: 'lsquo'; Value: #145; ValueUtf8: #$E2#$80#$98),
(Size: 5; Name: 'mdash'; Value: #151; ValueUtf8: #$E2#$80#$94),
(Size: 5; Name: 'micro'; Value: #181; ValueUtf8: #$C2#$B5),
(Size: 5; Name: 'minus'; Value: '-'; ValueUtf8: #$2D),
(Size: 5; Name: 'ndash'; Value: #150; ValueUtf8: #$E2#$80#$93),
(Size: 5; Name: 'Ocirc'; Value: #212; ValueUtf8: #$C3#$94),
(Size: 5; Name: 'ocirc'; Value: #244; ValueUtf8: #$C3#$B4),
(Size: 5; Name: 'OElig'; Value: #140; ValueUtf8: #$C5#$92),
(Size: 5; Name: 'oelig'; Value: #156; ValueUtf8: #$C5#$93),
(Size: 5; Name: 'pound'; Value: #163; ValueUtf8: #$C2#$A3),
(Size: 5; Name: 'raquo'; Value: #187; ValueUtf8: #$C2#$BB),
(Size: 5; Name: 'rdquo'; Value: #148; ValueUtf8: #$E2#$80#$9D),
(Size: 5; Name: 'rsquo'; Value: #146; ValueUtf8: #$E2#$80#$99),
(Size: 5; Name: 'szlig'; Value: #223; ValueUtf8: #$C3#$9F),
(Size: 5; Name: 'THORN'; Value: #222; ValueUtf8: #$C3#$9E),
(Size: 5; Name: 'thorn'; Value: #254; ValueUtf8: #$C3#$BE),
(Size: 5; Name: 'tilde'; Value: '~'; ValueUtf8: #$7E),
(Size: 5; Name: 'times'; Value: #215; ValueUtf8: #$C3#$97),
(Size: 5; Name: 'trade'; Value: #153; ValueUtf8: #$E2#$84#$A2),
(Size: 5; Name: 'Ucirc'; Value: #219; ValueUtf8: #$C3#$9B),
(Size: 5; Name: 'ucirc'; Value: #251; ValueUtf8: #$C3#$BB),
(Size: 6; Name: 'Aacute'; Value: #193; ValueUtf8: #$C3#$81),
(Size: 6; Name: 'aacute'; Value: #225; ValueUtf8: #$C3#$A1),
(Size: 6; Name: 'Agrave'; Value: #192; ValueUtf8: #$C3#$80),
(Size: 6; Name: 'agrave'; Value: #224; ValueUtf8: #$C3#$A0),
(Size: 6; Name: 'Atilde'; Value: #195; ValueUtf8: #$C3#$83),
(Size: 6; Name: 'atilde'; Value: #227; ValueUtf8: #$C3#$A3),
(Size: 6; Name: 'brvbar'; Value: #166; ValueUtf8: #$C2#$A6),
(Size: 6; Name: 'Ccedil'; Value: #199; ValueUtf8: #$C3#$87),
(Size: 6; Name: 'ccedil'; Value: #231; ValueUtf8: #$C3#$A7),
(Size: 6; Name: 'curren'; Value: #164; ValueUtf8: #$C2#$A4),
(Size: 6; Name: 'dagger'; Value: #134; ValueUtf8: #$E2#$80#$A0),
(Size: 6; Name: 'Dagger'; Value: #135; ValueUtf8: #$E2#$80#$A1),
(Size: 6; Name: 'divide'; Value: #247; ValueUtf8: #$C3#$B7),
(Size: 6; Name: 'Eacute'; Value: #201; ValueUtf8: #$C3#$89),
(Size: 6; Name: 'eacute'; Value: #233; ValueUtf8: #$C3#$A9),
(Size: 6; Name: 'Egrave'; Value: #200; ValueUtf8: #$C3#$88),
(Size: 6; Name: 'egrave'; Value: #232; ValueUtf8: #$C3#$A8),
(Size: 6; Name: 'frac12'; Value: #189; ValueUtf8: #$C2#$BD),
(Size: 6; Name: 'frac14'; Value: #188; ValueUtf8: #$C2#$BC),
(Size: 6; Name: 'frac34'; Value: #190; ValueUtf8: #$C2#$BE),
(Size: 6; Name: 'hellip'; Value: #133; ValueUtf8: #$E2#$80#$A6),
(Size: 6; Name: 'Iacute'; Value: #205; ValueUtf8: #$C3#$8D),
(Size: 6; Name: 'iacute'; Value: #237; ValueUtf8: #$C3#$AD),
(Size: 6; Name: 'Igrave'; Value: #204; ValueUtf8: #$C3#$8C),
(Size: 6; Name: 'igrave'; Value: #236; ValueUtf8: #$C3#$AC),
(Size: 6; Name: 'iquest'; Value: #191; ValueUtf8: #$C2#$BF),
(Size: 6; Name: 'lsaquo'; Value: #139; ValueUtf8: #$E2#$80#$B9),
(Size: 6; Name: 'middot'; Value: #183; ValueUtf8: #$C2#$B7),
(Size: 6; Name: 'Ntilde'; Value: #209; ValueUtf8: #$C3#$91),
(Size: 6; Name: 'ntilde'; Value: #241; ValueUtf8: #$C3#$B1),
(Size: 6; Name: 'Oacute'; Value: #211; ValueUtf8: #$C3#$93),
(Size: 6; Name: 'oacute'; Value: #243; ValueUtf8: #$C3#$B3),
(Size: 6; Name: 'Ograve'; Value: #210; ValueUtf8: #$C3#$92),
(Size: 6; Name: 'ograve'; Value: #242; ValueUtf8: #$C3#$B2),
(Size: 6; Name: 'Oslash'; Value: #216; ValueUtf8: #$C3#$98),
(Size: 6; Name: 'oslash'; Value: #248; ValueUtf8: #$C3#$B8),
(Size: 6; Name: 'Otilde'; Value: #213; ValueUtf8: #$C3#$95),
(Size: 6; Name: 'otilde'; Value: #245; ValueUtf8: #$C3#$B5),
(Size: 6; Name: 'permil'; Value: #137; ValueUtf8: #$E2#$80#$B0),
(Size: 6; Name: 'plusmn'; Value: #177; ValueUtf8: #$C2#$B1),
(Size: 6; Name: 'rsaquo'; Value: #155; ValueUtf8: #$E2#$80#$BA),
(Size: 6; Name: 'Scaron'; Value: #138; ValueUtf8: #$C5#$A0),
(Size: 6; Name: 'scaron'; Value: #154; ValueUtf8: #$C5#$A1),
(Size: 6; Name: 'Uacute'; Value: #218; ValueUtf8: #$C3#$9A),
(Size: 6; Name: 'uacute'; Value: #250; ValueUtf8: #$C3#$BA),
(Size: 6; Name: 'Ugrave'; Value: #217; ValueUtf8: #$C3#$99),
(Size: 6; Name: 'ugrave'; Value: #249; ValueUtf8: #$C3#$B9),
(Size: 6; Name: 'Yacute'; Value: #221; ValueUtf8: #$C3#$9D),
(Size: 6; Name: 'yacute'; Value: #253; ValueUtf8: #$C3#$BD),
(Size: 6; Name: 'xxxxxx'; Value: NAnchorChar; ValueUtf8: NAnchorChar)
);
function ParseConstant(const S: string; OnUtf8: boolean = false): string;
var
Error: Integer;
Index1: Integer;
Index2: Integer;
Size1: Integer;
Found: Boolean;
begin {'Complete boolean eval' must be off}
Result := ' ';
Size1 := Length(S);
if Size1 = 0 then Exit;
if (S[1] in ['$', '0'..'9']) then
begin
Val(S, Index1, Error);
if (Error = 0) then
begin
if not OnUTF8 and (Index1 >= 32) and (Index1 <= 255) then
Result := Chr(Index1)
else
begin
Result := UnicodeToUTF8(Index1);
if Result = NbspUTF8 then Result := NbspChar;
end;
end;
end else
begin
Index1 := 0;
repeat
if Size1 = Codes[Index1].Size then
begin
Found := True;
Index2 := 1;
while Index2 <= Size1 do
begin
if S[Index2] <> Codes[Index1].Name[Index2] then
begin
Found := False;
Break;
end;
Inc(Index2);
end;
if Found then
begin
if OnUtf8 then
Result := Codes[Index1].ValueUTF8
else
Result := Codes[Index1].Value;
Break;
end;
end;
Inc(Index1);
until (Index1 >= CodeCount) or (Codes[Index1].Size > Size1);
end;
end;
{- returns the string with & escapes expanded}
procedure ExpandEscapes(var S: string);
var
i, j : Integer;
Co : string;
Ch : AnsiChar;
St : string;
begin
i := Length(S);
while i > 0 do begin
if S[i] = '&' then begin
j := i;
while (j < length(S)) and not (S[j] in [';', ' ']) do
Inc(j);
Co := copy(S, i + 1, j - i - 1);
if Co <> '' then begin
if Co[1] = '#' then begin
Delete(Co, 1, 1);
if UpCase(Co[1]) = 'X' then begin
Delete(Co, 1, 1);
Insert('$', Co, 1);
end;
end;
Delete(S, i, j - i + 1);
if SystemCharSetIsUTF8 then begin
St := ParseConstant(Co, true);
Insert(St, S, i)
end else begin
Ch := ParseConstant(Co)[1];
Insert(Ch, S, i);
end;
end;
end;
Dec(i);
end;
end;
function EscapeToAnsi(const S: string): string;
var
P : Integer;
begin
Result := S;
P := CharPos('&', S);
if P <> 0 then
ExpandEscapes(Result);
end;
(*
procedure TrimFormatting(const S: string; Target: PAnsiChar; PreFormatted: Boolean = False);
var
r, w: Integer;
procedure CopyChar(ch: AnsiChar);
begin
Target[w] := ch;
Inc(w);
end;
begin
r := 1;
w := 0;
while r <= Length(S) do begin
case S[r] of
#0..#8, #11..#12, #14..#31 :
;
#9 :
if PreFormatted then
CopyChar(' ');
#13 :
if PreFormatted then
CopyChar(LF);
#10 :
if PreFormatted then begin
if (w = 0) or (Target[w-1] <> LF) then
CopyChar(LF);
end
else begin
if w > 1 then
CopyChar(' ');
end;
' ' :
if PreFormatted or (w = 0) or (Target[w-1] <> ' ') then
CopyChar(' ');
else
CopyChar(S[r]);
end;
Inc(r);
end;
Target[w] := #0;
end; *)
end.

48
components/turbopower_ipro/test_cases/ipro_tests.pas
View File

@ -273,6 +273,54 @@ const
'</body>' + LE +
'</html>';
//------------------------------------------------------------------------------
// CSS
//------------------------------------------------------------------------------
const
HTMLCommentInCSS_title =
'HTML comment in CSS section';
HTMLCommentInCSS_descr =
'The text must be red.';
HTMLCommentInCSS_html =
'<html>' + LE +
'<head>' + LE +
' <style type="text/css">' + LE +
' <!--' + LE +
' body { color: red; }' + LE +
' -->' + LE +
' </style>' + LE +
'</head>' + LE +
'<body>' + LE +
' <p>abc</p>' + LE +
'</body>' + LE +
'</html>';
//------------------------------------------------------------------------------
// Special cases in file structure
//------------------------------------------------------------------------------
const
NoHtmlTag_title =
'No <html> tag';
NoHtmlTag_descr =
'You should see an ordered list with two items "line 1" and "line 2".';
NoHtmlTag_html =
'<body>' + LE +
' <ol>' + LE +
' <li>line 1</li>' + LE +
' <li>line 2</li>' + LE +
' </ol>' + LE +
'</body>';
const
NoBodyTag_title =
'No <body> tag';
NoBodyTag_descr =
'You should see an ordered list with two items "line 1" and "line 2".';
NoBodyTag_html =
'<ol>' + LE +
' <li>line 1</li>' + LE +
' <li>line 2</li>' + LE +
'</ol>';
implementation

23
components/turbopower_ipro/test_cases/iprotest_unit.pas
View File

@ -139,7 +139,7 @@ end;
procedure TForm1.PopulateTests;
var
node: TTreeNode;
node, node1: TTreeNode;
begin
TreeView1.Items.BeginUpdate;
try
@ -162,11 +162,22 @@ begin
AddTest(node, TextInColoredTableCell_title, TextInColoredTableCell_descr, TextInColoredTableCell_html);
node.Expanded := true;
node := TreeView1.Items.AddChild(nil, 'Text alignment');
AddTest(node, AlignInCell_title, AlignInCell_descr, AlignInCell_html);
AddTest(node, AlignInCellBold_title, AlignInCellBold_descr, AlignInCellBold_html);
AddTest(node, AlignInCell_CSS_title, AlignInCell_CSS_descr, AlignInCell_CSS_html);
AddTest(node, AlignInCellBold_CSS_title, AlignInCellBold_CSS_descr, AlignInCellBold_CSS_html);
node := TreeView1.Items.AddChild(nil, 'Tables');
node1 := TreeView1.Items.AddChild(node, 'Text alignment');
AddTest(node1, AlignInCell_title, AlignInCell_descr, AlignInCell_html);
AddTest(node1, AlignInCellBold_title, AlignInCellBold_descr, AlignInCellBold_html);
AddTest(node1, AlignInCell_CSS_title, AlignInCell_CSS_descr, AlignInCell_CSS_html);
AddTest(node1, AlignInCellBold_CSS_title, AlignInCellBold_CSS_descr, AlignInCellBold_CSS_html);
node1.Expanded := true;
node.Expanded := true;
node := TreeView1.Items.AddChild(nil, 'CSS');
AddTest(node, HTMLCommentInCSS_title, HTMLCommentInCSS_descr, HTMLCommentInCSS_html);
node.Expanded := true;
node := TreeView1.Items.AddChild(nil, 'Special cases in file structure');
AddTest(node, NoHtmlTag_title, NoHtmlTag_descr, NoHtmlTag_html);
AddTest(node, NoBodyTag_title, NoBodyTag_descr, NoBodyTag_html);
node.Expanded := true;
finally

14
components/turbopower_ipro/turbopoweripro.lpk
View File

@ -25,7 +25,7 @@
<License Value="MPL - Mozilla public license
"/>
<Version Major="1"/>
<Files Count="17">
<Files Count="20">
<Item1>
<Filename Value="ipanim.pas"/>
<UnitName Value="IpAnim"/>
@ -98,6 +98,18 @@
<Filename Value="iphtmlgenerated.inc"/>
<Type Value="Binary"/>
</Item17>
<Item18>
<Filename Value="iphtmlparser.pas"/>
<UnitName Value="IpHtmlParser"/>
</Item18>
<Item19>
<Filename Value="iphtmlutils.pas"/>
<UnitName Value="IpHtmlUtils"/>
</Item19>
<Item20>
<Filename Value="ipcss.pas"/>
<UnitName Value="IpCSS"/>
</Item20>
</Files>
<CompatibilityMode Value="True"/>
<i18n>

3
components/turbopower_ipro/turbopoweripro.pas
View File

@ -10,7 +10,7 @@ interface
uses
IpAnim, IpConst, Ipfilebroker, Iphttpbroker, IpHtml, IpMsg, IpStrms,
IpUtils, IpHtmlTabList, iphtmlprop, ipHtmlBlockLayout, ipHtmlTableLayout,
LazarusPackageIntf;
IpHtmlParser, IpHtmlUtils, IpCSS, LazarusPackageIntf;
implementation
@ -24,4 +24,3 @@ end;
initialization
RegisterPackage('TurboPowerIPro', @Register);
end.