frambrwz.pas

来自「查看html文件的控件」· PAS 代码 · 共 2,106 行 · 第 1/5 页

        end;
if WinName <> '' then   {add it to the Window name list}
  (AOwner as TbrSubFrameSet).MasterSet.FrameNames.AddObject(Uppercase(WinName), Self);
OnMouseDown := FVMouseDown;
OnMouseMove := FVMouseMove;
OnMouseUp := FVMouseUp;
frHistory := TStringList.Create;
frPositionHistory := TFreeList.Create;
end;

{----------------TbrFrame.Destroy}
destructor TbrFrame.Destroy;
var
  I: integer;
begin
if Assigned(MasterSet) then
  begin
  if (WinName <> '')
      and Assigned(MasterSet.FrameNames) and MasterSet.FrameNames.Find(WinName, I)
      and (MasterSet.FrameNames.Objects[I] = Self) then
    MasterSet.FrameNames.Delete(I);
  if Assigned(Viewer) then
    begin
    if Assigned(MasterSet.Viewers) then
      MasterSet.Viewers.Remove(Viewer);
    if Assigned(MasterSet.Frames) then
      MasterSet.Frames.Remove(Self);
    if Viewer = MasterSet.FActive then MasterSet.FActive := Nil;
    end;
  end;
if Assigned(Viewer) then
  begin
  Viewer.Free;
  Viewer := Nil;
  end
else if Assigned(FrameSet) then
  begin
  FrameSet.Free;
  FrameSet := Nil;
  end;
frHistory.Free;  frHistory := Nil;
frPositionHistory.Free;  frPositionHistory := Nil;
ViewerFormData.Free;     
RefreshTimer.Free;
inherited Destroy;
end;

procedure TbrFrame.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 TbrFrame.RefreshEvent(Sender: TObject; Delay: integer; const URL: string);
var
  Ext: string;
begin
if not (fvMetaRefresh in MasterSet.FrameViewer.FOptions) then
  Exit;
Ext := Lowercase(GetURLExtension(URL));
if (Ext = 'exe') or (Ext = 'zip') then Exit;
if URL = '' then
  NextFile := Source
else if not IsFullURL(URL) then
   NextFile := Combine(URLBase, URL)  //URLBase + URL
else
   NextFile := URL;
if not Assigned(RefreshTimer) then
  RefreshTimer := TTimer.Create(Self);
RefreshTimer.OnTimer := RefreshTimerTimer;
RefreshTimer.Interval := Delay*1000;
RefreshTimer.Enabled := True;
end;

procedure TbrFrame.RefreshTimerTimer(Sender: TObject);
var
  S, D: string;
begin
RefreshTimer.Enabled := False;
if Unloaded then Exit;
if not IsFullUrl(NextFile) then
  NextFile := Combine(UrlBase, NextFile);
if (MasterSet.Viewers.Count = 1) then    {load a new FrameSet}
  MasterSet.FrameViewer.LoadURLInternal(NextFile, '', '', '', True, True)
else
  begin
  SplitURL(NextFile, S, D);
  frLoadFromBrzFile(S, D, '', '', '', True, True, True);
  end;
end;

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

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

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

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

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

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

{----------------TbrFrame.CreateViewer}
procedure TbrFrame.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 Assigned(FOnImageRequest) then
    Viewer.OnImageRequest := FOnImageRequest;
  Viewer.OnFormSubmit := DoFormSubmitEvent;
  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;   
  Viewer.OnhtStreamRequest := DoURLRequest;
  end;
Viewer.MarginWidth := brMarginWidth;    
Viewer.MarginHeight := brMarginHeight;  
Viewer.OnEnter := MasterSet.CheckActive;
Viewer.OnExpandName := UrlExpandName;    
end;

{----------------TbrFrame.LoadBrzFiles}
procedure TbrFrame.LoadBrzFiles;
var
  Item: TbrFrameBase;
  I: integer;
  Upper, Lower: boolean;
  Msg: string[255];
  NewURL: string;
  TheString: string;   
begin
if (Source <> '') and (MasterSet.NestLevel < 4) then
  begin
  if not Assigned(TheStream) then
    begin
    NewURL := '';
    if Assigned(MasterSet.FrameViewer.FOnGetPostRequestEx) then   
      MasterSet.FrameViewer.FOnGetPostRequestEX(Self, True, Source, '', '', '', False, NewURL, TheStreamType, TheStream)
    else
      MasterSet.FrameViewer.FOnGetPostRequest(Self, True, Source, '', False, NewURL, TheStreamType, TheStream);
    if NewURL <> '' then
      Source := NewURL;
    end;
  URLBase := GetBase(Source);
  Inc(MasterSet.NestLevel);
  try
    TheString := StreamToString(TheStream);  
    if (TheStreamType = HTMLType) and IsFrameString(LsString, '', TheString,
          MasterSet.FrameViewer) then
      begin
      FrameSet := TbrSubFrameSet.CreateIt(Self, MasterSet);
      FrameSet.Align := alClient;
      FrameSet.Visible := False;
      InsertControl(FrameSet);
      FrameSet.SendToBack;
      FrameSet.Visible := True;
      FrameParseString(MasterSet.FrameViewer, FrameSet, lsString, '', TheString, FrameSet.HandleMeta);
      Self.BevelOuter := bvNone;
      frBumpHistory1(Source, 0);
      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;
      end
    else
      begin
      CreateViewer;     
      Viewer.Base := MasterSet.FBase;
      Viewer.LoadStream(Source, TheStream, TheStreamType);
      Viewer.PositionTo(Destination);
      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 '+Source;
    Viewer.LoadFromBuffer(@Msg[1], Length(Msg), '');  {load an error message}
    end;
  Dec(MasterSet.NestLevel);
  end
else
  begin  {so blank area will perform like the TFrameBrowser}
  OnMouseDown := MasterSet.FrameViewer.OnMouseDown;
  OnMouseMove := MasterSet.FrameViewer.OnMouseMove;
  OnMouseUp := MasterSet.FrameViewer.OnMouseUp;
  end;
end;

{----------------TbrFrame.ReloadFiles}
procedure TbrFrame.ReloadFiles(APosition: LongInt);
var
  Item: TbrFrameBase;
  I: integer;
  Upper, Lower: boolean;
  Dummy: string;

  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 := TbrFrameBase(List.Items[I]);
        Item.ReloadFiles(APosition);
        end;
      CheckNoresize(Lower, Upper);
      end;
    end
  else if Assigned(Viewer) then
    begin
    Viewer.Base := MasterSet.FBase;  {only effective if no Base to be read}
    try     
      if Assigned(MasterSet.FrameViewer.FOnGetPostRequestEx) then   
        MasterSet.FrameViewer.FOnGetPostRequestEx(Self, True, Source, '', '', '',False,
                                     Dummy, TheStreamType, TheStream)
      else
        MasterSet.FrameViewer.FOnGetPostRequest(Self, True, Source, '', False,
                                     Dummy, TheStreamType, TheStream);
      Viewer.LoadStream(Source, TheStream, TheStreamType);
      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;
Unloaded := False;
end;

{----------------TbrFrame.UnloadFiles}
procedure TbrFrame.UnloadFiles;
var
  Item: TbrFrameBase;
  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 := TbrFrameBase(List.Items[I]);
      Item.UnloadFiles;
      end;
    end;
  end
else if Assigned(Viewer) then
  begin
  ViewerPosition := Viewer.Position;
  ViewerFormData := Viewer.FormData;    
  if Assigned(MasterSet.FrameViewer.FOnViewerClear) then
    MasterSet.FrameViewer.FOnViewerClear(Viewer);
  Viewer.Clear;
  if MasterSet.FActive = Viewer then
    MasterSet.FActive := Nil;             
  Viewer.OnSoundRequest := Nil;
  end;
Unloaded := True;
end;

{----------------TbrFrame.frLoadFromBrzFile}
procedure TbrFrame.frLoadFromBrzFile(const URL, Dest, Query, EncType, Referer: string; Bump, IsGet, Reload: boolean);
{URL is full URL here, has been seperated from Destination}
var
  OldPos: LongInt;
  HS, S, S1, OldTitle, OldName, OldBase: string;
  OldFormData: TFreeList;     
  SameName: boolean;
  OldViewer: ThtmlViewer;
  OldFrameSet: TbrSubFrameSet;
  TheString: string;   
  Upper, Lower, FrameFile: boolean;