📄 frambrwz.pas
字号:
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 + -