tpipro, handle style tag in HEAD, improved font for length units em & %, handle single and double quote in css strings

git-svn-id: trunk@13901 -
This commit is contained in:
jesus 2008-01-28 18:57:27 +00:00
parent 3e1f2d598f
commit feff55eb39
4 changed files with 148 additions and 70 deletions

View File

@ -551,29 +551,32 @@ end;
function TCSSProps.GetCommandArgs(ACommand: String): TStringList; function TCSSProps.GetCommandArgs(ACommand: String): TStringList;
var var
i: Integer; i: Integer;
WantQuote: Boolean;
WantArg: Boolean; WantArg: Boolean;
Arg: String; Arg: String;
Start: Integer; Start: Integer;
Quote: char;
begin begin
Result := TStringList.Create; Result := TStringList.Create;
Start := Pos(':', ACommand)+1; Start := Pos(':', ACommand)+1;
WantQuote := False;
WantArg := True; WantArg := True;
Quote := #0;
for i := Start to Length(ACommand) do for i := Start to Length(ACommand) do
begin begin
if (WantQuote = False) and (ACommand[i] = '"') then if (Quote = #0) and (ACommand[i] in ['"','''']) then
begin begin
WantQuote := True; Quote := ACommand[i];
Start := i+1; Start := i+1;
continue; continue;
end; end;
if WantQuote and (ACommand[i] = '"') then if Quote<>#0 then begin
begin if ACommand[i]=Quote then begin
WantQuote := False; Quote:=#0;
Arg := Copy(ACommand, Start, i-1); Arg := Copy(ACommand, Start, i-Start);
Result.Add(Arg); Result.Add(Arg);
end;
continue;
end; end;
if WantArg then if WantArg then
begin begin
@ -585,7 +588,9 @@ begin
end end
else // we have an arg we are reading ... else // we have an arg we are reading ...
begin begin
if (i <> Length(ACommand)) and (not IsWhiteSpace(ACommand[i])) then if (i<Length(ACommand)) and
(ACommand[i]<>';')
then
continue; continue;
WantArg := True; WantArg := True;
Arg := Copy(ACommand, Start, i-1); Arg := Copy(ACommand, Start, i-1);
@ -751,9 +756,6 @@ begin
Args := GetCommandArgs(ACommand); Args := GetCommandArgs(ACommand);
Command := LowerCase(GetCommandName(ACommand)); Command := LowerCase(GetCommandName(ACommand));
//WriteLn('Got Command: "', Command,'" With args:');
//WriteLn(Args.Text);
if Command = 'color' then if Command = 'color' then
Color := ColorFromString(Args[0]) Color := ColorFromString(Args[0])
else if Command = 'background-color' then else if Command = 'background-color' then
@ -812,8 +814,10 @@ var
ElementIndex := FElements.IndexOf(ElementName); ElementIndex := FElements.IndexOf(ElementName);
if ElementIndex>=0 then if ElementIndex>=0 then begin
result := TCSSProps(FElements.Objects[ElementIndex]); result := TCSSProps(FElements.Objects[ElementIndex]);
end;
end; end;
begin begin
Result := nil; Result := nil;

View File

@ -301,13 +301,13 @@ var
begin begin
Initialize(FileAddrRec); Initialize(FileAddrRec);
{$IFDEF IP_LAZARUS} {$IFDEF IP_LAZARUS}
DebugLn('TIpFileDataProvider.CanHandle('+URL+')'); //DebugLn('TIpFileDataProvider.CanHandle('+URL+')');
{$ENDIF} {$ENDIF}
FN := BuildURL(FOldURL, URL); FN := BuildURL(FOldURL, URL);
IpParseURL(FN, FileAddrRec); IpParseURL(FN, FileAddrRec);
FN := NetToDosPath(FileAddrRec.Path); FN := NetToDosPath(FileAddrRec.Path);
{$IFDEF IP_LAZARUS} {$IFDEF IP_LAZARUS}
DebugLn('TIpFileDataProvider.CanHandle FN="'+FN+'"'); //DebugLn('TIpFileDataProvider.CanHandle FN="'+FN+'"');
{$ENDIF} {$ENDIF}
ContentType := UpperCase(GetLocalContent(FN)); ContentType := UpperCase(GetLocalContent(FN));
Result := (FileExists(FN)) and ((Pos('TEXT/HTML', ContentType) > 0) or Result := (FileExists(FN)) and ((Pos('TEXT/HTML', ContentType) > 0) or

View File

@ -777,6 +777,8 @@ type
protected protected
procedure ParseBaseProps(Owner : TIpHtml); {virtual;} {!!.12} procedure ParseBaseProps(Owner : TIpHtml); {virtual;} {!!.12}
{$IFDEF IP_LAZARUS} {$IFDEF IP_LAZARUS}
function SelectCSSFont(const aFont: string): string;
procedure ApplyCSSProps(const Element: TCSSProps; const props: TIpHtmlProps);
procedure LoadCSSProps(Owner : TIpHtml; var Element: TCSSProps; const Props: TIpHtmlProps); virtual; procedure LoadCSSProps(Owner : TIpHtml; var Element: TCSSProps; const Props: TIpHtmlProps); virtual;
function ElementName: String; function ElementName: String;
function GetFontSizeFromCSS(CurrentFontSize:Integer; aFontSize: string):Integer; function GetFontSizeFromCSS(CurrentFontSize:Integer; aFontSize: string):Integer;
@ -5303,8 +5305,14 @@ begin
{$ENDIF} {$ENDIF}
end; end;
NextToken; NextToken;
if CurToken <> IpHtmlTagSTYLEend then if CurToken <> IpHtmlTagSTYLEend then begin
{$IFDEF IP_LAZARUS}
if (CurToken=IpHtmlTagText) and
(AnsiCompareText(CurStyle.Type_ , 'text/css')=0) then
ParseStyleSheet(CurStyle, GetTokenString);
{$ENDIF}
ParseText([IpHtmlTagSTYLEend], CurStyle); ParseText([IpHtmlTagSTYLEend], CurStyle);
end;
if CurToken = IpHtmlTagSTYLEend then if CurToken = IpHtmlTagSTYLEend then
NextToken NextToken
else else
@ -6756,25 +6764,26 @@ procedure TIpHtml.ParseStyleSheet(Parent: TIpHtmlNode; HRef: String);
var var
StyleStream: TStream; StyleStream: TStream;
begin begin
if FDataProvider = nil then if FDataProvider = nil then begin
begin
//DebugLn('No dataprovider!'); //DebugLn('No dataprovider!');
exit; exit;
end; end;
if Parent is TIpHtmlNodeHEAD then
begin StyleStream:=nil;
if Parent is TIpHtmlNodeHEAD then begin
Href := FDataProvider.BuildURL(CurURL, HRef); Href := FDataProvider.BuildURL(CurURL, HRef);
StyleStream := FDataProvider.DoGetStream(HRef); StyleStream := FDataProvider.DoGetStream(HRef);
if StyleStream <> nil then end else
begin if Parent is TIpHtmlNodeSTYLE then
with TCSSReader.Create(StyleStream, FCSS) do StyleStream := TStringStream.Create(Href);
begin
ParseCSS; if StyleStream<>nil then
Free; with TCSSReader.Create(StyleStream, FCSS) do begin
end; ParseCSS;
Free;
StyleStream.Free; StyleStream.Free;
end; end;
end;
end; end;
{$ENDIF} {$ENDIF}
@ -14610,46 +14619,87 @@ begin
TmpElement := Element; TmpElement := Element;
if Element = nil then if Element = nil then
begin begin
// process first the Main element // process first the Main element
Element := Owner.CSS.GetElement(ElementName, ''); Element := Owner.CSS.GetElement(ElementName, '');
if Element <> nil then if Element <> nil then begin
LoadCSSProps(Owner, Element, Props); ApplyCSSProps(Element, Props);
end;
// load the .class if there is one // load the .class if there is one
Element := Owner.CSS.GetElement('', ClassId); if ClassID<>'' then begin
if Element <> nil then Element := Owner.CSS.GetElement('', ClassId);
LoadCSSProps(Owner, Element, Props); if Element <> nil then begin
ApplyCSSProps(Element, Props);
end;
end;
// then load the element + class if there is one // then load the element + class if there is one
if (Element=nil)and(ClassID<>'') then if (Element=nil)and(ClassID<>'') then begin
Element := Owner.CSS.GetElement(ElementName, ClassId); Element := Owner.CSS.GetElement(ElementName, ClassId);
if Element=nil then
else begin
ApplyCSSProps(Element, Props);
end;
end;
end; end;
if (Element <> nil) and (Props <> nil) then if TmpElement = nil then
begin
// lookup id elements
TmpElement := Owner.CSS.GetElement(Id);
if TmpElement <> nil then begin
ApplyCSSProps(TmpElement, Props);
end;
// lookup local elements for this tag, not from the stylesheet
TmpElement := CSS;
if TmpElement <> nil then begin
ApplyCSSProps(TmpElement, Props);
end;
end;
end;
function TIpHtmlNodeCore.SelectCSSFont(const aFont: string): string;
begin
// todo: implement font matching
result := FirstString(aFont);
end;
procedure TIpHtmlNodeCore.ApplyCSSProps(const Element: TCSSProps;
const props: TIpHtmlProps);
begin
if (Element<>nil) and (props<>nil) then
begin begin
{$WARNING Setting these font colors and name messes up the alignment for some reason} {$WARNING Setting these font colors and name messes up the alignment for some reason}
if Element.Color <> -1 then if Element.Color <> -1 then begin
Props.FontColor := Element.Color; Props.FontColor := Element.Color;
end;
if Element.BGColor <> -1 then
if Element.BGColor <> -1 then begin
Props.BgColor := Element.Color; Props.BgColor := Element.Color;
end;
if Element.Font.Name <> '' then
Props.FontName := FirstString(Element.Font.Name); if Element.Font.Name <> '' then begin
// put the code here, later refactore it
Props.FontName := SelectCSSFont(Element.Font.Name);
end;
{$WARNING TODO Set Font size from CSS Value} {$WARNING TODO Set Font size from CSS Value}
// see http://xhtml.com/en/css/reference/font-size/ // see http://xhtml.com/en/css/reference/font-size/
if Element.Font.Size <> '' then if Element.Font.Size <> '' then begin
// Props.FontSize := Element.Font.Size;
props.FontSize:=GetFontSizeFromCSS(Props.FontSize, Element.Font.Size); props.FontSize:=GetFontSizeFromCSS(Props.FontSize, Element.Font.Size);
end;
if Element.Font.Style <> cfsNormal then if Element.Font.Style <> cfsNormal then begin
begin
case Element.Font.Style of case Element.Font.Style of
cfsItalic,cfsOblique: Props.FontStyle := Props.FontStyle + [fsItalic]; cfsItalic,cfsOblique: Props.FontStyle := Props.FontStyle + [fsItalic];
cfsInherit: ; // what to do?: search through parent nodes looking for a computed value cfsInherit: ; // what to do?: search through parent nodes looking for a computed value
end; end;
end; end;
if Element.Font.Weight <> cfwNormal then if Element.Font.Weight <> cfwNormal then begin
begin
case Element.Font.Weight of case Element.Font.Weight of
cfwBold : Props.FontStyle := Props.FontStyle + [fsBold]; cfwBold : Props.FontStyle := Props.FontStyle + [fsBold];
cfwBolder : Props.FontStyle := Props.FontStyle + [fsBold]; cfwBolder : Props.FontStyle := Props.FontStyle + [fsBold];
@ -14666,18 +14716,6 @@ begin
end; end;
end; end;
end; end;
if TmpElement = nil then
begin
// lookup id elements
TmpElement := Owner.CSS.GetElement(Id);
if TmpElement <> nil then
LoadCSSProps(Owner, TmpElement, Props);
// lookup local elements for this tag, not from the stylesheet
TmpElement := CSS;
if TmpElement <> nil then
LoadCSSProps(Owner, TmpElement, Props);
end;
end; end;
function TIpHtmlNodeCore.ElementName: String; function TIpHtmlNodeCore.ElementName: String;
@ -14687,20 +14725,56 @@ end;
function TIpHtmlNodeCore.GetFontSizeFromCSS(CurrentFontSize:Integer; function TIpHtmlNodeCore.GetFontSizeFromCSS(CurrentFontSize:Integer;
aFontSize: string):Integer; aFontSize: string):Integer;
function GetFSize(aUnits: string): double;
var
i: Integer;
begin
i := pos(aUnits, aFontSize);
if i>0 then
result := StrToFloatDef(copy(aFontSize,1,i-1), -1.0)
else
result := -1.0;
end;
function GetParentFontSize: integer;
begin
if (FParentNode is TIpHtmlNodeBlock) then
result :=TIpHtmlNodeBlock(FParentNode).Props.FontSize
else
if (FParentNode is TIpHtmlNodeGenInline) then
result := TIpHtmlNodeGenInline(FparentNode).Props.FontSize
else
result := CurrentFontSize;
end;
var var
P: Integer; P: double;
ParentFSize: Integer;
begin begin
result := CurrentFontSize; result := CurrentFontSize;
// check pt // check pt
P := Pos('pt',aFontSize); P:=GetFSize('pt');
if p>0 then if P>0 then begin
begin result := round(P);
p := StrToIntDef(copy(aFontSize,1,P-1), -1); exit;
if P>0 then end;
begin
result := P; //todo: em, ex are supposed to be based on the computed pixel size of
exit; // parent node, tpipro has no provision for this....
end;
// check %
P:=GetFSize('%');
if P>0 then begin
result := round(GetParentFontSize * P/100);
exit;
end;
// check em
P:=GetFSize('em');
if P>0 then begin
result := round(GetParentFontSize * P);
end; end;
end; end;

View File

@ -2777,7 +2777,7 @@ begin
Reg.Free; Reg.Free;
end; end;
end; end;
DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result); //DebugLn('IpUtils.GetLocalContent File:'+TheFileName+' Result:'+result);
end; end;
{$ELSE} {$ELSE}