frambrwz.pas

查看html文件的控件

  with TbrFrameBase(List[I]) do
    if CheckNoResize(Lw, Up) then
      begin
      Result := True;  {sides are fixed}
      Fixed[I] := True;  {these edges are fixed}
      Fixed[I+1] := True;
      If Lw and (I = 0) then Lower := True;
      If Up and (I = List.Count-1) then Upper := True;
      end;
end;

{----------------TbrSubFrameSet.Clear}
procedure TbrSubFrameSet.Clear;
var
  I: integer;
  X: TbrFrameBase;
begin
for I := List.Count-1 downto 0 do
  begin
  X := List.Items[I];
  List.Delete(I);
  RemoveControl(X);
  X.Free;
  end;
DimCount := 0;
First := True;
Rows := False;
FillChar(Fixed, Sizeof(Fixed), 0);
FillChar(Lines, Sizeof(Lines), 0);
FBase := '';
FBaseTarget := '';
end;

{----------------TbrSubFrameSet.UpdateFrameList}
procedure TbrSubFrameSet.UpdateFrameList;
var
  I: integer;
begin
for I := 0 to List.Count-1 do
  TbrFrameBase(List[I]).UpdateFrameList;
end;

{----------------TbrSubFrameSet.HandleMeta}
procedure TbrSubFrameSet.HandleMeta(Sender: TObject; const HttpEq, Name, Content: string);  
var
  DelTime, I: integer;
begin
{$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
if CompareText(HttpEq, 'content-type') = 0 then
  TranslateCharset(Content, LocalCharset);     
{$endif}

with MasterSet.FrameViewer do
  begin
  if Assigned(FOnMeta) then FOnMeta(Sender, HttpEq, Name, Content);
  if not (fvMetaRefresh in FOptions) then Exit;
  end;

if CompareText(Lowercase(HttpEq), 'refresh') = 0 then
  begin
  I := Pos(';', Content);
  if I > 0 then                                        
    DelTime := StrToIntDef(copy(Content, 1, I-1), -1)
  else DelTime := StrToIntDef(Content, -1);
  if DelTime < 0 then Exit
  else if DelTime = 0 then DelTime := 1;   
  I := Pos('url=', Lowercase(Content));
  if I > 0 then
    FRefreshURL := Copy(Content, I+4, Length(Content)-I-3)
  else FRefreshURL := '';
  FRefreshDelay := DelTime;
  end;
end;

{----------------TbrSubFrameSet.SetRefreshTimer}
procedure TbrSubFrameSet.SetRefreshTimer;
begin
NextFile := FRefreshURL;
if not Assigned(RefreshTimer) then
  RefreshTimer := TTimer.Create(Self);
RefreshTimer.OnTimer := RefreshTimerTimer;
RefreshTimer.Interval := FRefreshDelay*1000;
RefreshTimer.Enabled := True;
end;

{----------------TbrSubFrameSet.RefreshTimerTimer}
procedure TbrSubFrameSet.RefreshTimerTimer(Sender: Tobject);  
var
  S, D: string;
begin
RefreshTimer.Enabled := False;
if Unloaded then Exit;
if Owner is TbrFrame then
  begin
  SplitURL(NextFile, S, D);
  TbrFrame(Owner).frLoadFromBrzFile(S, D, '', '', '', True, True, True)
  end;
end;

{----------------TbrFrameSet.Create}
constructor TbrFrameSet.Create(AOwner: TComponent);
begin
inherited CreateIt(AOwner, Self);
FrameViewer := AOwner as TFrameBrowser;
{$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
LocalCharSet := FrameViewer.FCharset;       
{$endif}
if fvNoBorder in FrameViewer.FOptions then
  BorderSize := 0    
else
  BorderSize := 2;
BevelOuter := bvNone;
FTitle := '';
FrameNames := TStringList.Create;
FrameNames.Sorted := True;
Viewers := TList.Create;
Frames := TList.Create;
OnResize := CalcSizes;
end;

{----------------TbrFrameSet.Destroy}
destructor TbrFrameSet.Destroy;
begin
FrameNames.Free;
FrameNames := Nil;   {is tested later}
Viewers.Free;
Viewers := Nil;
Frames.Free;    
Frames := Nil;
inherited Destroy;
end;

{----------------TbrFrameSet.Clear}
procedure TbrFrameSet.Clear;
begin
inherited Clear;
FrameNames.Clear;
Viewers.Clear;
Frames.Clear;   
HotSet := Nil;
FTitle := '';
FCurrentFile:= '';
OldHeight := 0;
OldWidth := 0;
FActive := Nil;
end;

procedure TbrFrameSet.RePaint;     
var
  I: integer;
begin
if Assigned(Frames) then
  for I := 0 to Frames.Count-1 do
    TWinControl(Frames[I]).RePaint;
inherited;     
end;

{----------------TbrFrameSet.EndFrameSet}
procedure TbrFrameSet.EndFrameSet;
begin
FTitle := ReadHTML.Title;
inherited EndFrameSet;
with ClientRect do
  InitializeDimensions(Left, Top, Right-Left, Bottom-Top);
end;

{----------------TbrFrameSet.CalcSizes}
{OnResize event comes here}
procedure TbrFrameSet.CalcSizes(Sender: TObject);
var
  ARect: TRect;
begin
ARect := ClientRect;
InflateRect(ARect, -OuterBorder, -OuterBorder);
with ARect do
  begin
  if (OldWidth <> Right-Left) or (OldHeight <> Bottom-Top) then
    begin
    InitializeDimensions(Left, Top, Right-Left, Bottom-Top);
    inherited CalcSizes(Sender);
    end;
  OldWidth := Right-Left;
  OldHeight := Bottom-Top;
  end;
end;

{----------------TbrFrameSet.CheckActive}
procedure TbrFrameSet.CheckActive(Sender: TObject);
begin
if Sender is ThtmlViewer then
  FActive := ThtmlViewer(Sender);
end;

{----------------TbrFrameSet.GetActive}
function TbrFrameSet.GetActive: ThtmlViewer;
begin
if Viewers.Count = 1 then
  Result := ThtmlViewer(Viewers[0])
else
  try
    if FActive is ThtmlViewer then Result := FActive
      else Result := Nil;
  except
    Result := Nil;
  end;
end;

{----------------TbrFrameSet.FVMouseMove}
procedure TbrFrameSet.FVMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
FindLineAndCursor(Sender, X, Y);
if (LineIndex = 0) or (LineIndex = DimCount) then
  begin    {picked up the outer boundary}
  (Sender as TbrFrameBase).Cursor := MasterSet.FrameViewer.Cursor;
  Cursor := MasterSet.FrameViewer.Cursor;
  end;
end;

procedure TbrFrameSet.RefreshTimerTimer(Sender: Tobject);
begin
RefreshTimer.Enabled := False;
if (Self = MasterSet.FrameViewer.CurbrFrameSet) then
FrameViewer.LoadURLInternal(NextFile, '', '', '', True, True)
end;

{----------------TbrFrameSet.LoadFromBrzFile}
procedure TbrFrameSet.LoadFromBrzFile(Stream: TMemoryStream; StreamType: ThtmlFileType;
               const URL, Dest: string);
var
  I: integer;
  Item: TbrFrameBase;
  Frame: TbrFrame;
  Lower, Upper: boolean;
  TheString: string;
begin
Clear;
NestLevel := 0;
FCurrentFile := URL;
TheString := StreamToString(Stream);  
if (StreamType = HTMLType) and
      IsFrameString(lsString, '', TheString, MasterSet.FrameViewer) then
  begin    {it's a Frameset html file}
  FrameParseString(FrameViewer, Self, lsString, '', TheString, HandleMeta);  
  for I := 0 to List.Count-1 do
    Begin
    Item := TbrFrameBase(List.Items[I]);
    TbrFrameBase(Item).LoadBrzFiles;
    end;
  CalcSizes(Self);
  CheckNoresize(Lower, Upper);
  if FRefreshDelay > 0 then
    SetRefreshTimer;
  end
else
  begin   {it's a non frame file}
  Frame := AddFrame(Nil, '');
  Frame.Source := URL;
  Frame.TheStream := Stream;
  Frame.TheStreamType := StreamType;
  Frame.Destination := Dest;
  EndFrameSet;
  CalcSizes(Self);
  Frame.LoadBrzFiles;
  FTitle := ReadHTML.Title;
  FBase := ReadHTML.Base;       
  FBaseTarget := ReadHTML.BaseTarget;
  end;
end;

{----------------TbrFrameSet.ClearForwards}
procedure TbrFrameSet.ClearForwards;
{clear all the forward items in the history lists}
var
  I, J: integer;
  Frame: TbrFrame;
  AList: TList;
  Obj: TObject;
begin
AList := TList.Create;
for J := 0 to Frames.Count-1 do
  begin
  Frame := TbrFrame(Frames[J]);
  with Frame do
    begin
    for I := 0 to frHistoryIndex-1 do
      begin
      Obj := frHistory.Objects[0];
      if Assigned(Obj) and (AList.IndexOf(Obj) < 0) then
        AList.Add(Obj);
      frHistory.Delete(0);
      PositionObj(frPositionHistory[0]).Free;
      frPositionHistory.Delete(0);
      end;
    frHistoryIndex := 0;
    end;
  end;
for J := 0 to Frames.Count-1 do {now see which Objects are no longer used}
  begin
  Frame := TbrFrame(Frames[J]);
  with Frame do
    begin
    for I := 0 to frHistory.Count-1 do
      begin
      Obj := frHistory.Objects[I];
      if Assigned(Obj) and (AList.IndexOf(Obj) > -1) then
        AList.Remove(Obj);  {remove it if it's there}     
      end;
    end;
  end;
for I := 0 to AList.Count-1 do   {destroy what's left}
  TObject(AList[I]).Free;   
AList.Free;
end;

{----------------TbrFrameSet.UpdateFrameList}
procedure TbrFrameSet.UpdateFrameList;  
{Fill Frames with a list of all current TFrames}
begin
Frames.Clear;
inherited UpdateFrameList;
end;

{----------------TFrameBrowser.Create}
constructor TFrameBrowser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Height := 150;
Width := 150;
ProcessList := TList.Create;
FLinkAttributes := TStringList.Create;  
FViewImages := True;
FBitmapList := TStringBitmapList.Create;  
FImageCacheCount := 5;
FHistory := TStringList.Create;
FPosition := TList.Create;
FTitleHistory := TStringList.Create;
FBackground := clBtnFace;
FFontColor := clBtnText;
FHotSpotColor := clBlue;
FVisitedColor := clPurple;
FOverColor := clBlue;
FVisitedMaxCount := 50;
FFontSize := 12;
FFontName := 'Times New Roman';
FPreFontName := 'Courier New';
FCursor := ThickIBeamCursor;
FDither := True;
TabStop := False;
FPrintMarginLeft := 2.0;
FPrintMarginRight := 2.0;
FPrintMarginTop := 2.0;
FPrintMarginBottom := 2.0;
FPrintScale := 1.0;
FMarginWidth := 10;        
FMarginHeight := 5;        
FOptions := [fvPrintTableBackground, fvPrintMonochromeBlack];  
{$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
FCharset := DEFAULT_CHARSET;
{$endif}
Visited := TStringList.Create;
FEncodePostArgs := True;      

CurbrFrameSet := TbrFrameSet.Create(Self);
if fvNoBorder in FOptions then
  begin
  CurbrFrameSet.OuterBorder := 0;
  CurbrFrameSet.BevelOuter := bvNone;
  end
else
  begin
  CurbrFrameSet.OuterBorder := 2;
  CurbrFrameSet.BevelWidth := 2;
  CurbrFrameSet.BevelOuter := bvLowered;
  end;
CurbrFrameSet.Align := alClient;
InsertControl(CurbrFrameSet);
end;

{----------------TFrameBrowser.Destroy}
destructor TFrameBrowser.Destroy;
begin
ProcessList.Free;
FLinkAttributes.Free;
FHistory.Free;
FPosition.Free;
FTitleHistory.Free;
Visited.Free;
FViewerList.Free;
inherited Destroy;
FBitmapList.Free;    
end;

{----------------TFrameBrowser.Clear}
procedure TFrameBrowser.Clear;
var
  I: integer;
  Obj: TObject;
begin
if not Processing then
  begin
  for I := 0 to FHistory.Count-1 do
    with FHistory do
      begin
      Obj := Objects[0];
      Delete(0);
      if Obj <> CurbrFrameSet then
        ChkFree(Obj);
      end;
  with CurbrFrameSet do
    begin
    Clear;
    BevelOuter := bvLowered;
    BevelWidth := 2;
    end;
  FBitmapList.Clear;   
  FURL := '';
  FTarget := '';
  FBaseEx := ''