htmlsubs.pas

查看html文件的控件

    Color := iColor;
    CharSet:= ICharSet;
    FontChanged;
    end;
end;

constructor TFontObj.CreateCopy(ASection: TSection; T: TFontObj); 
begin
inherited Create;
Section := ASection;
Pos := T.Pos;
SScript := T.SScript;
TheFont := TMyFont.Create;
TheFont.Assign(T.TheFont);
if Assigned(T.FIArray) then
  ConvertFont(T.FIArray.Ar[LFont]);
UrlTarget := TUrlTarget.Create;
UrlTarget.Copy(T.UrlTarget);
FontChanged;
end;

destructor TFontObj.Destroy;
begin
FIArray.Free;
TheFont.Free;
UrlTarget.Free;
TabControl.Free;   
inherited Destroy;
end;

procedure TFontObj.SetVisited(Value: boolean);    
begin
if Value <> FVisited then
  begin
  FVisited := Value;
  if Value then
    if Hover then
      ConvertFont(FIArray.Ar[HVFont])
    else
      ConvertFont(FIArray.Ar[VFont])
  else
    if Hover then
      ConvertFont(FIArray.Ar[HLFont])
    else
      ConvertFont(FIArray.Ar[LFont]);
  FontChanged;
  end;
end;

procedure TFontObj.SetHover(Value: boolean);
begin
if Value <> FHover then
  begin
  FHover := Value;
  if Value then
    if FVisited then
      ConvertFont(FIArray.Ar[HVFont])
    else ConvertFont(FIArray.Ar[HLFont])
  else
    if FVisited then
      ConvertFont(FIArray.Ar[VFont])
    else ConvertFont(FIArray.Ar[LFont]);
  FontChanged;
  end;
end;

procedure TFontObj.SetAllHovers(List: TList; Value: boolean);
{Set/Reset Hover on this item and all adjacent item with the same URL}
var
  I, J: integer;
begin
SetHover(Value);
I := List.IndexOf(Self);
if I >= 0 then
  begin
  J := I+1;
  while (J < List.Count) and (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) do
    begin
    TFontObj(List[J]).Hover := Value;
    Inc(J);
    end;
  J := I-1;
  while (J >= 0) and (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) do
    begin
    TFontObj(List[J]).Hover := Value;
    Dec(J);
    end;
  end;
end;

function TFontObj.GetURL: string;
begin
try                            
  Result := UrlTarget.Url;
except
  Result := '';
  {$ifdef DebugIt}
  ShowMessage('Bad TFontObj, htmlsubs.pas, TFontObj.GetUrl');
  {$endif}
  end;
end;

procedure TFontObj.FontChanged;   
begin
tmHeight := TheFont.tmHeight;
tmMaxCharWidth := TheFont.tmMaxCharWidth;
FontHeight := TheFont.tmHeight + TheFont.tmExternalLeading;
Descent := TheFont.tmDescent;
if fsItalic in TheFont.Style then  {estimated overhang}
  Overhang := TheFont.tmheight div 10
else Overhang := 0;
TheFont.Charset := TheFont.tmCharset;
end;

function TFontObj.GetOverhang: integer;
begin
Result := Overhang;
end;

function TFontObj.GetHeight(var Desc: integer): integer;
begin
Desc := Descent;
Result := FontHeight;
end;

constructor TFontList.CreateCopy(ASection: TSection; T: TFontList);
var
  I: integer;
begin
inherited create;
for I := 0 to T.Count-1 do
  Add(TFontObj.CreateCopy(ASection, TFontObj(T.Items[I])));
end;

function TFontList.GetFontAt(Posn : integer;
                var OHang : integer) : TMyFont;
{given a character index, find the font that's effective there}
var
  I, PosX: integer;
  F : TFontObj;
begin
I := 0;
PosX := 0;
while (I < Count)  do
  begin
  PosX := TFontObj(Items[I]).Pos;
  Inc(I);
  if PosX >= Posn then Break;
  end;
Dec(I);
if PosX > Posn then Dec(I);
F := TFontObj(Items[I]);
OHang := F.Overhang;   
Result := F.TheFont;
end;

function TFontList.GetFontCountAt(Posn, Leng : integer) : integer;
{Given a position, return the number of chars before the font changes}
var
  I, PosX : integer;
begin
I := 0;
PosX := 0;
while I < Count do
  begin
  PosX := TFontObj(Items[I]).Pos;
  if PosX >= Posn then Break;
  Inc(I);
  end;
if PosX = Posn then Inc(I);
if I = Count then
  Result := Leng-Posn
else
  Result := TFontObj(Items[I]).Pos - Posn;
end;

{----------------TFontList.GetFontObjAt}
function TFontList.GetFontObjAt(Posn : integer;
                      var Index : integer) : TFontObj;
{Given a position, returns the FontObj which applies there and the index of
 the FontObj in the list}
var
  PosX: integer;
begin
Index := 0;
PosX := 0;
while (Index < Count)  do
  begin
  PosX := TFontObj(Items[Index]).Pos;
  Inc(Index);
  if PosX >= Posn then Break;
  end;
Dec(Index);
if PosX > Posn then Dec(Index);
Result := TFontObj(Items[Index]);
end;

{----------------TFontList.Decrement}
procedure TFontList.Decrement(N: integer; ParentSectionList: TSectionList);   
{called when a character is removed to change the Position figure}
var
  I, J: integer;
  FO, FO1: TFontObj;
begin
I := 0;
while I < Count do
  begin
  FO := TFontObj(Items[I]);
  if FO.Pos > N then
      Dec(FO.Pos);
  if (I > 0) and (TFontObj(Items[I-1]).Pos = FO.Pos) then
    begin
    FO1 := TFontObj(Items[I-1]);
    J := ParentSectionList.LinkList.IndexOf(FO1);
    if J >=0 then
      ParentSectionList.LinkList.Delete(J);
    FO1.Free;
    Delete(I-1);
    end
  else Inc(I);
  end;
end;

{----------------TImageObj.Create}
constructor TImageObj.Create(MasterList: TSectionList; Position: integer; L: TAttributeList);
var
  I: integer;
  S: string;
  NewSpace: integer;
  T: TAttribute;
begin
inherited Create;
ParentSectionList := MasterList;
Pos := Position;
ObjAlign := ABottom;   {default}
NewSpace := -1;
SpecHeight := -1;
SpecWidth := -1;    
for I := 0 to L.Count-1 do
  with TAttribute(L[I]) do
    case Which of
      SrcSy: Source := Trim(Name);   
      AltSy:
        begin
        FAlt := Name;
        while (Length(FAlt) > 0) and (FAlt[Length(FAlt)] in [#$D, #$A]) do
          Delete(FAlt, Length(FAlt), 1);
        ImageTitle := FAlt;    {use Alt as default Title}
        FAltW := MultibyteToWideString(CodePage, FAlt);
        end;
      IsMapSy:  IsMap := True;
      UseMapSy:
        begin
        UseMap := True;
        S := Trim(Uppercase(Name));
        if (Length(S) > 1) and (S[1] = '#') then
          System.Delete(S, 1, 1);
        MapName := S;
        end;
      AlignSy:
        begin
        S := UpperCase(Name);
        if S = 'TOP' then ObjAlign := ATop
        else if (S = 'MIDDLE') or (S = 'ABSMIDDLE') then ObjAlign := AMiddle
        else if S = 'LEFT' then ObjAlign := ALeft
        else if S = 'RIGHT' then ObjAlign := ARight;
        end;
      BorderSy: begin
                NoBorder := Value = 0;
                BorderSize := IntMin(IntMax(0, Value), 10);
                end;
      TranspSy: Transparent := LLCorner;
      HeightSy:if System.Pos('%', Name) > 0 then   
                 begin
                 if (Value >= 0) and (Value <=100) then
                   begin
                   SpecHeight := Value;
                   PercentHeight := True;
                   end;
                 end
               else
                 SpecHeight := Value;
      WidthSy:if System.Pos('%', Name) > 0 then
                begin
                if (Value >= 0) and (Value <=100) then
                  begin
                  SpecWidth := Value;
                  PercentWidth := True;
                  end;
                end
              else
                SpecWidth := Value;
      HSpaceSy:  NewSpace := IntMin(40, Abs(Value));
      VSpaceSy:  VSpaceT := IntMin(40, Abs(Value));
      ActiveSy:  FHoverImage := True;
      NameSy: ParentSectionList.IDNameList.AddObject(Name, Self);  
      end;
if L.Find(TitleSy, T) then
  ImageTitle := T.Name;   {has higher priority than Alt loaded above}
if L.TheID <> '' then
  ParentSectionList.IDNameList.AddObject(L.TheID, Self);

if NewSpace >= 0 then   
  HSpaceL := NewSpace
else if ObjAlign in [ALeft, ARight] then
  HSpaceL := ImageSpace   {default}
else HSpaceL := 0;
HSpaceR := HSpaceL;
VSpaceB := VSpaceT;
end;

constructor TImageObj.SimpleCreate(MasterList: TSectionList; const AnURL: string);
begin
inherited Create;
ParentSectionList := MasterList;
ObjAlign := ABottom;   {default}
Source := AnURL;
NoBorder := True;
BorderSize := 0;  
end;

procedure TFloatingObj.ProcessProperties(Prop: TProperties);
const     
  DummyHtWd = 200;
var
  MargArrayO: TVMarginArray;
  MargArray: TMarginArray;
  Align: AlignmentType;
  EmSize, ExSize: integer;
begin
if Prop.GetVertAlign(Align) then
  ObjAlign := Align;
if Prop.GetFloat(Align) and (Align <> ANone) then
  begin
  if HSpaceR = 0 then
    begin  {default is different for Align = left/right}
    HSpaceR := ImageSpace;
    HSpaceL := ImageSpace;
    end;
  ObjAlign := Align;
  end;
if ImageTitle = '' then  {a Title attribute will have higher priority than inherited}
  ImageTitle := Prop.PropTitle;
Prop.GetVMarginArray(MargArrayO);
EmSize := Prop.EmSize;
ExSize := Prop.ExSize;
ConvInlineMargArray(MargArrayO, DummyHtWd, DummyHtWd