framview.pas

查看html文件的控件

    NoReSize: boolean;

    constructor CreateIt(AOwner: TComponent; L: TAttributeList;
              Master: TFrameSet; const Path: string);
    destructor Destroy; override;
    procedure InitializeDimensions(X, Y, Wid, Ht: integer); override;
    procedure Repaint; override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;  
  end;

  TSubFrameSet = class(TFrameBase)  {can contain one or more TFrames and/or TSubFrameSets}
  Protected
    FBase: string;
    FBaseTarget: string;
    OuterBorder: integer;
    BorderSize: integer;
    FRefreshURL: string;
    FRefreshDelay: integer;
    RefreshTimer: TTimer;
    NextFile: string;

    procedure ClearFrameNames;
    procedure AddFrameNames;
    procedure UpdateFrameList; override;
    procedure HandleMeta(Sender: TObject; const HttpEq, Name, Content: string);
    procedure SetRefreshTimer;
    procedure RefreshTimerTimer(Sender: Tobject); virtual;
  protected
    OldRect: TRect;
    function GetRect: TRect;
    procedure FVMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure FVMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer); override;
    procedure FVMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); override;
    procedure FindLineAndCursor(Sender: TObject; X, Y: integer);
    function NearBoundary(X, Y: integer): boolean;
    function CheckNoResize(var Lower, Upper: boolean): boolean; override;
    procedure Clear; virtual;
    procedure LoadFromFile(const FName, Dest: string);
  public
    First: boolean;     {First time thru}
    Rows: boolean;          {set if row frameset, else column frameset}
    List: TFreeList;   {list of TFrames and TSubFrameSets in this TSubFrameSet}
    Dim,    {col width or row height as read.  Blanks may have been added}
    DimF,   {col width or row height in pixels as calculated and displayed}
    Lines   {pixel pos of lines, Lines[1]=0, Lines[DimCount]=width|height}
         : array[0..20] of SmallInt;
    Fixed   {true if line not allowed to be dragged}
         : array[0..20] of boolean;
    DimCount: integer;
    DimFTot: integer;
    LineIndex: integer;

    constructor CreateIt(AOwner: TComponent; Master: TFrameSet);
    destructor Destroy; override;
    function AddFrame(Attr: TAttributeList; const FName: string): TfvFrame;
    procedure EndFrameSet; virtual;
    procedure DoAttributes(L: TAttributeList);
    procedure LoadFiles(PEV: PEventRec); override;
    procedure ReLoadFiles(APosition: integer); override;
    procedure UnloadFiles; override;
    procedure InitializeDimensions(X, Y, Wid, Ht: integer); override;
    procedure CalcSizes(Sender: TObject);
  end;

  TFrameViewer = class;

  TFrameSet = class(TSubFrameSet)  {only one of these showing, others may be held as History}
  protected
    FTitle: string;
    FCurrentFile: string;
    FrameNames: TStringList; {list of Window names and their TFrames}
    Viewers: TList;   {list of all ThtmlViewer pointers}
    Frames: TList;    {list of all the Frames contained herein}
    HotSet: TFrameBase;     {owner of line we're moving}
    OldWidth, OldHeight: integer;
    NestLevel: integer;
    FActive: ThtmlViewer;   {the most recently active viewer}

    function RequestEvent: boolean;
    function TriggerEvent(const Src: string; PEV: PEventRec): boolean;
    procedure ClearForwards;
    procedure UpdateFrameList; override;
    procedure RefreshTimerTimer(Sender: Tobject); override;

  protected
    procedure FVMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer); override;
    procedure CheckActive(Sender: TObject);
    function GetActive: ThtmlViewer;
  public
    FrameViewer: TFrameViewer;

    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure EndFrameSet; override;
    procedure LoadFromFile(const FName, Dest: string);
    procedure Clear; override;
    procedure CalcSizes(Sender: TObject);
    procedure Repaint; override;
  end;

  TFrameViewer = class(TFVBase)
  protected
    FPosition: TList;
    FHistoryIndex: integer;
    FOnFormSubmit: TFormSubmitEvent;
    FOptions: TFrameViewerOptions;
    UrlRequestStream: TMemoryStream;  

    FOnStreamRequest: TStreamRequestEvent;
    FOnBufferRequest: TBufferRequestEvent;
    FOnStringsRequest: TStringsRequestEvent;
    FOnFileRequest: TFileRequestEvent;
    FOnProgress: ThtProgressEvent;

    FBaseEx: string;

    procedure SetOnImageRequest(Handler: TGetImageEvent);

    function GetBase: string;
    procedure SetBase(Value: string);
    function GetBaseTarget: string;
    function GetTitle: string;
    function GetCurrentFile: string;
    procedure HotSpotCovered(Sender: TObject; const SRC: string);
    procedure SetHistoryIndex(Value: integer);

    procedure SetOnFormSubmit(Handler: TFormSubmitEvent);
    procedure ChkFree(Obj: TObject);
    function GetActiveBase: string;
    function GetActiveTarget: string;
    function GetFwdButtonEnabled: boolean;
    function GetBackButtonEnabled: boolean;
    procedure SetOptions(Value: TFrameViewerOptions);
    procedure fvDragDrop(Sender, Source: TObject; X, Y: Integer);  
    procedure fvDragOver(Sender, Source: TObject; X, Y: Integer;
      State: TDragState; var Accept: Boolean);
    procedure SetDragDrop(const Value: TDragDropEvent);
    procedure SetDragOver(const Value: TDragOverEvent);
    function GetViewers: TStrings;  override;
    procedure SetOnProgress(Handler: ThtProgressEvent);   

  protected
    CurFrameSet: TFrameSet;  {the TFrameSet being displayed}

    function GetCurViewerCount: integer; override;
    function GetCurViewer(I: integer): ThtmlViewer; override;
    function GetActiveViewer: ThtmlViewer;  override;


    procedure BumpHistory(OldFrameSet: TFrameSet; OldPos: integer);
    procedure BumpHistory1(const FileName, Title: string;
                 OldPos: integer; ft: ThtmlFileType);
    procedure BumpHistory2(OldPos: integer);
    function HotSpotClickHandled: boolean;
    procedure LoadFromFileInternal(const FName: string);

    procedure AddFrame(FrameSet: TObject; Attr: TAttributeList; const FName: string); override;
    function CreateSubFrameSet(FrameSet: TObject): TObject; override;
    procedure DoAttributes(FrameSet: TObject; Attr: TAttributeList); override;
    procedure EndFrameSet(FrameSet: TObject); override;
    procedure AddVisitedLink(const S: string);
    procedure CheckVisitedLinks;
    procedure DoURLRequest(Sender: TObject; const SRC: string; var RStream: TMemoryStream);

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure LoadFromFile(const FName: string);
    procedure Load(const SRC: string);
    procedure LoadTargetFromFile(const Target, FName: string);
    procedure LoadImageFile(const FName: string);
    procedure Reload;
    procedure Clear;
    procedure HotSpotClick(Sender: TObject; const AnURL: string;
              var Handled: boolean);
    function HTMLExpandFilename(const Filename: string): string; virtual;
    procedure ClearHistory; override;
    function ViewerFromTarget(const Target: string): ThtmlViewer;
    procedure GoBack;
    procedure GoFwd;
    procedure Repaint; override;

    property Base: string read GetBase write SetBase;
    property BaseTarget: string read GetBaseTarget;
    property DocumentTitle: string read GetTitle;
    property CurrentFile: string read GetCurrentFile;
    property HistoryIndex: integer read FHistoryIndex write SetHistoryIndex;

  published
    property OnImageRequest: TGetImageEvent read FOnImageRequest
             write SetOnImageRequest;
    property OnFormSubmit: TFormSubmitEvent read FOnFormSubmit
             write SetOnFormSubmit;
    property FwdButtonEnabled: boolean read GetFwdButtonEnabled;
    property BackButtonEnabled: boolean read GetBackButtonEnabled;
    property fvOptions: TFrameViewerOptions read FOptions write SetOptions
                 default [fvPrintTableBackground, fvPrintMonochromeBlack];

    property OnStreamRequest: TStreamRequestEvent read FOnStreamRequest write FOnStreamRequest;
    property OnStringsRequest: TStringsRequestEvent read FOnStringsRequest write FOnStringsRequest;
    property OnBufferRequest: TBufferRequestEvent read FOnBufferRequest write FOnBufferRequest;
    property OnFileRequest: TFileRequestEvent read FOnFileRequest write FOnFileRequest;

    property OnBitmapRequest;
    property ServerRoot;
    property OnDragDrop: TDragDropEvent read FOnDragDrop write SetDragDrop;  
    property OnDragOver: TDragOverEvent read FOnDragOver write SetDragOver;
    property OnProgress: ThtProgressEvent read FOnProgress write SetOnProgress; 
  end;

implementation

const
  Sequence: integer = 10;

type
  PositionObj = class(TObject)
    Pos: integer;
    Seq: integer;
    FormData: TFreeList;
    destructor Destroy; override;
    end;

function ImageFile(Const S: string): boolean;
var
  Ext: string[5];
begin
Ext := Lowercase(ExtractFileExt(S));
Result := (Ext = '.gif') or (Ext = '.jpg') or (Ext = '.jpeg') or (Ext = '.bmp')
       or (Ext = '.png');
end;

function TexFile(Const S: string): boolean;
var
  Ext: string[5];
begin
Ext := Lowercase(ExtractFileExt(S));
Result := (Ext = '.txt');
end;

{----------------FileToString}
function FileToString(const Name: String): string;      
var
  FS: TFileStream;
begin
Result := '';
FS := TFileStream.Create(Name, fmOpenRead or fmShareDenyWrite);
try
  SetLength(Result, FS.Size);
  FS.ReadBuffer(Result[1], FS.Size);
finally
  FS.Free;
  end;
end;

{----------------SplitURL}
procedure SplitURL(const Src: string; var FName, Dest: string);
{Split an URL into filename and Destination}
var
  I: integer;
begin
I := Pos('#', Src);
if I >= 1 then
  begin
  Dest := System.Copy(Src, I, 255);  {local destination}
  FName := System.Copy(Src, 1, I-1);     {the file name}
  end
else
  begin
  FName := Src;
  Dest := '';    {no local destination}
  end;
end;

{----------------TfvFrame.CreateIt}
constructor TfvFrame.CreateIt(AOwner: TComponent; L: TAttributeList;
                   Master: TFrameSet; const Path: string);
var
  I: integer;
  S, Dest: string;
begin
inherited Create(AOwner);
{$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
if AOwner is TSubFrameSet then
  LocalCharSet := TSubFrameset(AOwner).LocalCharSet;     
{$endif}
LOwner := AOwner as TSubFrameSet;
MasterSet := Master;
BevelInner := bvNone;
frMarginWidth := MasterSet.FrameViewer.MarginWidth;  
frMarginHeight := MasterSet.FrameViewer.MarginHeight;  
if LOwner.BorderSize = 0 then
  BevelOuter := bvNone
else
  begin
  BevelOuter := bvLowered;      
  BevelWidth := LOwner.BorderSize;
  end;
ParentColor := True;
if Assigned(L) then
  for I := 0 to L.Count-1 do
    with TAttribute(L[I]) do
      case Which of
        SrcSy:
          begin
          SplitUrl(Trim(Name), S, Dest);
          Destination := Dest;
          if not Master.RequestEvent then
            begin
            S := HTMLServerToDos(S, Master.FrameViewer.ServerRoot);
            if Pos(':', S) = 0 then
              begin
              if ReadHTML.Base <> '' then   {a Base was found}
                if CompareText(ReadHTML.Base, 'DosPath') = 0 then
                   S := ExpandFilename(S)
                else
                  S := ExtractFilePath(HTMLToDos(ReadHTML.Base)) + S
              else S := Path + S;
              end;
            end;
          Source := S;
          OrigSource := S;     
          end;
        NameSy: WinName := Name;
        NoResizeSy:  NoResize := True;
        ScrollingSy:
          if CompareText(Name, 'NO') = 0 then  {auto and yes work the same}
            NoScroll := True;
        MarginWidthSy:  frMarginWidth := Value;
        MarginHeightSy: frMarginHeight := Value;
        end;
if WinName <> '' then   {add it to the Window name list}
  (AOwner as TSubFrameSet).MasterSet.FrameNames.AddObject(Uppercase(WinName), Self);
OnMouseDown := FVMouseDown;
OnMouseMove := FVMouseMove;
OnMouseUp := FVMouseUp;
frHistory := TStringList.Create;
frPositionHistory := TFreeList.Create;
end;

{----------------TfvFrame.Destroy}
destructor TfvFrame.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;