styleun.pas

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

        begin
        A[I].Cl := System.Copy(A[I].Tg, J+1, Length(A[I].Tg));
        A[I].Tg := System.Copy(A[I].Tg, 1, J-1);
        end
      else A[I].Cl := '';
      end;
    end;

  begin
  Result := False;
  Split(Styles[I]); //split contextual selectors into parts in array A
  if (A[1].Tg <> Tag) and (A[1].Cl <> AClass) and (A[1].PS <> PSeudo) then 
    Exit
  else Result := True;
  if (N > 1)   //it's a contextual selector.  N is count of selectors
        and ((A[1].Tg = Tag) or (A[1].Tg = ''))
        and ((A[1].Cl = AClass) or (A[1].Cl = ''))
        and ((A[1].ID = AnID) or (A[1].ID = ''))
        and ((A[1].PS = PSeudo) or (A[1].PS = '')) then
    begin //look thru the stack to see if this contextual selector is appropriate
    K := 2;   //K is selector index in the sequence
    J := PropStack.Count-2;  // start on stack item below this one
    while (K <= N) and (J >= 1) do
      begin
      with PropStack[J] do
        if ((A[K].Tg = PropTag) or (A[K].Tg = '')) and ((A[K].Cl = PropClass) or (A[K].Cl = ''))
              and ((A[K].ID = PropID) or (A[K].ID = ''))
              and ((A[K].PS = PropPseudo) or (A[K].PS = '')) then
          begin
          if K = N then  //all parts of contextual selector match
            Merge(Styles.Objects[I] as TProperties);
          Inc(K);
          end;
      Dec(J);
      end;
    end
  end;

  procedure MergeItems(Const Item: string);
  {look up items in the Style list.  If found, merge them in this TProperties.
   Items may be duplicated in which case the last has priority.  Items may be
   simple tags like 'p', 'blockquote', 'em', etc or they may be more complex
   like  p.class, em#id, a.class:link, etc}
  var
    X: integer;
  begin
  if Styles.Find(Item, X) then
    begin
    Merge(Styles.Objects[X] as TProperties);
    Inc(X);
    while (X < Styles.Count) and (Styles[X] = Item) do
      begin  //duplicates, last one has highest priority
      Merge(Styles.Objects[X] as TProperties);
      Inc(X);
      end;
    end;
  end;

begin
{$ifdef Quirk}
if (Tag = 'td') or (Tag = 'th') then   
  OldSize := DefPointSize else
{$endif}
if (VarType(Props[FontSize]) = VarDouble) and (Props[FontSize] > 0.0) then    {should be true}
  OldSize := Props[FontSize]
else OldSize := DefPointSize;

{Some hover and visited items adequately taken care of when link processed}
NoHoverVisited := (Pseudo = '') or ((Pseudo <> 'hover') and (Pseudo <> 'visited'));

// in the following, lowest priority on top, highest towards bottom.

if (Tag = 'a') and (Pseudo <> '') then
  MergeItems('::'+Pseudo); {default Pseudo definition}

if NoHoverVisited then
  MergeItems(Tag);

if Pseudo <> '' then
  MergeItems(':'+Pseudo);

if (AClass <> '') and NoHoverVisited then
  MergeItems('.'+AClass);

if (AClass <> '') and NoHoverVisited then
  MergeItems(Tag+'.'+AClass);

if Pseudo <> '' then
  MergeItems(Tag+':'+Pseudo);

if (AClass <> '') and (PSeudo <> '') then
    MergeItems('.'+AClass+':'+Pseudo);

if (AClass <> '') and (Pseudo <> '') then
  MergeItems(Tag+'.'+AClass+':'+Pseudo);

if AnID <> '' then
  begin
  MergeItems('#'+AnID);
  MergeItems(Tag+'#'+AnID);
  if (AClass <> '') then
    MergeItems('.'+AClass+'#'+AnID);
  if (Pseudo <> '') then
    begin
    MergeItems('#'+AnID+':'+Pseudo);
    MergeItems(Tag+'#'+AnID+':'+Pseudo);
    end;
  if (AClass <> '') then
    MergeItems(Tag+'.'+AClass+'#'+AnID);
  MergeItems('.'+AClass+'#'+AnID+':'+Pseudo);
  MergeItems(Tag+'.'+AClass+'#'+AnID+':'+Pseudo);
  end;

{process the entries in Styles to see if they are contextual selectors}
Styles.Find(Tag, IX);    //place to start
while (IX < Styles.Count) and (Pos(Tag, Styles[IX]) = 1) and CheckForContextual(IX) do
  Inc(IX);

Styles.Find('.'+AClass, IX);    //place to start
while (IX < Styles.Count) and (Pos('.'+AClass, Styles[IX]) = 1) and CheckForContextual(IX) do
  Inc(IX);

Styles.Find(':'+PSeudo, IX);    //place to start           
while (IX < Styles.Count) and (Pos(':'+PSeudo, Styles[IX]) = 1) and CheckForContextual(IX) do
  Inc(IX);

If Assigned(AProp) then   //the Style= attribute
  Merge(AProp);

if not ((VarType(Props[FontSize]) = VarDouble) or
      (VarType(Props[FontSize]) in varInt)) then  {if still a string, hasn't been converted}
  Props[FontSize] := FontSizeConv(Props[FontSize], OldSize);
end;

function TProperties.GetFont: TMyFont;
var
  Font: ThtFontInfo;
  Save: THandle;
  SaveCharSet: TFontCharSet;
  tm : TTextmetric;
  DC: HDC;
  V: Variant;
begin      {call only if all things valid}
if not Assigned(TheFont) then
  begin
  Font := ThtFontInfo.Create;
  try
    GetSingleFontInfo(Font);
    TheFont := TMyFont.Create;
    with TheFont, Font do
      begin
      Name := iName;
      Height := -Round(iSize * Screen.PixelsPerInch / 72);   
      Style := iStyle;
      bgColor := ibgColor;
      Color := iColor;
      Charset := iCharSet;
      V := iCharExtra;
      end;
  finally
    Font.Free;
    end;
  {if this is a Symbol charset, then keep it that way.  To check the font's real
   charset, use Default_Charset} 
  SaveCharSet := TheFont.CharSet;
  TheFont.CharSet := Default_Charset;
  DC := GetDC(0);
  try
    Save := SelectObject(DC, TheFont.Handle);
    try
      GetTextMetrics(DC, tm);
    finally
      SelectObject(DC, Save);
      end;
    if tm.tmCharset = Symbol_Charset then
      TheFont.Charset := Symbol_CharSet
    else
      TheFont.Charset := SaveCharSet;
    {now get the info on the finalized font}
    if TheFont.Charset <> Default_Charset then  {else already have the textmetrics}
      begin
      Save := SelectObject(DC, TheFont.Handle);
      try
        GetTextMetrics(DC, tm);
      finally
        SelectObject(DC, Save);
        end;
      end;
  finally
    ReleaseDC(0, DC);
    end;
  {calculate EmSize with current font rather than inherited}
  EmSize := tm.tmHeight-tm.tmInternalLeading;
  ExSize := EmSize div 2; {apparently correlates with what browsers are doing}
  TheFont.tmHeight := tm.tmHeight;  
  TheFont.tmDescent := tm.tmDescent;
  TheFont.tmExternalLeading := tm.tmExternalLeading;
  TheFont.tmMaxCharWidth := tm.tmMaxCharWidth;
  TheFont.tmAveCharWidth := tm.tmAveCharWidth;
  TheFont.tmCharset := tm.tmCharset;
  if VarType(V) in VarInt then
    TheFont.CharExtra := V
  else if VarType(V) = VarString then
    if V = 'normal' then
      TheFont.CharExtra := 0
    else TheFont.CharExtra := LengthConv(V, False, EmSize, EmSize, ExSize, 0)
  else TheFont.CharExtra := 0;
  end;
Result := TMyFont.Create;
Result.Assign(TheFont);
end; 

{----------------ReadFontName}
function ReadFontName(S: string): string;
var
  S1: string;
  Done: boolean;

  function NextFontName: string;
  const
    Generic1: array[1..4] of string = ('serif', 'monospace', 'sans-serif', 'cursive');
    Generic2: array[1..4] of string = ('Times New Roman', 'Courier New', 'Arial', 'Lucida Handwriting');
  var
    I: integer;
  begin
  I := Pos(',', S);        {read up to the comma}
  if I > 0 then
    begin
    Result := Trim(System.Copy(S, 1, I-1));
    Delete(S, 1, I);
    end
  else
    begin   {last item}
    Result := Trim(S);
    S := '';
    end;
  for I := 1 to 4 do
    if CompareText(Result, Generic1[I]) = 0 then
      begin
      Result :=  Generic2[I];
      break;
      end;
  if (Result <> '') and (Result[Length(Result)] in ['"', '''']) then
    SetLength(Result, Length(Result)-1);
  if (Result <> '') and (Result[1] in ['"', '''']) then
    Delete(Result, 1, 1);
  end;

begin
Done := False;
S1 := NextFontName;
while (S1 <> '') and not Done do
  begin
  Done := Screen.Fonts.IndexOf(S1) >= 0;
  if Done then
    Result := S1
  else S1 := NextFontName;
  end;
end;

{----------------TProperties.GetSingleFontInfo}
procedure TProperties.GetSingleFontInfo(var Font: ThtFontInfo);  
var
  S, S1: string;
  Done: boolean;
  Wt: integer;
  Style: TFontStyles;

  function NextFontName: string;
  const
    Generic1: array[1..4] of string = ('serif', 'monospace', 'sans-serif', 'cursive');
    Generic2: array[1..4] of string = ('Times New Roman', 'Courier New', 'Arial', 'Lucida Handwriting');
  var
    I: integer;
  begin
  I := Pos(',', S);        {read up to the comma}
  if I > 0 then
    begin
    Result := Trim(System.Copy(S, 1, I-1));
    Delete(S, 1, I);
    end
  else
    begin   {last item}
    Result := Trim(S);
    S := '';
    end;
  for I := 1 to 4 do
    if CompareText(Result, Generic1[I]) = 0 then
      begin
      Result :=  Generic2[I];
      break;
      end;
  if (Result <> '') and (Result[Length(Result)] in ['"', '''']) then
    SetLength(Result, Length(Result)-1);
  if (Result <> '') and (Result[1] in ['"', '''']) then
    Delete(Result, 1, 1);
  end;

begin      {call only if all things valid}
Font.ibgColor := FontBG;
Font.iColor := Props[Color];
Style := [];
if Pos('bold', Props[FontWeight]) > 0 then
  Style := [fsBold]
else
  begin
  Wt := StrToIntDef(Props[FontWeight], 0);
  if Wt >= 600 then
    Style := [fsBold];
  end;
if (Props[FontStyle] = 'italic') or (Props[FontStyle] = 'oblique') then
  Style := Style + [fsItalic];
if Props[TextDecoration] = 'underline' then
  Style := Style + [fsUnderline]
else if Props[TextDecoration] = 'line-through' then
  Style := Style + [fsStrikeOut];
Font.iStyle := Style;
Font.iSize := Props[FontSize];
Font.iCharset := CharSet;
Font.iCharExtra := Props[LetterSpacing];  

Done := False;
S := Props[FontFamily];
S1 := NextFontName;
while (S1 <> '') and not Done do
  begin
  Done := Screen.Fonts.IndexOf(S1) >= 0;
  if Done then
    begin
    Font.iName := S1;
    end
  else S1 := NextFontName;
  end;
if Font.iName = '' then        
  Font.iName := DefFontname;  
end;

procedure TProperties.CalcLinkFontInfo(Styles: TStyleList; I: integer);
{I is index in PropStack for this item}    
  procedure InsertNewProp(N: integer; const Pseudo: string);
  begin
  PropStack.Insert(N, TProperties.Create);
  PropStack[N].Inherit('', PropStack[N-1]);   
  PropStack[N].Combine(Styles, PropTag, PropClass, PropID, Pseudo, PropTitle, PropStyle);
  end;

begin
PropStack[I].SetFontBG;    
GetSingleFontInfo(FIArray.Ar[LFont]);
InsertNewProp(I+1, 'visited');
PropStack[I+1].SetFontBG;
PropStack[I+1].GetSingleFontInfo(FIArray.Ar[VFont]);
InsertNewProp(I+2, 'hover');
PropStack[I+2].SetFontBG;
PropStack[I+2].GetSingleFontInfo(FIArray.Ar[HVFont]);
PropStack.Delete(I+2);
PropStack.Delete(I+1);
InsertNewProp(I+1, 'hover');
PropStack[I+1].SetFontBG;
PropStack[I+1].GetSingleFontInfo(FIArray.Ar[HLFont]);
PropStack.Delete(I+1);
end;

procedure TProperties.GetFontInfo(AFI: TFontInfoArray);
begin
AFI.Assign(FIArray);
end;

procedure TProperties.GetVMarginArray(var MArray: TVMarginArray);
var
  I: PropIndices;
begin
for I := Low(Marray) to High(MArray) do
  case I of
    BorderTopStyle..BorderLeftStyle:
      if VarType(Props[I]) = VarString then
        MArray[I] := BorderStyleFromString(Props[I])
      else MArray[I] := bssNone;
    else
      MArray[I] := Props[I];
    end;
end;

procedure TProperties.AddPropertyByIndex(Index: PropIndices; PropValue: string);
var
  NewColor: TColor;
begin
case Index of
  BorderColor:
    if ColorFromString(PropValue, False, NewColor) then
      begin
      Props[BorderColor] := NewColor;
      Props[BorderLeftColor] := NewColor;
      Props[BorderTopColor] := NewColor;
      Props[BorderRightColor] := NewColor;
      Props[BorderBottomColor] := NewColor;
      end;
  BorderTopColor .. BorderLeftColor:
    if ColorFromString(PropValue, False, NewColor) then
      Props[Index] := NewColor;
  Color, BackgroundColor:
    if ColorFromString(PropValue, False, NewColor) then
      Props[Index] := NewColor
    else if Index = Color then
      Props[Index] := clBlack
    else Props[Index] := clNone;
  MarginTop..BorderLeftWidth, Width..LeftPos:
    Props[Index] := PropValue;
  FontSize:
    Props[FontSize] := PropValue;
  Visibility:
    begin
    if PropValue = 'visible' then
      Props[Visibility] := viVisible
    else if PropValue = 'hidden' then
      Props[Visibility] := viHidden;
    end;
  TextTransform:
    begin
    if PropValue = 'uppercase' then
      Props[TextTransform] := txUpper
    else if PropValue = 'lowercase' then
      Props[TextTransform] := txLower
    else Props[TextTransform] := txNone;
    end;
  WordWrap:                           
    if PropValue = 'break-word' then
      Props[WordWrap] := PropValue
    else Props[WordWrap] := 'normal';
  FontVariant:
    if PropValue = 'small-caps' then
      Props[FontVariant] := PropValue
    else if PropValue = 'normal' then
      Props[FontVariant] := 'normal';
  BorderTopStyle..BorderLeftStyle:
    begin
    if PropValue <> 'none' then      
      Props[BorderStyle] := PropValue;
    Props[Index] := PropValue;
    end;