htmlview.pas

查看html文件的控件

begin
if FProcessing then Exit;
if Filename <> '' then
  begin
  OldFile := FCurrentFile;
  OldTitle := FTitle;
  OldPos := Position;
  OldType := FCurrentFileType;
  OldFormData := GetFormData;   
  try                    
    LoadFile(FileName, HTMLType);

    (*Indent := '';     //debugging aid
    Tree := '';
    FSectionList.FormTree(Indent, Tree);

    Stream := TMemoryStream.Create;
    Stream.Size := Length(Tree);
    Move(Tree[1], Stream.Memory^, Length(Tree));
    Stream.SaveToFile('C:\css2\exec\Tree.txt');
    Stream.Free; *) 


    if (OldFile <> FCurrentFile) or (OldType <> FCurrentFileType) then
      BumpHistory(OldFile, OldTitle, OldPos, OldFormData, OldType)
    else OldFormData.Free;
  except
    OldFormData.Free;
    Raise;
    end;
  end;
end;

{----------------ThtmlViewer.LoadTextFile}
procedure ThtmlViewer.LoadTextFile(const FileName: string);
var
  OldFile, OldTitle: string;
  OldPos: integer;
  OldType: ThtmlFileType;
  OldFormData: TFreeList;  
begin
if FProcessing then Exit;
if Filename <> '' then
  begin
  OldFile := FCurrentFile;
  OldTitle := FTitle;
  OldPos := Position;
  OldType := FCurrentFileType;
  OldFormData := GetFormData;
  try
    LoadFile(FileName, TextType);
    if (OldFile <> FCurrentFile) or (OldType <> FCurrentFileType) then
      BumpHistory(OldFile, OldTitle, OldPos, OldFormData, OldType)
    else OldFormData.Free;
  except
    OldFormData.Free;
    Raise;
    end;
  end;
end;

{----------------ThtmlViewer.LoadImageFile}
procedure ThtmlViewer.LoadImageFile(const FileName: string);
var
  OldFile, OldTitle: string;
  OldPos: integer;
  OldType: ThtmlFileType;
  OldFormData: TFreeList;  

begin
if FProcessing then Exit;
if Filename <> '' then
  begin
  OldFile := FCurrentFile;
  OldTitle := FTitle;
  OldPos := Position;
  OldType := FCurrentFileType;
  OldFormData := GetFormData;   
  try
    LoadFile(FileName, ImgType);
    if (OldFile <> FCurrentFile) or (OldType <> FCurrentFileType) then
      BumpHistory(OldFile, OldTitle, OldPos, OldFormData, OldType)      
    else OldFormData.Free;
  except
    OldFormData.Free;
    Raise;
    end;
  end;
end;

{----------------THtmlViewer.LoadStrings}
procedure THtmlViewer.LoadStrings(const Strings: TStrings; const Reference: string);
begin
LoadString(Strings.Text, Reference, HTMLType);
if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then
  FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL);
end;

{----------------THtmlViewer.LoadTextStrings}
procedure THtmlViewer.LoadTextStrings(Strings: TStrings);
begin
LoadString(Strings.Text, '', TextType);
end;

{----------------ThtmlViewer.LoadFromBuffer}
procedure ThtmlViewer.LoadFromBuffer(Buffer: PChar; BufSize: integer; const Reference: string);
var
  S: string;
begin
SetLength(S, BufSize);
Move(Buffer^, S[1], BufSize);
LoadString(S, Reference, HTMLType);
if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then
  FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL);
end;

{----------------ThtmlViewer.LoadTextFromString}
procedure ThtmlViewer.LoadTextFromString(const S: string);
begin
LoadString(S, '', TextType);
end;

{----------------ThtmlViewer.LoadFromString}
procedure ThtmlViewer.LoadFromString(const S: string; const Reference: string);
begin
LoadString(S, Reference, HTMLType);
if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then
  FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL);
end;

{$ifdef Delphi6_Plus}
procedure ThtmlViewer.LoadFromString(const WS: WideString; const Reference: string);
begin
LoadFromString(#$EF+#$BB+#$BF+UTF8Encode(WS), Reference);
end;
{$endif}

{----------------ThtmlViewer.LoadString}
procedure ThtmlViewer.LoadString(const Source, Reference: string; ft: ThtmlFileType);  
var
  I: integer;
  Dest, FName, OldFile: string;

begin
if FProcessing then Exit;
SetProcessing(True);
FRefreshDelay := 0;
FName := Reference;
I := Pos('#', FName);
if I > 0 then
  begin
  Dest := Copy(FName, I+1, Length(FName)-I);  {positioning information} 
  FName := Copy(FName, 1, I-1);
  end
else Dest := '';
DontDraw := True;    
try
  OldFile := FCurrentFile;
  FCurrentFile := ExpandFileName(FName);
  FCurrentFileType := ft;
  FSectionList.ProgressStart := 75;
  htProgressInit;    
  InitLoad;
  CaretPos := 0;
  Sel1 := -1;
  if Assigned(FOnSoundRequest) then
    FOnSoundRequest(Self, '', 0, True);
  FDocumentSource := Source;
  if Assigned(FOnParseBegin) then
    FOnParseBegin(Self, FDocumentSource);
  if Ft = HTMLType then
    ParseHTMLString(FDocumentSource, FSectionList, FOnInclude, FOnSoundRequest, HandleMeta, FOnLink)
  else
    ParseTextString(FDocumentSource, FSectionList);
  SetupAndLogic;
  CheckVisitedLinks;
  if (Dest <> '') and PositionTo(Dest) then  {change position, if applicable}
  else if (FCurrentFile = '') or (FCurrentFile <> OldFile) then
     begin
     ScrollTo(0);
     HScrollBar.Position := 0;
     end;
  {else if same file leave position alone}
  PaintPanel.Invalidate;
finally
  htProgressEnd;
  SetProcessing(False);
  DontDraw := False;    
  end;
end;

{----------------ThtmlViewer.LoadFromStream}
procedure ThtmlViewer.LoadFromStream(const AStream: TStream; const Reference: string);   
var
  Stream: TMemoryStream;
  S: string;
begin
Stream := TMemoryStream.Create;
try
  Stream.LoadFromStream(AStream);
  SetLength(S, Stream.Size);
  Move(Stream.Memory^, S[1], Stream.Size);
  LoadString(S, Reference, HTMLType);
  if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then
    FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL);
finally
  Stream.Free;
  end;
end;

procedure ThtmlViewer.DoImage(Sender: TObject; const SRC: string; var Stream: TMemoryStream);
begin
Stream := FImageStream;
end;

{----------------ThtmlViewer.LoadStream}
procedure ThtmlViewer.LoadStream(const URL: string; AStream: TMemoryStream; ft: ThtmlFileType);
var
  SaveOnImageRequest: TGetImageEvent;
  SBuffer: string;
begin
if FProcessing or not Assigned(AStream) then Exit;
SetProcessing(True);
FRefreshDelay := 0;
DontDraw := True;     
try
  FSectionList.ProgressStart := 75;  
  htProgressInit;      
  InitLoad;
  CaretPos := 0;
  Sel1 := -1;

  if ft in [HTMLType, TextType] then
    begin
    SetLength(FDocumentSource, AStream.Size);
    Move(AStream.Memory^, FDocumentSource[1], AStream.Size);
    end
  else FDocumentSource := '';
  if Assigned(FOnParseBegin) then
    FOnParseBegin(Self, FDocumentSource);
  if ft = HTMLType then
    begin
    if Assigned(FOnSoundRequest) then
      FOnSoundRequest(Self, '', 0, True);
    ParseHTMLString(FDocumentSource, FSectionList, FOnInclude, FOnSoundRequest, HandleMeta, FOnLink);
    SetupAndLogic;
    end
  else if ft = TextType then
    begin
    ParseTextString(FDocumentSource, FSectionList);
    SetupAndLogic;
    end
  else
    begin
    SaveOnImageRequest := FOnImageRequest;
    SetOnImageRequest(DoImage);
    FImageStream := AStream;
    SBuffer := '<img src="'+URL+'">';
    try
      ParseHTMLString(SBuffer, FSectionList, Nil, Nil, Nil, Nil);
      SetupAndLogic;
    finally
      SetOnImageRequest(SaveOnImageRequest);
      end;
    end;
  ScrollTo(0);
  HScrollBar.Position := 0;
  PaintPanel.Invalidate;
  FCurrentFile := URL;
finally
  htProgressEnd;
  DontDraw := False;      
  SetProcessing(False);
  end;
if (FRefreshDelay > 0) and Assigned(FOnMetaRefresh) then
  FOnMetaRefresh(Self, FRefreshDelay, FRefreshURL);
end;

{----------------ThtmlViewer.DoScrollBars}
procedure ThtmlViewer.DoScrollBars;
var
  VBar, VBar1, HBar: boolean;   
  Wid, HWidth, WFactor, WFactor2, VHeight: integer;
  ScrollInfo :TScrollInfo;

begin
ScrollWidth := IntMin(ScrollWidth, MaxHScroll);
if FBorderStyle = htNone then
  begin
  WFactor := 0;
  PaintPanel.Top := 0;
  PaintPanel.Left := 0;
  BorderPanel.Visible := False;
  end
else
  begin
  WFactor := 1;
  PaintPanel.Top := 1;
  PaintPanel.Left := 1;
  BorderPanel.Visible := False;
  BorderPanel.Visible := True;
  end;
WFactor2 := 2*WFactor;

VBar := False;
VBar1 := False;
if (not (htShowVScroll in htOptions) and (FMaxVertical <= Height-WFactor2) and (ScrollWidth <= Width-WFactor2)) 
         or (FScrollBars = ssNone) then
  {there are no scrollbars}
  HBar := False
else
  if FScrollBars in [ssBoth, ssVertical] then
    begin  {assume a vertical scrollbar}
    VBar1 := (FMaxVertical >= Height-WFactor2) or
            ((FScrollBars in [ssBoth, ssHorizontal]) and
             (FMaxVertical >= Height-WFactor2-sbWidth) and
             (ScrollWidth > Width-sbWidth-WFactor2));
    HBar := (FScrollBars in [ssBoth, ssHorizontal]) and
            ((ScrollWidth > Width-WFactor2) or
             ((VBar1 or (htShowVScroll in FOptions)) and
                 (ScrollWidth > Width-sbWidth-WFactor2)));
    VBar := Vbar1 or  (htShowVScroll in htOptions);
    end
  else
    {there is no vertical scrollbar}
    HBar := (FScrollBars = ssHorizontal) and (ScrollWidth > Width-WFactor2);

if VBar or ((htShowVScroll in FOptions) and (FScrollBars in [ssBoth, ssVertical])) then
  Wid := Width - sbWidth
else
  Wid := Width;
PaintPanel.Width := Wid - WFactor2;
if HBar then
  begin
  PaintPanel.Height := Height - WFactor2 - sbWidth;
  VHeight := Height - sbWidth - WFactor2;        
  end
else
  Begin
  PaintPanel.Height := Height - WFactor2;
  VHeight := Height - WFactor2;        
  end;
HWidth := IntMax(ScrollWidth, Wid-WFactor2);
HScrollBar.Visible := HBar;
HScrollBar.LargeChange := IntMax(1, Wid - 20);
HScrollBar.SetBounds(WFactor, Height-sbWidth-WFactor, Wid -WFactor, sbWidth);
VScrollBar.SetBounds(Width-sbWidth-WFactor, WFactor, sbWidth, VHeight);    
VScrollBar.LargeChange := PaintPanel.Height - VScrollBar.SmallChange;
if htShowVScroll in FOptions then
  begin
  VScrollBar.Visible := ( FScrollBars in [ssBoth, ssVertical] );
  VScrollBar.Enabled := VBar1;
  end
else VScrollBar.Visible := VBar;

HScrollBar.Max := IntMax(0, HWidth);
VScrollBar.SetParams(VScrollBar.Position, PaintPanel.Height+1, 0, FMaxVertical);
ScrollInfo.cbSize := SizeOf(ScrollInfo);
ScrollInfo.fMask := SIF_PAGE;
ScrollInfo.nPage := Wid;
SetScrollInfo(HScrollBar.Handle,SB_CTL,ScrollInfo,TRUE);
end;

{----------------ThtmlViewer.DoLogic}
procedure ThtmlViewer.DoLogic;
var
  Wid, WFactor: integer;

  function HasVScrollbar: boolean;     
  begin
  Result := (FMaxVertical > Height-WFactor) or   
            ((FScrollBars in [ssBoth, ssHorizontal]) and
             (FMaxVertical >= Height-WFactor-sbWidth) and
             (ScrollWidth > Width-sbWidth-WFactor));
  end;

  function HasVScrollbar1: boolean;     
  begin
  Result := (FMaxVertical > Height-WFactor) or
            ((FScrollBars in [ssBoth, ssHorizontal]) and
             (FMaxVertical >= Height-WFactor-sbWidth) and
             (ScrollWidth > Width-WFactor));
  end;

  function FSectionListDoLogic(Width: integer): integer;
  var
    Curs: integer;
  begin
  Curs := 0;
  ScrollWidth := 0;
  Result := FSectionList.DoLogic(PaintPanel.Canvas, 0,
          Width, ClientHeight-WFactor, 0, ScrollWidth, Curs);    
  end;
begin