framview.pas

查看html文件的控件

end;

procedure TfvFrame.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);  
begin
inherited;
{in most cases, SetBounds results in a call to CalcSizes.  However, to make sure
 for case where there is no actual change in the bounds.... }
if Assigned(FrameSet) then
  FrameSet.CalcSizes(Nil);
end;

procedure TfvFrame.RefreshEvent(Sender: TObject; Delay: integer; const URL: string);
begin
if not (fvMetaRefresh in MasterSet.FrameViewer.FOptions) then
  Exit;
if URL = '' then        
  NextFile := Source
else NextFile := MasterSet.FrameViewer.HTMLExpandFilename(URL);
if not FileExists(NextFile) and not MasterSet.RequestEvent then   
  Exit;
if not Assigned(RefreshTimer) then
  RefreshTimer := TTimer.Create(Self);
RefreshTimer.OnTimer := RefreshTimerTimer;
RefreshTimer.Interval := Delay*1000;
RefreshTimer.Enabled := True;
end;

procedure TfvFrame.RefreshTimerTimer(Sender: TObject);
begin
RefreshTimer.Enabled := False;
if Unloaded then Exit;
if (MasterSet.Viewers.Count = 1) then    {load a new FrameSet}
  begin
  if CompareText(NextFile, MasterSet.FCurrentFile) = 0 then
    MasterSet.FrameViewer.Reload    
  else MasterSet.FrameViewer.LoadFromFileInternal(NextFile);
  end
else
  frLoadFromFile(NextFile, '', True, True);     {reload set}
end;

procedure TfvFrame.RePaint;
begin
if Assigned(Viewer) then Viewer.RePaint
else if Assigned(FrameSet) then FrameSet.RePaint;
inherited RePaint;
end;

{----------------TfvFrame.FVMouseDown}
procedure TfvFrame.FVMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
(Parent as TSubFrameSet).FVMouseDown(Sender, Button, Shift, X+Left, Y+Top);
end;

{----------------TfvFrame.FVMouseMove}
procedure TfvFrame.FVMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
if not NoResize then
  (Parent as TSubFrameSet).FVMouseMove(Sender, Shift, X+Left, Y+Top);
end;

{----------------TfvFrame.FVMouseUp}
procedure TfvFrame.FVMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
begin
(Parent as TSubFrameSet).FVMouseUp(Sender, Button, Shift, X+Left, Y+Top);
end;

{----------------TfvFrame.CheckNoResize}
function TfvFrame.CheckNoResize(var Lower, Upper: boolean): boolean;
begin
Result := NoResize;
Lower := NoResize;
Upper := NoResize;
end;

{----------------TfvFrame.InitializeDimensions}
procedure TfvFrame.InitializeDimensions(X, Y, Wid, Ht: integer);
begin
if Assigned(FrameSet) then
  FrameSet.InitializeDimensions(X, Y, Wid, Ht);
end;

{----------------TfvFrame.CreateViewer}
procedure TfvFrame.CreateViewer;
begin
Viewer := ThtmlViewer.Create(Self);  {the Viewer for the frame}
Viewer.FrameOwner := Self;
Viewer.Width := ClientWidth;  
Viewer.Height := ClientHeight; 
Viewer.Align := alClient;
if (MasterSet.BorderSize = 0) or (fvNoFocusRect in MasterSet.FrameViewer.fvOptions) then
  Viewer.BorderStyle := htNone;
Viewer.OnHotspotClick := LOwner.MasterSet.FrameViewer.HotSpotClick;
Viewer.OnHotspotCovered := LOwner.MasterSet.FrameViewer.HotSpotCovered;
if NoScroll then
  Viewer.Scrollbars := ssNone;
Viewer.DefBackground := MasterSet.FrameViewer.FBackground;
Viewer.Visible := False;
InsertControl(Viewer);
Viewer.SendToBack;
Viewer.Visible := True;
Viewer.Tabstop := True;
{$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
Viewer.CharSet := LocalCharset;    
{$endif}
MasterSet.Viewers.Add(Viewer);
with MasterSet.FrameViewer do
  begin
  Viewer.ViewImages := FViewImages;
  Viewer.SetStringBitmapList(FBitmapList); 
  Viewer.ImageCacheCount := FImageCacheCount;
  Viewer.NoSelect := FNoSelect;
  Viewer.DefFontColor := FFontColor;
  Viewer.DefHotSpotColor := FHotSpotColor;
  Viewer.DefVisitedLinkColor := FVisitedColor;  
  Viewer.DefOverLinkColor := FOverColor;
  Viewer.DefFontSize := FFontSize;
  Viewer.DefFontName := FFontName;
  Viewer.DefPreFontName := FPreFontName;
  Viewer.OnBitmapRequest := FOnBitmapRequest;
  if fvOverLinksActive in FOptions then
    Viewer.htOptions := Viewer.htOptions + [htOverLinksActive];
  if fvNoLinkUnderline in FOptions then
    Viewer.htOptions := Viewer.htOptions + [htNoLinkUnderline];  
  if not (fvPrintTableBackground in FOptions) then
    Viewer.htOptions := Viewer.htOptions - [htPrintTableBackground];
  if (fvPrintBackground in FOptions) then
    Viewer.htOptions := Viewer.htOptions + [htPrintBackground];  
  if not (fvPrintMonochromeBlack in FOptions) then
    Viewer.htOptions := Viewer.htOptions - [htPrintMonochromeBlack]; 
  if fvShowVScroll in FOptions then
    Viewer.htOptions := Viewer.htOptions + [htShowVScroll];
  if fvNoWheelMouse in FOptions then
    Viewer.htOptions := Viewer.htOptions + [htNoWheelMouse];
  if fvShowDummyCaret in FOptions then
    Viewer.htOptions := Viewer.htOptions + [htShowDummyCaret];   
  Viewer.OnImageRequest := FOnImageRequest;
  Viewer.OnFormSubmit := FOnFormSubmit;
  Viewer.OnLink := FOnLink;   
  Viewer.OnMeta := FOnMeta;
  Viewer.OnMetaRefresh := RefreshEvent;
  Viewer.OnRightClick := FOnRightClick;     
  Viewer.OnProcessing := CheckProcessing;
  Viewer.OnMouseDown := OnMouseDown;
  Viewer.OnMouseMove := OnMouseMove;
  Viewer.OnMouseUp := OnMouseUp;
  Viewer.OnKeyDown := OnKeyDown;
  Viewer.OnKeyUp := OnKeyUp;
  Viewer.OnKeyPress := OnKeyPress;
  Viewer.Cursor := Cursor;
  Viewer.HistoryMaxCount := FHistoryMaxCount;
  Viewer.OnScript := FOnScript;
  Viewer.PrintMarginLeft := FPrintMarginLeft;
  Viewer.PrintMarginRight := FPrintMarginRight;
  Viewer.PrintMarginTop := FPrintMarginTop;
  Viewer.PrintMarginBottom := FPrintMarginBottom;
  Viewer.PrintScale := FPrintScale;    
  Viewer.OnPrintHeader := FOnPrintHeader;
  Viewer.OnPrintFooter := FOnPrintFooter;
  Viewer.OnPrintHtmlHeader := FOnPrintHtmlHeader;  
  Viewer.OnPrintHtmlFooter := FOnPrintHtmlFooter;
  Viewer.OnInclude := FOnInclude;
  Viewer.OnSoundRequest := FOnSoundRequest;
  Viewer.OnImageOver := FOnImageOver;
  Viewer.OnImageClick := FOnImageClick;
  Viewer.OnFileBrowse := FOnFileBrowse;  
  Viewer.OnObjectClick := FOnObjectClick;
  Viewer.OnObjectFocus := FOnObjectFocus;
  Viewer.OnObjectBlur := FOnObjectBlur;
  Viewer.OnObjectChange := FOnObjectChange; 
  Viewer.ServerRoot := ServerRoot;
  Viewer.OnMouseDouble := FOnMouseDouble;
  Viewer.OnPanelCreate := FOnPanelCreate;
  Viewer.OnPanelDestroy := FOnPanelDestroy;
  Viewer.OnPanelPrint := FOnPanelPrint;
  Viewer.OnDragDrop := fvDragDrop;
  Viewer.OnDragOver := fvDragOver;
  Viewer.OnParseBegin := FOnParseBegin;
  Viewer.OnParseEnd := FOnParseEnd;
  Viewer.OnProgress := FOnProgress;
  Viewer.OnObjectTag := OnObjectTag;     
  if MasterSet.RequestEvent then
    Viewer.OnhtStreamRequest := DoURLRequest;  
  end;
Viewer.MarginWidth := frMarginWidth;
Viewer.MarginHeight := frMarginHeight;  
Viewer.OnEnter := MasterSet.CheckActive;
end;

{----------------TfvFrame.LoadFiles}
procedure TfvFrame.LoadFiles(PEV: PEventRec);
var
  Item: TFrameBase;
  I: integer;
  Upper, Lower, Image, Tex: boolean;
  Msg: string;
  EV: EventRec;
  Event: boolean;
begin
if ((Source <> '') or Assigned(PEV)) and (MasterSet.NestLevel < 4) then
  begin
  Image := ImageFile(Source) and not MasterSet.RequestEvent;
  Tex := TexFile(Source) and not MasterSet.RequestEvent;
  EV.LStyle := lsFile;
  if Image or Tex then
    EV.NewName := MasterSet.FrameViewer.HTMLExpandFilename(Source)
  else
    begin
    if Assigned(PEV) then
      begin
      Event := True;
      EV := PEV^;
      end
    else
      Event := MasterSet.TriggerEvent(Source, @EV);
    if not Event then
      EV.NewName := MasterSet.FrameViewer.HTMLExpandFilename(Source);
    end;
  Inc(MasterSet.NestLevel);
  try
    if not Image and not Tex and IsFrameString(EV.LStyle, EV.NewName, EV.AString, MasterSet.FrameViewer) then
      begin
      FrameSet := TSubFrameSet.CreateIt(Self, MasterSet);
      FrameSet.Align := alClient;
      FrameSet.Visible := False;
      InsertControl(FrameSet);
      FrameSet.SendToBack;
      FrameSet.Visible := True;
      FrameParseString(MasterSet.FrameViewer, FrameSet, EV.LStyle, EV.NewName, EV.AString,
               FrameSet.HandleMeta);
      Self.BevelOuter := bvNone;
      frBumpHistory1(Source, 0);
      with FrameSet do
        begin
        for I := 0 to List.Count-1 do
          Begin
          Item := TFrameBase(List.Items[I]);
          Item.LoadFiles(Nil);
          end;
        CheckNoresize(Lower, Upper);
        if FRefreshDelay > 0 then
          SetRefreshTimer;
        end;
      end
    else
      begin
      CreateViewer;
      Viewer.Base := MasterSet.FBase;
      if Image then
        Viewer.LoadImageFile(EV.NewName)
      else if Tex then
        Viewer.LoadTextFile(EV.NewName)
      else
        begin
        case EV.LStyle of
          lsFile: Viewer.LoadFromFile(EV.NewName+Destination);
          lsString:
            Viewer.LoadFromString(EV.AString, Source);    
          end;
        if EV.LStyle <> lsFile then
          Viewer.PositionTo(Destination);
        end;
      frBumpHistory1(Source, Viewer.Position);
      end;
  except
    if not Assigned(Viewer) then
      CreateViewer;
    if Assigned(FrameSet) then
      begin
      FrameSet.Free;
      FrameSet := Nil;
      end;
    Msg := '<p><img src="qw%&.bmp" alt="Error"> Can''t load '+EV.NewName;
    Viewer.LoadFromBuffer(@Msg[1], Length(Msg), '');  {load an error message}
    end;
  Dec(MasterSet.NestLevel);
  end
else
  begin  {so blank area will perform like the TFrameViewer}
  OnMouseDown := MasterSet.FrameViewer.OnMouseDown;
  OnMouseMove := MasterSet.FrameViewer.OnMouseMove;
  OnMouseUp := MasterSet.FrameViewer.OnMouseUp;
  end;
end;

{----------------TfvFrame.ReloadFiles}
procedure TfvFrame.ReloadFiles(APosition: integer);
var
  Item: TFrameBase;
  I: integer;
  Upper, Lower: boolean;
  EV: EventRec;

  procedure DoError;
  var
    Msg: string;
  begin
  Msg := '<p><img src="qw%&.bmp" alt="Error"> Can''t load '+Source;
  Viewer.LoadFromBuffer(@Msg[1], Length(Msg), '');  {load an error message}
  end;

begin
if (Source <> '') then
  if Assigned(FrameSet) then
    begin
    with FrameSet do
      begin
      for I := 0 to List.Count-1 do
        Begin
        Item := TFrameBase(List.Items[I]);
        Item.ReloadFiles(APosition);
        end;
      CheckNoresize(Lower, Upper);
      end;
    end
  else if Assigned(Viewer) then
    begin
    Viewer.Base := MasterSet.FBase;
    if ImageFile(Source) then
      try
        Viewer.LoadImageFile(Source)
      except end   {leave blank on error}
    else if TexFile(Source) then
      try
        Viewer.LoadTextFile(Source)
      except end
    else
      begin
      try
        if MasterSet.TriggerEvent(Source, @EV) then
          case EV.LStyle of
            lsFile: Viewer.LoadFromFile(EV.NewName);
            lsString: Viewer.LoadFromString(EV.AString, '');
            end
          else
            Viewer.LoadFromFile(Source);
        if APosition < 0 then
          Viewer.Position := ViewerPosition
        else Viewer.Position := APosition;    {its History Position}
        Viewer.FormData := ViewerFormData;   
        ViewerFormData.Free;
        ViewerFormData := Nil;      
      except
        DoError;
        end;
      end;
    end;
Unloaded := False;
end;

{----------------TfvFrame.UnloadFiles}
procedure TfvFrame.UnloadFiles;
var
  Item: TFrameBase;
  I: integer;
begin
if Assigned(RefreshTimer) then
  RefreshTimer.Enabled := False;
if Assigned(FrameSet) then
  begin
  with FrameSet do
    begin
    for I := 0 to List.Count-1 do
      Begin
      Item := TFrameBase(List.Items[I]);
      Item.UnloadFiles;
      end;
    end;
  end
else if Assigned(Viewer) then
  begin
  ViewerPosition := Viewer.Position;
  ViewerFormData := Viewer.FormData;    
  Viewer.Clear;
  if MasterSet.FActive = Viewer then
    MasterSet.FActive := Nil;