readhtml.pas

查看html文件的控件

  if InHref then DoAEnd;
  if Assigned(Row) then
    begin
    AddSection;
    if RowType <> TFoot then  
      Table.Rows.Add(Row)
    else FootList.Add(Row);
    Row.RowType := RowType;  
    Row := Nil;
    while PropStackIndex > RowStack do
      PopProp;
    end;
  end;

begin
Inc(TableLevel);
if TableLevel > 10 then
  begin
  Next;
  Exit;
  end;
if InHref then DoAEnd;    {terminate <a>}
SectionList.Add(Section, TagIndex);
Section := Nil;
SaveSectionList := SectionList;
SaveStyle := CurrentStyle;
SaveNoBreak := NoBreak;
SaveListLevel := ListLevel;   
SectionList := Nil;
CaptionBlock := Nil;
TopCaption := True;
if PropStack.Last.Props[TextAlign] = 'center' then   
  SetJustify := centered
else if PropStack.Last.Props[TextAlign] = 'right' then
  SetJustify := Right
else SetJustify := NoJustify;
PushNewProp('table', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
Table := ThtmlTable.Create(MasterList, Attributes, PropStack.Last);
NewBlock := TTableBlock.Create(MasterList, PropStack.Last,
	SaveSectionList, Table, Attributes, TableLevel);
if (NewBlock.Justify <> Centered) and not (NewBlock.FloatLR in [ALeft, ARight]) then
  NewBlock.Justify := SetJustify;   
NewBlock.MyCell.Add(Table, TagIndex);  {the only item in the cell}
CombineBlock := TTableAndCaptionBlock.Create(MasterList, PropStack.Last,
	                  SaveSectionList, Attributes, NewBlock);  {will be needed if Caption found}
CM := Nil;
ColOK := True;   {OK to add <col> info}
FootList := TList.Create;
try
  Row := Nil;
  RowVAlign := AMiddle;
  RowStack := PropStackIndex;   {to prevent warning message}
  HFStack := 9999999;  
  RowType := TBody;    
  Next;
  while (Sy <> TableEndSy) and (Sy <> EofSy) and (Sy <> CaptionEndSy) do  
    case Sy of
      TDSy, THSy:
        Begin
        ColOK := False;   {no more <col> tags processed}
        if InHref then DoAEnd;
        CurrentStyle := SaveStyle;
        ListLevel := 0;     
        if not Assigned(Row) then   {in case <tr> is missing}
          begin
          RowVAlign := AMiddle;
          RowStack := PropStackIndex;
          PushNewProp('tr', '', '', '', '', Nil);
          Row := TCellList.Create(Nil, PropStack.Last);
          end
        else
          begin
          AddSection;
          while PropStackIndex > RowStack+1 do
            PopProp;          {back stack off to Row item}
          end;
        if Sy = THSy then
          TdTh := 'th'
        else TdTh := 'td';
        PushNewProp(TdTh, Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
        VAlign := GetVAlign(RowVAlign);
        if Assigned(CM) then
          begin
          CellNum := CM.FindColNum(Table.Rows.Count);
          if CellNum >=0 then
            with TColObj(Table.ColInfo[CellNum]) do
              begin
              if colAlign <> '' then   {<col> alignments added here}
                PropStack.Last.Assign(colAlign, TextAlign);
              if colVAlign <> ANone then
                VAlign := colVAlign;
              end;
          end;
        CheckForAlign;     {see if there is Align override}
        if PropStack.Last.Props[TextAlign] = 'none' then
          if Sy = ThSy then
            PropStack.Last.Assign('center', TextAlign)   {th}
          else PropStack.Last.Assign('left', TextAlign); {td}
        CellObj := TCellObj.Create(MasterList, VAlign, Attributes, PropStack.Last);
        SectionList := CellObj.Cell;
        if ((CellObj.WidthAttr = 0) or CellObj.AsPercent) and Attributes.Find(NoWrapSy, T) then   
          NoBreak := True   {this seems to be what IExplorer does}
        else NoBreak := False;
        SkipWhiteSpace;
        Next;
        DoBody(TableTermSet);
        end;
      CaptionSy:
        begin
        if InHref then DoAEnd;
        CurrentStyle := SaveStyle;
        NoBreak := False;
        AddSection;
        if Attributes.Find(AlignSy, T) then
          TopCaption := Lowercase(T.Name) <> 'bottom';
        PushNewProp('caption', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
        if not Assigned(CaptionBlock) then
          CaptionBlock := TBlock.Create(MasterList, PropStack.Last,
            SaveSectionList, Attributes);
        SectionList := CaptionBlock.MyCell;
        Next;
        DoBody(TableTermSet);

        SectionList.Add(Section, TagIndex);
        PopAProp('caption');
        Section := Nil;
        SectionList := Nil;
        if Sy = CaptionEndSy then Next;  {else it's TDSy, THSy, etc}
        end;
      THeadSy, TBodySy, TFootSy, THeadEndSy, TBodyEndSy, TFootEndSy:   
        begin
        AddRow;   {if it hasn't been added already}
        while PropStackIndex > HFStack do
          PopProp;
        HFStack := PropStackIndex;
        TdTh := '';
        case Sy of
          THeadSy:
            if Table.Rows.Count = 0 then
              begin
              RowType := THead;
              TdTh := 'thead';
              end
            else RowType := TBody;
          TBodySy:
            begin
            RowType := TBody;
            TdTh := 'tbody';
            end;
          TFootSy:
            begin
            RowType := TFoot;
            TdTh := 'tfoot';
            end;
          THeadEndSy, TBodyEndSy, TFootEndSy:
            RowType := TBody;
          end;
        if TdTh <> '' then
          PushNewProp(TdTh, Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
        Next;
        end;
      TREndSy:
        begin
        AddRow;   
        Next;
        end;
      TRSy:
        begin
        AddRow;  {if it is still assigned}
        RowStack := PropStackIndex;
        PushNewProp('tr', Attributes.TheClass, Attributes.TheID, '', Attributes.TheTitle, Attributes.TheStyle);
        CheckForAlign;
        Row := TCellList.Create(Attributes, PropStack.Last);
        RowVAlign := GetVAlign(AMiddle);
        Next;
        end;
      TDEndSy, THEndSy:
        begin AddSection; Next; end;
      ColSy, ColGroupSy:
        begin
        DoColGroup(Table, ColOK);
        if not Assigned(CM) and Assigned(Table.ColInfo) then
          CM := TCellManager.Create(Table);
        end;
      else
        begin
        if ((Sy = TextSy) and (LCToken.S = ' ')) or (Sy = CommandSy) then  
          Next  {discard single spaces here}
        else
          begin
          JunkSaveSectionList := SectionList;
          SectionList := SaveSectionList;   {the original one}
          DoBody(TableTermSet);
          SectionList.Add(Section, TagIndex);
          Section := Nil;
          SectionList := JunkSaveSectionList;
          end;
        end;
      end;
  if InHref then DoAEnd;
  AddSection;
  AddRow;     
  while PropStackIndex > HFStack do
    PopProp;
  for I := 0 to FootList.Count-1 do   {put TFoot on end of table}
    Table.Rows.Add(TCellList(FootList[I]));
finally
  FootList.Free;   
  SectionList := SaveSectionList;
  if Assigned(CaptionBlock) then
    begin
    CombineBlock.TopCaption := TopCaption;
    CombineBlock.CaptionBlock := CaptionBlock;
    with CombineBlock.MyCell do
      if TopCaption then
        begin
        Add(CaptionBlock, TagIndex);
        Add(NewBlock, TagIndex);
        end
      else
        begin
        Add(NewBlock, TagIndex);
        Add(CaptionBlock, TagIndex);
        end;
    SectionList.Add(CombineBlock, TagIndex);
    NewBlock.OwnerCell := CombineBlock.MyCell;
    end
  else
    begin
    CombineBlock.CancelUsage;    
    CombineBlock.Free;     {wasn't needed}
    SectionList.Add(NewBlock, TagIndex);
    end;
  PopaProp('table');
  CurrentStyle := SaveStyle;
  NoBreak := SaveNoBreak;
  ListLevel := SaveListLevel;
  Dec(TableLevel);
  CM.Free;
  end;
Next;
end;

procedure GetOptions(Select: TListBoxFormControlObj);
 {get the <option>s for Select form control}
var
  InOption, Selected: boolean;
  WS: WideString;
  SaveNoBreak: boolean;
  CodePage: integer;
  Attr: TStringList;
  T: TAttribute;
begin
SaveNoBreak := NoBreak;
NoBreak := False;
CodePage := PropStack.Last.CodePage;
Next;
WS := '';
InOption := False;
Selected := False;
Attr := Nil;
while not (Sy in[SelectEndSy, InputSy, PSy, EofSy]+TableTermSet) do
  begin
  case Sy of
    OptionSy, OptionEndSy:
      begin
      WS := WideTrim(WS);
      if InOption then
        Select.AddStr(WS, Selected, Attr, CodePage);
      Selected := False;
      WS := '';
      InOption := Sy = OptionSy;
      if InOption then
        begin
        Selected := Attributes.Find(SelectedSy, T);
        Attr := Attributes.CreateStringList;
        end;
      end;
    TextSy: if InOption then
              WS := WS+LCToken.S;
    end;
  Next;
  end;
if InOption then
  begin
  WS := WideTrim(WS);
  Select.AddStr(WS, Selected, Attr, CodePage);
  end;
Select.ResetToValue;
NoBreak := SaveNoBreak;   
end;

{----------------DoMap}
procedure DoMap;
var
  Item: TMapItem;
  T: TAttribute;
  ErrorCnt: integer;
begin
Item := TMapItem.Create;
ErrorCnt := 0;
try
  if Attributes.Find(NameSy, T) then
    Item.MapName := Uppercase(T.Name);
  Next;
  while (Sy <> MapEndSy) and (Sy <> EofSy) and (ErrorCnt < 3) do
    begin
    if Sy = AreaSy then Item.AddArea(Attributes)
    else if Sy <> TextSy then
      Inc(ErrorCnt);
    Next;
    end;
  if Sy = MapEndSy then MasterList.MapList.Add(Item)
    else Item.Free;
except
  Item.Free;
  Raise;
  end;
Next;
end;

procedure DoScript(Ascript: TScriptEvent);
var
  Lang, AName: string;
  T: TAttribute;
  S, Text: string;

  procedure Next1;
    {Special Next routine to get the next token}
    procedure GetTag1;  {simplified 'Pick up a Tag' routine}
    var
      Count: integer;
    begin
    Text := '<';
    GetCh;
    if not (Ch in ['A'..'Z', '/']) then
      begin
      Sy := TextSy;
      Exit;
      end;
    Sy := CommandSy;   {catch all}
    while (Ch in ['A'..'Z', '/']) do
      begin
      Text := Text+LCh;
      GetCh;
      end;
    if CompareText(Text, '</script') = 0 then
      Sy := ScriptEndSy;
    Count := 0;
    while not (LCh in ['>', EofChar]) and (Count < 6)do   
      begin
      if LCh = ^M then
        Text := Text+' '
      else Text := Text+LCh;
      GetCh;
      Inc(Count);
      end;
    if LCh = '>' then
      begin
      Text := Text+'>';
      if Sy = ScriptEndSy then    
        InScript := False;
      GetCh;
      end;
    end;

  begin  {already have fresh character loaded here}
  Text := '';
  if LCh = EofChar then Sy := EofSy
  else if LCh = ^M then
    begin
    Sy := EolSy;
    GetCh;
    end
  else if LCh = '<' then
     GetTag1
  else
    begin
    Sy := TextSy;
    while not (LCh in [^M, '<', EofChar]) do
      begin
      Text := Text+LCh;
      GetCh;
      end;
    end;
  end;

begin  {on entry, do not have the next character for <script>}
try
  if Assigned(AScript) then
    begin
    InScript := True;
    GetCh;      {get character here with Inscript set to allow immediate comment}
    if Attributes.Find(LanguageSy, T) then
      Lang := T.Name
    else Lang := '';
    if Attributes.Find(NameSy, T) then 
      AName := T.Name
    else AName := '';                  

    S := '';
    Next1;
    while (Sy <> ScriptEndSy) and (Sy <> EofSy) do
      begin
      if Sy = EolSy then
        S := S+^M+^J
      else
        S := S+Text;
      Next1;
      end;
    AScript(CallingObject, AName, Lang, S);
    end
  else
    begin
    GetCh;   {make up for not having next character on entry}  
    repeat
      Next1;
    until Sy in [ScriptEndSy, EofSy];
    end;
finally
  InScript := False;
  end;
end;

procedure DoP(const TermSet: SymbSet); forward;
procedure DoBr(const TermSet: SymbSet); forward;

function DoObjectTag(var C: Char; var N, IX: integer): boolean;    
var
  WantPanel: boolean;
  SL, Params: TStringList;
  Prop: TProperties;
  PO: TPanelObj;
  S: string;
  T: TAttribute;

  procedure SavePosition;
  begin
  C := LCh;
  N := Buff-PChar(DocS);
  IX := SIndex; 
  end;

  procedure Next1;
  begin
  SavePosition;
  Next;
  end;
begin
Result := False;