⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frambrwz.pas

📁 查看html文件的控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
  Item: TbrFrameBase;
  I: integer;

begin
if Assigned(RefreshTimer) then RefreshTimer.Enabled := False;
OldName := Source;
OldBase := URLBase;
S := URL;
if S = '' then S := OldName
else  URLBase := URLSubs.GetBase(S);   {get new base}
HS := S;
SameName := CompareText(S, OldName)= 0;
{if SameName, will not have to reload anything unless Reload set}

if not SameName or Reload then
  begin
  if Assigned(Viewer) and Assigned(MasterSet.FrameViewer.FOnViewerClear) then
    MasterSet.FrameViewer.FOnViewerClear(Viewer);
  S1 := '';
  if Assigned(MasterSet.FrameViewer.FOnGetPostRequestEx) then   
    MasterSet.FrameViewer.FOnGetPostRequestEx(Self, IsGet, S, Query, EncType, Referer, Reload, S1, TheStreamType, TheStream) 
  else
    MasterSet.FrameViewer.FOnGetPostRequest(Self, IsGet, S, Query, Reload, S1, TheStreamType, TheStream);
  if S1 <> '' then
    begin
    S := S1;
    URLBase := GetBase(S);
    end;
  end;
Source := S;

try
  TheString := StreamToString(TheStream);  
  if not SameName then
    try
      FrameFile := (TheStreamType = HTMLType) and
              IsFrameString(lsString, '', TheString, MasterSet.FrameViewer);
    except
      Raise(EfvLoadError.Create('Can''t load: '+URL));
      end
  else FrameFile := not Assigned(Viewer);
  if SameName and not Reload then
    if Assigned(Viewer) then
      begin
      OldPos := Viewer.Position;
      Viewer.PositionTo(Dest);
      MasterSet.FrameViewer.AddVisitedLink(URL+Dest);   
      if Bump and (Viewer.Position <> OldPos) then
        {Viewer to Viewer}
        frBumpHistory(HS, Viewer.Position, OldPos, Nil);
      end
    else
      begin
      with FrameSet do
        for I := 0 to List.Count-1 do
          Begin
          Item := TbrFrameBase(List.Items[I]);
          if (Item is TbrFrame) then
            with TbrFrame(Item) do
              if CompareText(Source, OrigSource) <> 0 then
                frLoadFromBrzFile(OrigSource, '', '', '', '', True, True, False);
          end;
      Exit;
      end      
  else if Assigned(Viewer) and not FrameFile then  {not samename or samename and reload}
    begin  {Viewer already assigned and it's not a Frame file}
    OldPos := Viewer.Position;
    OldTitle := Viewer.DocumentTitle;
    if Bump and not SameName and (MasterSet.Viewers.Count > 1) then  
      OldFormData := Viewer.FormData      
    else OldFormData := Nil;
    try
      Viewer.Base := MasterSet.FBase;
      Viewer.LoadStream(Source, TheStream, TheStreamType);
      if (Dest <> '') then
        Viewer.PositionTo(Dest);
      MasterSet.FrameViewer.AddVisitedLink(URL+Dest);
      if not samename then
        begin   {don't bump history on a forced reload}
        if MasterSet.Viewers.Count > 1 then
          begin
          if Bump then
             {Viewer to Viewer}
            frBumpHistory(HS, Viewer.Position, OldPos, OldFormData)   
          else OldFormData.Free;
          end
        else if (MasterSet.Viewers.Count = 1) and Bump then    
          {a single viewer situation, bump the history here}
          with MasterSet do
            begin
            FCurrentFile := Source;
            FTitle := Viewer.DocumentTitle;
            FBase := Viewer.Base;
            FBaseTarget := Viewer.BaseTarget;
            FrameViewer.BumpHistory1(OldName, OldTitle, OldPos, HTMLType);
            end;
        end;
    except
      OldFormData.Free;  
      Raise;
      end;
    end
  else
    begin {Viewer is not assigned or it is a Frame File}
    {keep the old viewer or frameset around (free later) to minimize blink}
    OldViewer := Viewer;  Viewer := Nil;
    OldFrameSet := FrameSet;  FrameSet := Nil;
    if OldFrameSet <> Nil then OldFrameSet.ClearFrameNames;
    if FrameFile then
      begin   {it's a frame file}
      FrameSet := TbrSubFrameSet.CreateIt(Self, MasterSet);
      FrameSet.URLBase := URLBase;
      FrameSet.Align := alClient;
      FrameSet.Visible := False;
      InsertControl(FrameSet);
      FrameSet.SendToBack;    {to prevent blink}
      FrameSet.Visible := True;
      FrameParseString(MasterSet.FrameViewer, FrameSet, lsString, '', TheString, FrameSet.HandleMeta);
      MasterSet.FrameViewer.AddVisitedLink(URL);
      Self.BevelOuter := bvNone;
      with FrameSet do
        begin
        for I := 0 to List.Count-1 do
          Begin
          Item := TbrFrameBase(List.Items[I]);
          Item.LoadBrzFiles;
          end;
        CheckNoresize(Lower, Upper);
        if FRefreshDelay > 0 then
          SetRefreshTimer;
        end;
      if Assigned(OldViewer) then
        frBumpHistory(HS, 0, OldViewer.Position, OldViewer.FormData)  
      else frBumpHistory(S, 0, 0, Nil);
      end
    else
      begin   {not a frame file but needs a viewer}
      CreateViewer;
      Viewer.Base := MasterSet.FBase;  
      Viewer.LoadStream(Source, TheStream, TheStreamType);
      Viewer.PositionTo(Dest);
      MasterSet.FrameViewer.AddVisitedLink(URL+Dest);
      {FrameSet to Viewer}
      frBumpHistory(HS, Viewer.Position, 0, Nil);
      end;
    if Assigned(FrameSet) then
      with FrameSet do
        begin
        with ClientRect do
          InitializeDimensions(Left, Top, Right-Left, Bottom-Top);
        CalcSizes(Nil);
        end;
    if Assigned(Viewer) then
      begin
      if MasterSet.BorderSize = 0 then
        BevelOuter := bvNone
      else
        begin
        BevelOuter := bvLowered;
        BevelWidth := MasterSet.BorderSize;
        end;
      if (Dest <> '') then
        Viewer.PositionTo(Dest);
      end;
    if Assigned(OldViewer) then
      begin
      MasterSet.Viewers.Remove(OldViewer);
      if MasterSet.FActive = OldViewer then
        MasterSet.FActive := Nil;
      OldViewer.Free;
      end
    else if Assigned(OldFrameSet) then
      begin
      OldFrameSet.UnloadFiles;
      OldFrameSet.Visible := False;
      end;
    RePaint;
    end;
  except
    Source := OldName;
    URLBase := OldBase;
    Raise;
    end;
end;

{----------------TbrFrame.ReloadFile}
procedure TbrFrame.ReloadFile(const FName: string; APosition: LongInt);
{It's known that there is only a single viewer, the file is not being changed,
 only the position}
begin
Viewer.Position := APosition;
end;

function ConvDosToHTML(const Name: string): string;    
{if Name is a Dos filename, convert it to HTML.  Add the file:// if it is
 a full pathe filename}
begin
Result := Name;
if Pos('\', Result) > 0 then
  begin
  Result := DosToHTML(Result);
  if (Pos('|', Result) > 0) then  {was something like c:\....}
    Result := 'file:///'+Result;
  end;
end;

{----------------TbrFrame.URLExpandName}    
procedure TbrFrame.URLExpandName(Sender: TObject; const SRC: string; var Rslt: string);
var
  S: string;
  Viewer: ThtmlViewer;
begin
S := ConvDosToHTML(SRC);  
if not IsFullUrl(S) then
  begin
  Viewer := Sender as ThtmlViewer;
  if Viewer.Base <> '' then      
    Rslt := Combine(GetBase(ConvDosToHTML(Viewer.Base)), S)
  else Rslt := Combine(UrlBase, S);
  end
else Rslt := S;
end;

{----------------TbrFrame.frBumpHistory}
procedure TbrFrame.frBumpHistory(const NewName: string;
              NewPos, OldPos: LongInt; OldFormData: TFreeList);
{applies to TFrames which hold a ThtmlViewer}{Viewer to Viewer}
var
  PO: PositionObj;
begin
with frHistory do
  begin
  if (Count > 0) then
    begin
    PositionObj(frPositionHistory[frHistoryIndex]).Pos := OldPos;
    if frHistory[frHistoryIndex] <> NewName then   
      PositionObj(frPositionHistory[frHistoryIndex]).FormData := OldFormData    
    else OldFormData.Free;
    end
  else OldFormData.Free;     
  MasterSet.ClearForwards;   {clear the history list forwards}
  frHistoryIndex := 0;
  InsertObject(0, NewName, FrameSet);  {FrameSet may be Nil here}
  PO := PositionObj.Create;
  PO.Pos := NewPos;
  PO.Seq := Sequence;
  Inc(Sequence);
  frPositionHistory.Insert(0, PO);
  MasterSet.UpdateFrameList;
  with MasterSet.FrameViewer do
    if Assigned(FOnHistoryChange) then
      FOnHistoryChange(MasterSet.FrameViewer);
  end;
end;

{----------------TbrFrame.frBumpHistory1}
procedure TbrFrame.frBumpHistory1(const NewName: string; Pos: LongInt);
{called from a fresh TbrFrame.  History list is empty}
var
  PO: PositionObj;
begin
with frHistory do
  begin
  frHistoryIndex := 0;
  InsertObject(0, NewName, FrameSet);  {FrameSet may be Nil here}
  PO := PositionObj.Create;
  PO.Pos := Pos;
  PO.Seq := Sequence;
  Inc(Sequence);
  frPositionHistory.Insert(0, PO);
  MasterSet.UpdateFrameList;     
  with MasterSet.FrameViewer do        
    if Assigned(FOnHistoryChange) then
      FOnHistoryChange(MasterSet.FrameViewer);
  end;
end;

{----------------TbrFrame.frSetHistoryIndex}
procedure TbrFrame.frSetHistoryIndex(Value: integer);
begin
with frHistory do
  if (Value <> frHistoryIndex) and (Value >= 0) and (Value < Count) then
    begin
    if Assigned(RefreshTimer) then
      RefreshTimer.Enabled := False;    {cut off any timing underway}
    if Assigned(Viewer) then   {current is Viewer}
      with PositionObj(frPositionHistory[frHistoryIndex]) do
        begin
        Pos := Viewer.Position;   {save the old position}
        {note that frHistoryIndex can only change by 1}
        PositionObj(frPositionHistory[frHistoryIndex]).FormData := Viewer.FormData;     
        end
    else
      begin    {Current is FrameSet}
      FrameSet.UnloadFiles;
      FrameSet.DestroyHandle;
      FrameSet.ClearFrameNames;
      FrameSet.Visible := False;
      FrameSet := Nil;   {it's not destroyed,though}
      end;

    if Objects[Value] is TbrSubFrameSet then
      begin
      FrameSet := TbrSubFrameSet(Objects[Value]);
      FrameSet.Visible := True;
      FrameSet.ReloadFiles(-1);
      FrameSet.AddFrameNames;
      if Assigned(Viewer) then
        begin
        if Assigned(MasterSet.Viewers) then
          MasterSet.Viewers.Remove(Viewer);
        if MasterSet.FActive = Viewer then
          MasterSet.FActive := Nil;
        Viewer.Free;
        Viewer := Nil;
        end;
      end
    else
      begin
      if not Assigned(Viewer) then
        CreateViewer;
      with PositionObj(frPositionHistory[Value]) do
        begin
        if (Source <> Strings[Value]) then
        frLoadFromBrzFile(Strings[Value], '', '', '', '', False, True, False);
        Viewer.FormData := FormData;   
        FormData.Free;
        FormData := Nil;
        Viewer.Position := Pos;
        end;
      end;
    Source := Strings[Value];
    frHistoryIndex := Value;
    MasterSet.UpdateFrameList;
    with MasterSet.FrameViewer do
      if Assigned(FOnHistoryChange) then
        FOnHistoryChange(MasterSet.FrameViewer);
    MasterSet.FrameViewer.CheckVisitedLinks;
    end;
end;

{----------------TbrFrame.UpdateFrameList}
procedure TbrFrame.UpdateFrameList;  
begin
MasterSet.Frames.Add(Self);
if Assigned(FrameSet) then
  FrameSet.UpdateFrameList;
end;

{----------------TbrSubFrameSet.CreateIt}
constructor TbrSubFrameSet.CreateIt(AOwner: TComponent; Master: TbrFrameSet);
begin
inherited Create(AOwner);
MasterSet := Master;
{$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
if AOwner is TbrFrameBase then
  LocalCharSet := TbrSubFrameset(AOwner).LocalCharSet;       
{$endif}
OuterBorder := 0;   {no border for subframesets}  
if Self <> Master then
  BorderSize := Master.BorderSize;   
First := True;
List := TFreeList.Create;
FBase := '';
FBaseTarget := '';
OnResize := CalcSizes;
OnMouseDown := FVMouseDown;
OnMouseMove := FVMouseMove;
OnMouseUp := FVMouseUp;
{$ifdef delphi7_plus}
ParentBackground := False;
{$endif}
ParentColor := True;
if (AOwner is TbrFrameBase) then
  URLBase := TbrFrameBase(AOwner).URLBase;   
end;

{----------------TbrSubFrameSet.ClearFrameNames}
procedure TbrSubFrameSet.ClearFrameNames;
var
  I, J: integer;
begin
for J := 0 to List.Count-1 do
  if (TbrFrameBase(List[J]) is TbrFrame) then
    begin  
    with TbrFrame(List[J]) do
      if Assigned(MasterSet) and (WinName <> '')
            and Assigned(MasterSet.FrameNames)
              and MasterSet.FrameNames.Find(WinName, I) then
                MasterSet.FrameNames.Delete(I);
    end
  else if (TbrFrameBase(List[J]) is TbrSubFrameSet) then
    TbrSubFrameSet(List[J]).ClearFrameNames;
end;

{----------------TbrSubFrameSet.AddFrameNames}
procedure TbrSubFrameSet.AddFrameNames;         
var
  J: integer;
  Frame: TbrFrame;
begin
for J := 0 to List.Count-1 do
  if (TbrFrameBase(List[J]) is TbrFrame) then
    begin
    Frame := TbrFrame(List[J]);
    with Frame do
      if Assigned(MasterSet) and (WinName <> '')
            and Assigned(MasterSet.FrameNames) then
              begin
              MasterSet.FrameNames.AddObject(Uppercase(WinName), Frame);
              end;
    end
  else if (TbrFrameBase(List[J]) is TbrSubFrameSet) then
    TbrSubFrameSet(List[J]).AddFrameNames;
end;

{----------------TbrSubFrameSet.Destroy}
destructor TbrSubFrameSet.Destroy;
begin
List.Free;
List := Nil;
RefreshTimer.Free;

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -