styleun.pas

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

ExSize := EmSize div 2; {apparently correlates with what browsers are doing}
end;

{----------------TProperties.Update}
procedure TProperties.Update(Source: TProperties; Styles: TStyleList; I: integer);
{Change the inherited properties for this item to those of Source}
var
  Index: PropIndices;
begin
for Index := Low(Index) to High(Index) do
  if not Originals[Index] then
    Props[Index] := Source.Props[Index];
TheFont.Free;   {may no longer be good}  
TheFont := Nil;
if Assigned(FIArray) then
  if Source.Inlink then
    FIArray.Assign(Source.FIArray)
  else if PropPseudo = 'link' then   {an <a href> tag}
    CalcLinkFontInfo(Styles, I)
  else
    begin  {an <a href> tag has been removed}
    FIArray.Free;
    FIArray := Nil;
    Inlink := False;
    end;
end;

{----------------TProperties.Assign}
procedure TProperties.Assign(const Item: Variant; Index: PropIndices);
{Assignment should be made in order of importance as the first one in
 predominates}
var
  I: FIIndex;
begin
if not Originals[Index] then
  begin
  Props[Index] := Item;
  Originals[Index] := True;
  if InLink then
    case Index of
      Color:
        for I := LFont to HVFont do
          FIArray.Ar[I].iColor := Item;
      FontSize:
        for I := LFont to HVFont do
          FIArray.Ar[I].iSize := Item;
      FontFamily:
        for I := LFont to HVFont do
          FIArray.Ar[I].iName := Item;
    end;
  end;
end;

function TProperties.GetBackgroundImage(var Image: string): boolean;
begin
if (VarType(Props[BackgroundImage]) = VarString) then
  if (Props[BackgroundImage] = 'none') then
    begin
    Image := '';
    Result := True;
    end
  else
    begin
    Image := ReadUrl(Props[BackgroundImage]);
    Result := Image <> '';
    end
else Result := False;
end;

procedure TProperties.AssignCharSet(CS: TFontCharset);
const
  {EastEurope8859_2 = 31; }
  SetValues: array[1..20] of integer =
    (ANSI_CHARSET, DEFAULT_CHARSET, SYMBOL_CHARSET, MAC_CHARSET, SHIFTJIS_CHARSET,
     HANGEUL_CHARSET, JOHAB_CHARSET, GB2312_CHARSET, CHINESEBIG5_CHARSET,
     GREEK_CHARSET, TURKISH_CHARSET, VIETNAMESE_CHARSET, HEBREW_CHARSET,
     ARABIC_CHARSET, BALTIC_CHARSET, RUSSIAN_CHARSET, THAI_CHARSET,
     EASTEUROPE_CHARSET, OEM_CHARSET, EastEurope8859_2);
 { SetValues: array[1..19] of integer =
    (0, 1, 2, 77, 128, 129, 130, 134, 136, 161, 162, 163, 177, 178,
     186, 204, 222, 238, 255); }
  CodePages: array[1..20] of integer =
    (1252, CP_ACP, 0, CP_MACCP, 932, 949, 1361, 936, 950, 1253, 1254, 1258, 1255, 1256, 1257, 1251,
     874, 1250, CP_OEMCP, 28592);    {28592 for 8859-2, east european}
var
  I: integer;
  Save: THandle;
  tm : TTextmetric;
  DC: HDC;
  Font: TFont;
  IX: FIIndex;
begin
if CS = EastEurope8859_2 then
  begin
  CharSet := EASTEUROPE_CHARSET;
  CodePage := 28592;
  if Assigned(FIArray) then
    for IX := LFont to HVFont do
      FIArray.Ar[IX].iCharset := CharSet;
  Exit;
  end;
{the following makes sure the CharSet is available.  It also translates
 "Default_CharSet" into the actual local character set}
Font := TFont.Create;
Font.Name := 'Arial';   
Font.CharSet := CS;
DC := GetDC(0);
try
  Save := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, tm);
  if CS <> Default_Charset then    {leave default as is}
    CharSet := tm.tmCharSet
  else CharSet := Default_CharSet;
  if Assigned(FIArray) then
    for IX := LFont to HVFont do
      FIArray.Ar[IX].iCharset := CharSet;
  SelectObject(DC, Save);
Finally
  ReleaseDC(0, DC);
  Font.Free;
  end;

for I := 1 to 19 do
  if SetValues[I] = tm.tmCharSet then    
    begin
    CodePage := CodePages[I];
    break;
    end;
end;

procedure TProperties.AssignUTF8;
{Called by DoMeta in Readhtml.pas to make the properties using UTF-8 for conversions.}
begin
CodePage := CP_UTF8;
Charset := ANSI_CHARSET;
end;

{----------------TProperties.GetBackgroundPos}
procedure TProperties.GetBackgroundPos(EmSize, ExSize: integer; var P: PtPositionRec);
var
  S: array[1..2] of string;
  Tmp: string;
  I, N, XY: integer;
begin
if (VarType(Props[BackgroundPosition]) <> VarString) then
  begin
  P[1].PosType := pDim;
  P[1].Value := 0;
  P[2] := P[1];
  end
else
  begin
  Tmp := Trim(Props[BackgroundPosition]);
  N := Pos(' ', Tmp);
  if N > 0 then
    begin
    S[1] := System.Copy(Tmp, 1, N-1);
    S[2] := Trim(system.Copy(Tmp, N+1, 255));
    N := 2;
    end
  else
    begin
    S[1] := Tmp;
    N := 1;
    end;
  I := 1;
  XY := 1;  {X}
  while I <= N do
    begin
    P[XY].PosType := pDim;
    if S[I] = 'center' then
      P[XY].PosType := pCenter
    else if Pos('%', S[I]) > 0 then
      P[XY].PosType := pPercent
    else if S[I] = 'left' then
      begin
      if XY = 2 then  {entered in reverse direction}
        P[2] := P[1];
      P[1].PosType := pLeft;
      end
    else if S[I] = 'right' then
      begin
      if XY = 2 then
        P[2] := P[1];
      P[1].PosType := pRight;
      end
    else if S[I] = 'top' then
      begin
      P[2].PosType := pTop;
      if XY = 1 then
        Dec(XY);   {read next one into X}
      end
    else if S[I] = 'bottom' then
      begin
      P[2].PosType := pBottom;
      if XY = 1 then
        Dec(XY);
      end;
    if P[XY].PosType in [pDim, pPercent] then
      begin
      P[XY].Value := LengthConv(S[I], False, 100, EmSize, ExSize, 0);
      end;
    Inc(I);
    Inc(XY);
    end;
  if N = 1 then
    if XY = 2 then
      P[2].PosType := pCenter
    else P[1].PosType := pCenter; {single entry but it was a Y}
  end;
P[1].RepeatD := True;
P[2].RepeatD := True;
if (VarType(Props[BackgroundRepeat]) = VarString) then
  begin
  Tmp := Trim(Props[BackgroundRepeat]);
  if Tmp = 'no-repeat' then
    begin
    P[1].RepeatD := False;
    P[2].RepeatD := False;
    end
  else if Tmp = 'repeat-x' then
    P[2].RepeatD := False
  else if Tmp = 'repeat-y' then
    P[1].RepeatD := False;
  end;
P[1].Fixed := False;
if (VarType(Props[BackgroundAttachment]) = VarString) and
       (Trim(Props[BackgroundAttachment]) = 'fixed') then
  P[1].Fixed := True;
P[2].Fixed := P[1].Fixed;
end;

function TProperties.GetVertAlign(var Align: AlignmentType): boolean;
{note:  'top' should have a catagory of its own}
var
  S: string;
begin
if (VarType(Props[VerticalAlign]) = VarString) then
  begin
  Result := True;
  S := Props[VerticalAlign];
  if (S = 'top') or (S = 'text-top') then Align := ATop
  else if S = 'middle' then Align := AMiddle
  else if S = 'baseline' then Align := ABaseline
  else if (S = 'bottom') then Align := ABottom
  else if (S = 'sub') then Align := ASub
  else if (S = 'super') then Align := ASuper
  else Result := False;
  end
else Result := False;
end;

function TProperties.IsOverflowHidden: boolean;   
begin
Result := (VarType(Props[OverFlow]) = VarString) and (Props[OverFlow] = 'hidden');
end;

function TProperties.GetFloat(var Align: AlignmentType): boolean;
var
  S: string;
begin
if (VarType(Props[Float]) = VarString) then
  begin
  Result := True;
  S := Props[Float];
  if (S = 'left') then Align := ALeft
  else if S = 'right' then Align := ARight
  else if S = 'none' then Align := ANone
  else Result := False;
  end
else Result := False;
end;

function TProperties.GetClear(var Clr: ClearAttrType): boolean;
var
  S: string;
begin
if (VarType(Props[Clear]) = VarString) then
  begin
  Result := True;
  S := Props[Clear];
  if (S = 'left') then Clr := clLeft
  else if S = 'right' then Clr := clRight
  else if S = 'both' then Clr := clAll
  else if S = 'none' then Clr := clrNone
  else Result := False;
  end
else Result := False;
end;

function TProperties.GetListStyleType: ListBulletType;
const
  S: array[Low(ListBulletType)..High(ListBulletType)] of string =
    ('blank', 'circle', 'decimal', 'disc', 'lower-alpha', 'lower-roman',
                 'none', 'square', 'upper-alpha', 'upper-roman');
var
  I: ListBulletType;

begin
if VarType(Props[ListStyleType]) = VarString then
  for I := Low(ListBulletType) to High(ListBulletType) do
    if S[I] = Props[ListStyleType] then
      begin
      Result := I;
      Exit;
      end;
Result := lbBlank;
end;

function TProperties.GetListStyleImage: string;
begin
Result := ReadURL(Props[ListStyleImage])
end;

function TProperties.GetPosition: PositionType;
begin
Result := posStatic;
if VarType(Props[Position]) = VarString then
  begin
  if Props[Position] = 'absolute' then
    Result := posAbsolute
  else if Props[Position] = 'relative' then
    Result := posRelative;
  end;
end;

function TProperties.GetVisibility: VisibilityType;
begin
Result := viVisible;
if VarType(Props[Visibility]) in varInt then
  if Props[Visibility] = viHidden then
    Result := viHidden;
end;

function TProperties.GetZIndex: integer;
begin
Result := 0;
if VarType(Props[ZIndex]) in VarInt then    
  Result := Props[ZIndex]
else if VarType(Props[ZIndex]) = VarString then
  Result := StrToIntDef(Props[ZIndex], 0);
end;

function TProperties.DisplayNone: boolean;
begin
Result := (VarType(Props[Display]) = VarString) and (Props[Display] = 'none');
end;

function TProperties.Collapse: boolean;  
begin
Result := (VarType(Props[BorderCollapse]) = VarString) and (Props[BorderCollapse] = 'collapse');
end;

function TProperties.GetLineHeight(NewHeight:integer): integer;
var
  V: double;
  Code: integer;
begin
if VarType(Props[LineHeight]) = varString then
  begin
  Val(Props[LineHeight], V, Code);
  if Code = 0 then   {a numerical entry with no 'em', '%', etc.  Use the new font height}
    Result := Round(V*NewHeight)
  else
    {note: 'normal' yields -1 in the next statement}
    Result := LengthConv(Props[LineHeight], True, EmSize, EmSize, ExSize, -1);   
  end
else Result := -1;     
end;

function TProperties.GetTextIndent(var PC: boolean): integer;
var
  I: integer;
begin
PC := False;
if VarType(Props[TextIndent]) = varString then
  begin
  I := Pos('%', Props[TextIndent]);
  if I > 0 then
    begin
    PC := True;  {return value in percent}
    Result := LengthConv(Props[TextIndent], True, 100, 0, 0, 0);
    end
  else
    Result := LengthConv(Props[TextIndent], False, 0, EmSize, EmSize, 0);
  end
else Result := 0;
end;

function TProperties.GetTextTransform: TextTransformType;
begin
try
  if VarType(Props[TextTransform]) in VarInt then
    Result := Props[TextTransform]
  else Result := txNone;
except
  Result := txNone;
  end;
end;

function TProperties.GetFontVariant: string;    
begin
try
  if VarType(Props[FontVariant]) = varString then
    Result := Props[FontVariant]
  else Result := 'normal';
except
  Result := 'normal';
  end;
end;

procedure TProperties.GetPageBreaks(var Before, After, Intact: boolean);
begin
Before := (VarType(Props[PageBreakBefore]) = varString) and  (Props[PageBreakBefore] = 'always');
After := (VarType(Props[PageBreakAfter]) = varString) and  (Props[PageBreakAfter] = 'always');
Intact := (VarType(Props[PageBreakInside]) = varString) and  (Props[PageBreakInside] = 'avoid');
end;

function TProperties.GetBackgroundColor: TColor;
begin
if (VarType(Props[BackgroundColor]) in varInt) and Originals[BackgroundColor] then
      {Originals to prevent fonts from getting inherited background color}
  Result := Props[BackgroundColor]
else Result := clNone;
end;

function TProperties.GetOriginalForegroundColor: TColor;
begin {return a color only if it hasn't been inherited}
if (VarType(Props[Color]) in varInt) and Originals[Color] then
  Result := Props[Color]
else Result := clNone;
end;

function BorderStyleFromString(const S: string): BorderStyleType;
const
  Ar: array[1..9] of string = ('none', 'solid', 'inset', 'outset','groove', 'ridge',
                              'dashed', 'dotted', 'double');
  Ar1: array[1..9] of BorderStyleType = (bssNone, bssSolid, bssInset, bssOutset, bssGroove, bssRidge,
                     bssDashed, bssDotted, bssDouble);
var