styleun.pas

来自「查看html文件的控件」· PAS 代码 · 共 2,197 行 · 第 1/5 页

  I: integer;
begin
Result := bssNone;
for I := 1 to 9 do
  if S = Ar[I] then
    begin
    Result := Ar1[I];
    break;
    end;
end;

function TProperties.GetBorderStyle: BorderStyleType;
begin
Result := bssNone;
if VarType(Props[BorderStyle]) = VarString then
  Result := BorderStyleFromString(Props[BorderStyle]);
end;

function TProperties.BorderStyleNotBlank: boolean;
{was a border of some type (including bssNone) requested?}
begin
Result := VarType(Props[BorderStyle]) = VarString;
end;

procedure TProperties.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;

procedure ConvVertMargins(const VM: TVMarginArray;
     BaseHeight, EmSize, ExSize: Integer;
     var M: TMarginArray; var TopAuto, BottomAuto: boolean);

  function Convert(V: Variant; var IsAutoParagraph: boolean): integer;
  begin
  IsAutoParagraph := False;
  if VarType(V) = VarString then
    Result := LengthConv(V, False, BaseHeight, EmSize, ExSize, 0) {Auto will be 0}
  else if VarType(V) in varInt then
    begin
    if V = IntNull then
      Result := 0
    else if V = AutoParagraph then
      begin
      Result := ParagraphSpace;
      IsAutoParagraph := True;
      end
    else Result := V;
    end
  else Result := 0;
  end;

begin
M[MarginTop] := Convert(VM[MarginTop], TopAuto);
M[MarginBottom] := Convert(VM[MarginBottom], BottomAuto);
end;

{----------------ConvMargArray}
procedure ConvMargArray(const VM: TVMarginArray; BaseWidth, BaseHeight, EmSize,
     ExSize: Integer; BStyle: BorderStyleType; var AutoCount: integer;
     var M: TMarginArray);
{This routine does not do MarginTop and MarginBottom as they are done by ConvVertMargins}
var
  I: PropIndices;
  Base: integer;
begin
AutoCount := 0;  {count of 'auto's in width items}
for I := Low(VM) to High(VM) do
  begin
  case I of
    Height:
      Base := BaseHeight
    else Base := BaseWidth;
    end;
  case I of
    BackgroundColor, BorderColor:
      begin
      if VarType(VM[I]) <= VarNull then
        M[I] := clNone
      else M[I] := VM[I];
      end;
    BorderTopWidth..BorderLeftWidth:
      begin
      if VM[PropIndices(Ord(BorderTopStyle) + (Ord(I)-Ord(BorderTopWidth)))] = bssNone then
        M[I] := 0
      else
        begin
        if VarType(VM[I]) = VarString 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, 4); {Auto will be 4}
          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;
    Height, PaddingTop..PaddingLeft:
      begin
      if VarType(VM[I]) = VarString then
        begin
        M[I] := LengthConv(VM[I], False, Base, EmSize, ExSize, 0); {Auto will be 0}
        if (I = Height) and (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;
    TopPos, LeftPos:
      begin
      if VarType(VM[I]) = VarString 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] := Auto
        else M[I] := VM[I];
        end
      else M[I] := Auto;
      end;
    MarginLeft, MarginRight:
      begin
      if VarType(VM[I]) = VarString 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;
    Width:
      begin
      if VarType(VM[I]) = VarString 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;
    MarginTop, MarginBottom:  ;   {do nothing}
    else
      begin
      if VarType(VM[I]) = VarString then
        M[I] := LengthConv(VM[I], False, BaseWidth, 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 ConvMargArrayForCellPadding(const VM: TVMarginArray; EmSize,
             ExSize: Integer; var M: TMarginArray);
{Return negative for no entry or percent entry}
var
  I: PropIndices;
begin
for I := PaddingTop to PaddingLeft do
  if VarType(VM[I]) = VarString 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: TVMarginArray; BaseWidth, BaseHeight, EmSize,
     ExSize: Integer; {BStyle: BorderStyleType;} var M: TMarginArray);
{currently for images, form controls.  BaseWidth/Height and BStyle currently not supported}
var
  I: PropIndices;
begin
for I := Low(VM) to High(VM) do
  case I of
    Height, Width:
      begin
      if VarType(VM[I]) = VarString 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;
    MarginLeft, MarginRight, MarginTop, MarginBottom:
      begin
      if VarType(VM[I]) = VarString 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[PropIndices(Ord(BorderTopStyle) + (Ord(I)-Ord(BorderTopWidth)))] = bssNone then
        M[I] := 0
      else
        begin
        if VarType(VM[I]) = VarString 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, 4); {Auto will be 4}
          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;

{----------------TProperties.Combine}
procedure TProperties.Combine(Styles: TStyleList;
        const Tag, AClass, AnID, PSeudo, ATitle: string; AProp: TProperties);  
{When called, this TProperties contains the inherited properties.  Here we
 add the ones relevant to this item. AProp are TProperties gleaned from the
 Style= attribute. AClass may be a multiple class like class="ab.cd"}
 var
   BClass, S: string;
   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;
PropTag := Tag;
PropClass := AClass;
PropID := AnID;
PropPseudo := Pseudo;
PropStyle := AProp;
if ATitle <> '' then
  PropTitle := ATitle;
if PSeudo = 'link' then
  begin
  if not Assigned(FIArray) then
    FIArray := TFontInfoArray.Create;
  CalcLinkFontInfo(Styles, PropStack.Count-1);
  InLink := True;
  end;
 end;

 {----------------TProperties.CombineX}
procedure TProperties.CombineX(Styles: TStyleList;
        const Tag, AClass, AnID, PSeudo, ATitle: string; AProp: TProperties);
{When called, this TProperties contains the inherited properties.  Here we
 add the ones relevant to this item. AProp are TProperties gleaned from the
 Style= attribute.}
var
  OldSize: double;
  IX: integer;
  NoHoverVisited: boolean;

  procedure Merge(Source: TProperties);
  var
    Index: PropIndices;
    I: FIIndex;
    Wt: integer;
    S1: string;
  begin
  for Index := Low(Index) to High(PropIndices) do
      if (VarType(Source.Props[Index]) <> varEmpty) and (Vartype(Source.Props[Index]) <> varNull) then
        case Index of
          MarginTop..LeftPos:
            if VarType(Source.Props[Index]) = VarString then
              begin
              Props[Index] := Source.Props[Index];
              Originals[Index] := True;
              end
            else if Source.Props[Index] <> IntNull then
              begin
              Props[Index] := Source.Props[Index];
              Originals[Index] := True;
              end;
          FontFamily, FontSize, FontStyle, FontWeight, Color, BackgroundColor,
                      TextDecoration, LetterSpacing:      
            begin
            Originals[Index] := True;
            Props[Index] := Source.Props[Index];
            if InLink then
              for I := LFont to HVFont do
                with FIArray.Ar[I] do
                  case Index of
                    FontFamily:
                      begin
                      S1 := ReadFontName(Props[FontFamily]);
                      if S1 <> '' then
                        iName := S1;
                      end;
                    FontSize:
                      iSize := FontSizeConv(Props[FontSize], iSize);
                    Color: iColor := Props[Color];
                    BackgroundColor: ibgColor := Props[BackgroundColor];
                    FontStyle:
                      if (Props[FontStyle] = 'italic') or (Props[FontStyle] = 'oblique') then
                        iStyle := iStyle + [fsItalic]
                      else if Props[FontStyle] = 'normal' then
                        iStyle := iStyle - [fsItalic];
                    FontWeight:
                      if Pos('bold', Props[FontWeight]) > 0 then
                        iStyle := iStyle + [fsBold]
                      else if Pos('normal', Props[FontWeight]) > 0 then
                        iStyle := iStyle - [fsBold]
                      else
                        begin
                        Wt := StrToIntDef(Props[FontWeight], 0);
                        if Wt >= 600 then
                          iStyle := iStyle + [fsBold];
                        end;
                    TextDecoration:
                      if Props[TextDecoration] = 'underline' then
                        iStyle := iStyle + [fsUnderline]
                      else if Props[TextDecoration] = 'line-through' then
                        iStyle := iStyle + [fsStrikeOut]
                      else if Props[TextDecoration] = 'none' then
                        iStyle := iStyle - [fsStrikeOut, fsUnderline];
                    LetterSpacing:
                      iCharExtra := Props[LetterSpacing];   
                  end;
            end
        else
          begin
          Props[Index] := Source.Props[Index];
          Originals[Index] := True;   {it's defined for this item, not inherited}
          end;
        end;
  end;

  function CheckForContextual(I: integer): boolean;
  {process contextual selectors}
  var
    J, K, N: integer;
    A: array[1..10] of record
         Tg, Cl, ID, PS: string;
         end;

    procedure Split(S: string);
    var
      I, J: integer;
    begin
    N := 1;   {N is number of selectors in contextual string}
    I := Pos(' ', S);
    while (I > 0) and (N < 10) 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) and (Length(A[2].Tg) > 0) then
      repeat
        Delete(A[2].Tg, 1, 1);   {remove the sort digit}
      until (length(A[2].Tg)=0) or not (A[2].Tg[1] in ['0'..'9']);  
    for I := 1 to N do
      begin
      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