readhtml.pas

查看html文件的控件

if Assigned(CallingObject) then
  begin
  if Assigned(ThtmlViewer(CallingObject).OnObjectTag) then
    begin
    SL := Attributes.CreateStringList;
    Result := True;
    if not Assigned(Section) then
      Section := TSection.Create(MasterList, Nil, PropStack.Last,
                 CurrentUrlTarget, SectionList, True);
    PushNewProp(SymbToStr(Sy), Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
    Prop:= PropStack.Last;
    PO := Section.CreatePanel(Attributes, SectionList);
    PO.ProcessProperties(PropStack.Last);
    WantPanel := False;
    Params := TStringList.Create;
    Params.Sorted := False;
    repeat
      SavePosition;
      SkipWhiteSpace;
      Next;
      if Sy = ParamSy then
        with Attributes do
          if Find(NameSy, T) then
            begin
            S := T.Name;
            if Find(ValueSy, T) then
              S := S+'='+T.Name;
            Params.Add(S);
            end;
    until (Sy <> ParamSy);
    try
      ThtmlViewer(CallingObject).OnObjectTag(CallingObject, PO.Panel, SL, Params, WantPanel);
    finally
      SL.Free;
      Params.Free;
      end;
    if WantPanel then
      begin
      if Prop.GetBorderStyle <> bssNone then   {start of inline border}
        MasterList.ProcessInlines(SIndex, Prop, True);
      Section.AddPanel1(PO, TagIndex);
      PopAProp('object');
      while not (Sy in [ObjectEndSy, EofSy]) do
        Next1;
      end
    else
      begin
      MasterList.PanelList.Remove(PO);
      PopAProp('object');
      PO.Free;
      end;
    end
  else Next1;
  end
else Next1;
end;

const
  FontConvBase: array[1..7] of double = (8.0,10.0,12.0,14.0,18.0,24.0,36.0);
  PreFontConvBase:  array[1..7] of double = (7.0,8.0,10.0,12.0,15.0,20.0,30.0);

var
  FontConv: array[1..7] of double;
  PreFontConv:  array[1..7] of double;

procedure InitializeFontSizes(Size: integer);
var
  I: integer;
begin
for I := 1 to 7 do
  begin
  FontConv[I] := FontConvBase[I] * Size / 12.0;
  PreFontConv[I] := PreFontConvBase[I] * Size / 12.0;
  end;
end;

{----------------DoCommonSy}
procedure DoCommonSy;
var
  I: integer;
  TxtArea: TTextAreaFormControlObj;
  FormControl: TFormControlObj;
  T: TAttribute;
  Tmp: string;
  HeadingBlock: TBlock;
  HRBlock: THRBlock;
  HorzLine: THorzLine;
  HeadingStr, Link: string;
  Done, FoundHRef: boolean;
  IO: TFloatingObj;  
  Page: TPage;
  SaveSy: Symb;
  Prop: TProperties;
  C: Char;  
  N, IX: integer;

  procedure ChangeTheFont(Sy: Symb; Pre: boolean);
  var
    FaceName: string;
    CharSet: TFontCharSet;
    NewColor: TColor;
    NewSize, I: integer;
    FontResults: set of (Face, Colr, Siz, CharS);   
    DNewSize: double;
    Prop: TProperties;   
  begin
  FontResults := [];
  NewSize := 0;  {get rid of warning}
  for I := 0 to Attributes.Count-1 do
    with TAttribute(Attributes[I]) do
      case Which of
        SizeSy:
          begin
          if (Length(Name) >= 2) and (Name[1] in ['+', '-']) then
            Value := BaseFontSize + Value;
          NewSize := IntMax(1, IntMin(7, Value)); {limit 1..7}
          if (Sy = BaseFontSy) then BaseFontSize := NewSize;
          Include(FontResults, Siz);
          end;
        ColorSy:
          if ColorFromString(Name, False, NewColor) then
            Include(FontResults, Colr);
        FaceSy:
          if (Sy <> BaseFontSy) and (Name <> '') then
            begin
            FaceName := Name;
            if FaceName <> '' then
              Include(FontResults, Face);
            end;
        CharSetSy:
          if not IsUTF8 and TranslateCharSet(Name, CharSet) then    
            Include(FontResults, CharS);
        end;
  PushNewProp('font', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
  Prop := TProperties(PropStack.Last);
  Prop.SetFontBG;
  if Prop.GetBorderStyle <> bssNone then   {start of inline border} 
   MasterList.ProcessInlines(SIndex, Prop, True);
  if Colr in FontResults then
    begin
      PropStack.Last.Assign(NewColor or $2000000, StyleUn.Color);
    end;
 if Siz in FontResults then
    begin
    if Pre then DNewSize := PreFontConv[NewSize]
    else DNewSize := FontConv[NewSize];
    PropStack.Last.Assign(double(DNewSize), FontSize);
    end;
  if Face in FontResults then
    begin
    PropStack.Last.Assign(ReadFontName(FaceName), FontFamily);
    end;
  if CharS in FontResults then
    PropStack.Last.AssignCharset(CharSet);
  end;

  procedure DoPreSy;
  var
    S: TokenObj;
    Tmp, Link: String;
    Done, InForm, InP: boolean;
    I, InitialStackIndex: integer;
    PreBlock, FormBlock, PBlock: TBlock;
    SaveSy: Symb;
    FoundHRef: boolean;
    Prop: TProperties;
    C: Char;
    N, IX: integer;
    Before, After, Intact: boolean;   

    function CollectPreText: boolean;
    // Considers the current data as pure text and collects everything until
    // the input end or one of the reserved tokens is found.
    var
      Buffer: TCharCollection;
      CodePage: Integer;
    begin
    Sy := TextSy;
    CodePage := PropStack.Last.CodePage;
    Buffer := TCharCollection.Create;
    try
      Result := not (LCh in [#0..#8, EOFChar, '<', ^M]);
      while not (LCh in [#0..#8, EOFChar, '<', ^M]) do
        begin
        while LCh = '&' do     {look for entities}
          GetEntity(S, CodePage);

        {Get any normal text, includein spaces}
        while not (LCh in [#0..#8, EOFChar, '<', '&', ^M]) do
          begin
          Buffer.Add(LCh, SIndex);
          GetCh;
          end;
        if Buffer.Size > 0 then
          begin
          S.AddString(Buffer, CodePage);
          Buffer.Clear;
          end;
        end;
    finally
      Buffer.Free;
      end;
    end;

    procedure FormEnd;
    begin
    CurrentForm := Nil;
    if Assigned(Section) then
      begin
      Section.AddTokenObj(S);
      SectionList.Add(Section, TagIndex);
      end;
    S.Clear;
    Section := Nil;   
    PopAProp('form');
    SectionList := FormBlock.OwnerCell;
    InForm := False;
    end;

    procedure PEnd;
    begin
    Section.AddTokenObj(S);
    S.Clear;
    if Section.Len > 0 then
      SectionList.Add(Section, TagIndex)
    else
      begin
      Section.CheckFree;
      Section.Free;
      end;
    Section := Nil;   
    PopAProp('p');
    SectionList := PBlock.OwnerCell;
    InP := False;
    end;

    procedure NewSection;
    begin
    Section.AddTokenObj(S);
    S.Clear;
    SectionList.Add(Section, TagIndex);
    Section := TPreFormated.Create(MasterList, Nil, PropStack.Last,
               CurrentUrlTarget, SectionList, False);
    end;

  begin
  InForm := False;
  InP := False;
  S := TokenObj.Create;
  FormBlock := Nil;
  try
    SectionList.Add(Section, TagIndex);
    PushNewProp('pre', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
    InitialStackIndex := PropStackIndex;
    PreBlock := TBlock.Create(MasterList, PropStack.Last, SectionList, Attributes);
    SectionList.Add(PreBlock, TagIndex);
    SectionList := PreBlock.MyCell;
    Section := TPreformated.Create(MasterList, Nil, PropStack.Last,
               CurrentUrlTarget, SectionList, True);
    Done := False;
    while not Done do
      case Ch of
        '<':
           begin
           Next;
           case Sy of
             TextSy: {this would be an isolated '<'}
               S.AddUnicodeChar('<', SIndex);
             BRSy:
               begin
               Section.AddTokenObj(S);   
               S.Clear;
               SectionList.Add(Section, TagIndex);
               {look for page-break}       
               PushNewProp('br', Attributes.TheClass, '', '', '', Attributes.TheStyle);
               PropStack.Last.GetPageBreaks(Before, After, Intact);
               if Before or After then
                 SectionList.Add(TPage.Create(MasterList), TagIndex);
               PopAProp('br');
               Section := TPreFormated.Create(MasterList, Nil, PropStack.Last,
                          CurrentUrlTarget, SectionList, False);
               if Ch = ^M then GetCh;
               end;
             PSy:
               begin
               if InP then
                 PEnd
               else
                 if S.Leng <> 0 then
                   begin
                   Section.AddTokenObj(S);
                   S.Clear;
                   SectionList.Add(Section, TagIndex);
                   end
                 else
                   begin
                   Section.CheckFree;  
                   Section.Free;
                   end;
               if Ch = ^M then GetCh;
               PushNewProp('p', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
               PBlock := TBlock.Create(MasterList, PropStack.Last, SectionList, Attributes);
               SectionList.Add(PBlock, TagIndex);
               SectionList := PBlock.MyCell;
               Section := TPreFormated.Create(MasterList, Nil, PropStack.Last,
                          CurrentUrlTarget, SectionList, True);
               InP := True;
               end;
             PEndSy:
               begin
               If InP then
                 begin
                 PEnd;
                 Section := TPreFormated.Create(MasterList, Nil, PropStack.Last,
                          CurrentUrlTarget, SectionList, True);
                 end;
               end;

             PreEndSy, TDEndSy, THEndSy:
               Done := True;

             BSy, ISy, BEndSy, IEndSy, EmSy, EmEndSy, StrongSy, StrongEndSy,
                 USy, UEndSy, CiteSy, CiteEndSy, VarSy, VarEndSy,
                 SSy, SEndSy, StrikeSy, StrikeEndSy, SpanSy, SpanEndSy,
                 SubSy, SubEndSy, SupSy, SupEndSy, BigSy, BigEndSy, SmallSy, SmallEndSy,
                 LabelSy, LabelEndSy:  
               begin
               Section.AddTokenObj(S);
               S.Clear;
               case Sy of
                  BSy, ISy, StrongSy, EmSy, CiteSy, VarSy, USy, SSy, StrikeSy, SpanSy,
                  SubSy, SupSy, BigSy, SmallSy, LabelSy:
                    begin
                    PushNewProp(SymbToStr(Sy), Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
                    Prop := TProperties(PropStack.Last);
                    Prop.SetFontBG;
                    if Prop.GetBorderStyle <> bssNone then   {start of inline border} 
                      MasterList.ProcessInlines(SIndex, Prop, True);
                    end;
                  BEndSy, IEndSy, StrongEndSy, EmEndSy, CiteEndSy, VarEndSy, UEndSy,
                      SEndSy, StrikeEndSy, SpanEndSy,
                      SubEndSy, SupEndSy, SmallEndSy, BigEndSy, LabelEndSy:   
                    PopAProp(EndSymbToStr(Sy));
                  end;

               TSection(Section).ChangeFont(PropStack.Last);
               end;

             FontSy, BaseFontSy:
               begin
               Section.AddTokenObj(S);
               S.Clear;
               ChangeTheFont(Sy, True);
               TSection(Section).ChangeFont(PropStack.Last);
               end;
             FontEndSy:
               if PropStackIndex > InitialStackIndex then
                 begin
                 PopAProp('font');
                 Section.AddTokenObj(S);
                 S.Clear;
                 TSection(Section).ChangeFont(PropStack.Last);
                 end;
             ASy:
               begin
               Section.AddTokenObj(S);
               S.Clear;
               FoundHRef := False;
               Link := '';

               for I := 0 to Attributes.Count-1 do
                 with TAttribute(Attributes[I]) do
                   if (Which = HRefSy) then
                     begin
                     FoundHRef := True;
                     if InHref then DoAEnd;
                     InHref := True;
                     if Attributes.Find(TargetSy, T) then
                       CurrentUrlTarget.Assign(Name, T.Name, Attributes, SIndex)      
                     else CurrentUrlTarget.Assign(Name, '', Attributes, SIndex);       
                     if Attributes.Find(TabIndexSy, T) then  
                       CurrentUrlTarget.TabIndex := T.Value;
                     Link := 'link';
                     Break;
                     end;
               PushNewProp('a', Attributes.TheClass, Attributes.TheID, Link,
                                Attributes.TheTitle, Attributes.TheStyle);
               Prop := TProperties(PropStack.Last);
               Prop.SetFontBG;
               if Prop.GetBorderStyle <> bssNone then  {start of inline border}  
                 MasterList.ProcessInlines(SIndex, Prop, True);
               TSection(Section).ChangeFont(PropStack.Last);

               if Attributes.Find(NameSy, T) then
                 begin
                 Tmp := UpperCase(T.Name);
                 {Author may have added '#' by mistake}
                 if (Length(Tmp) > 0) and (Tmp[1] = '#') then
                   Delete(Tmp, 1, 1);
                 MasterList.IDNameList.AddChPosObject(Tmp, SIndex);   
                 Section.AnchorName := True;
                 end;
               if FoundHRef then
                 Section.HRef(HRefSy, MasterList, CurrentUrlTarget, Attributes, PropStack.Last);  
               end;
             AEndSy:
               begin
               Section.AddTokenObj(S);
               S.Clear;
               DoAEnd;
               end;
             ImageSy:
               begin
               Section.AddTokenObj(S);
               PushNewProp('img', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
               IO := TSection(Section).AddImage(Attributes, SectionList, TagIndex);
               IO.ProcessProperties(PropStack.Last);
               PopAProp('img');
               S.Clear;
               end;
             PanelSy:
               begin
               Section.AddTokenObj(S);
               PushNewProp('panel', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
               IO := TSection(Section).AddPanel(Attributes, SectionList, TagIndex);
               IO.ProcessProperties(PropStack.Last);
               PopAProp('panel');
               S.Clear;
               end;
             ObjectSy:    
               begin
               Section.AddTokenObj(S);
               S.Clear;
               C := LCh;
               N := Buff-PChar(DocS);
               IX := SIndex;
               DoObjectTag(C, N, IX);
               LCh := C;
               Ch := UpCase(LCh);
               Buff := PChar(DocS)+N;
               SIndex := IX;
               if Ch = ^M then
                 GetCh;
               end;
             PageSy:
               begin
               Section.AddTokenObj(S);
               S.Clear;
               SectionList.Add(Section, TagIndex