framview.pas

查看html文件的控件

{Version 9.4}
{*********************************************************}
{*                     FRAMVIEW.PAS                      *}
{*              Copyright (c) 1995-2006 by               *}
{*                   L. David Baldwin                    *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$i htmlcons.inc}

unit FramView;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, StdCtrls, ExtCtrls, Menus, htmlsubs, htmlview, htmlun2,
  readHTML;

type
  {common to TFrameViewer and TFrameBrowser}
  THotSpotTargetClickEvent = procedure(Sender: TObject; const Target, URL: string;
                     var Handled: boolean) of Object;
  THotSpotTargetEvent = procedure(Sender: TObject; const Target, URL: string) of Object;
  TWindowRequestEvent = procedure(Sender: TObject; const Target, URL: string) of Object;
  fvOptionEnum = (fvMetaRefresh, fvNoBorder, fvNoLinkUnderline, fvOverLinksActive,
                  fvPrintMonochromeBlack, fvPrintTableBackground, fvPrintBackground,  
                  fvShowVScroll, fvNoFocusRect, fvShowDummyCaret, fvNoWheelMouse);
  TFrameViewerOptions = set of fvOptionEnum;

  {for TFrameViewer}
  TStreamRequestEvent = procedure(Sender: TObject; const SRC: string;
                           var Stream: TStream) of Object;
  TBufferRequestEvent = procedure(Sender: TObject; const SRC: string;
                           var Buffer: PChar; var BuffSize: integer) of Object;
  TStringsRequestEvent = procedure(Sender: TObject; const SRC: string;
                           var Strings: TStrings) of Object;
  TFileRequestEvent = procedure(Sender: TObject; const SRC: string;
                           var NewName: string) of Object;
  EfvLoadError = class(Exception);

{common base class for TFrameViewer and TFrameBrowser}
  TFVBase = class(TFrameViewerBase)  {TFrameViewerBase is in ReadHTML.pas}
  protected
    FURL: string;
    FTarget: string;
    FLinkText: string;  
    FLinkAttributes: TStringList;  
    FOnHotSpotTargetClick: THotSpotTargetClickEvent;
    FOnHotSpotTargetCovered: THotSpotTargetEvent;
    ProcessList: TList;   {list of viewers that are processing}
    FViewImages: boolean;
    FImageCacheCount: integer;
    FBitmapList: TStringBitmapList;
    FProcessing, FViewerProcessing: boolean;
    FNoSelect: boolean;
    FOnHistoryChange: TNotifyEvent;
    FOnBitmapRequest: TGetBitmapEvent;
    FOnImageRequest: TGetImageEvent;
    FOnBlankWindowRequest: TWindowRequestEvent;
    FOnMeta: TMetaType;
    FOnScript: TScriptEvent;
    FOnImageClick: TImageClickEvent;
    FOnImageOver: TImageOverEvent;
    FOnFileBrowse: TFileBrowseEvent;  
    FOnObjectClick: TObjectClickEvent;
    FOnObjectFocus: ThtObjectEvent;
    FOnObjectBlur: ThtObjectEvent;
    FOnObjectChange: ThtObjectEvent; 
    FOnRightClick: TRightClickEvent;
    FOnMouseDouble: TMouseEvent;
    FServerRoot: string;
    FOnInclude: TIncludeType;
    FOnSoundRequest: TSoundType;
    FPrintMarginLeft,
    FPrintMarginRight,
    FPrintMarginTop,
    FPrintMarginBottom: double;
    FMarginWidth, FMarginHeight: integer;   
    FOnPrintHeader, FOnPrintFooter: TPagePrinted;
    FOnPrintHTMLHeader, FOnPrintHTMLFooter: ThtmlPagePrinted;  
    FVisitedMaxCount: integer;
    FBackground: TColor;
    FFontName: string;
    FPreFontName: string;
    FFontColor: TColor;
    FHotSpotColor, FVisitedColor, FOverColor: TColor; 
    FFontSize: integer;
    FCursor: TCursor;
    FHistoryMaxCount: integer;
    {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
    FCharset: TFontCharset;
    {$endif}
    FOnProcessing: TProcessingEvent;
    FHistory, FTitleHistory: TStrings;
    FDither: boolean;
    FOnPanelCreate: TPanelCreateEvent;   
    FOnPanelDestroy: TPanelDestroyEvent;   
    FOnPanelPrint: TPanelPrintEvent;    
    Visited: TStringList;     {visited URLs}
    FOnDragDrop: TDragDropEvent;  
    FOnDragOver: TDragOverEvent;
    FViewerList: TStrings;    
    FOnParseBegin: TParseEvent;
    FOnParseEnd: TNotifyEvent;
    FPrintScale: double;
    FOnObjectTag: TObjectTagEvent;  

    function GetCurViewerCount: integer; virtual; abstract;
    function GetCurViewer(I: integer): ThtmlViewer; virtual; abstract;
    function GetFURL: string;
    function GetProcessing: boolean;
    function GetTarget: String;
    procedure SetViewImages(Value: boolean);
    procedure SetImageCacheCount(Value: integer);
    procedure SetNoSelect(Value: boolean);
    procedure SetOnBitmapRequest(Handler: TGetBitmapEvent);
    procedure SetOnMeta(Handler: TMetaType);
    procedure SetOnLink(Handler: TLinkType);
    procedure SetOnScript(Handler: TScriptEvent);
    procedure SetImageOver(Handler: TImageOverEvent);
    procedure SetImageClick(Handler: TImageClickEvent);
    procedure SetOnFileBrowse(Handler: TFileBrowseEvent);  
    procedure SetOnObjectClick(Handler: TObjectClickEvent);
    procedure SetOnObjectFocus(Handler: ThtObjectEvent);
    procedure SetOnObjectBlur(Handler: ThtObjectEvent);
    procedure SetOnObjectChange(Handler: ThtObjectEvent);  
    procedure SetOnRightClick(Handler: TRightClickEvent);
    procedure SetMouseDouble(Handler: TMouseEvent);  
    procedure SetServerRoot(Value: string);
    procedure SetPrintMarginLeft(Value: Double);
    procedure SetPrintMarginRight(Value: Double);
    procedure SetPrintMarginTop(Value: Double);
    procedure SetPrintMarginBottom(Value: Double);
    procedure SetPrintScale(Value: double);
    procedure SetPrintHeader(Handler: TPagePrinted);
    procedure SetPrintFooter(Handler: TPagePrinted);
    procedure SetPrintHtmlHeader(Handler: THtmlPagePrinted);
    procedure SetPrintHtmlFooter(Handler: THtmlPagePrinted);
    procedure SetMarginHeight(Value: integer);
    procedure SetMarginWidth(Value: integer);   
    procedure SetVisitedMaxCount(Value: integer);
    procedure SetColor(Value: TColor);
    function GetFontName: TFontName;
    procedure SetFontName(Value: TFontName);
    function GetPreFontName: TFontName;
    procedure SetPreFontName(Value: TFontName);
    procedure SetFontSize(Value: integer);
    procedure SetFontColor(Value: TColor);
    procedure SetHotSpotColor(Value: TColor);
    procedure SetActiveColor(Value: TColor);
    procedure SetVisitedColor(Value: TColor);
    procedure SetHistoryMaxCount(Value: integer);
    procedure SetCursor(Value: TCursor);
    function GetSelLength: integer;
    procedure SetSelLength(Value: integer);
    function GetSelStart: integer;
    procedure SetSelStart(Value: integer);
    {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
    procedure SetCharset(Value: TFontCharset);
    {$endif}
    function GetOurPalette: HPalette;
    procedure SetOurPalette(Value: HPalette);
    procedure SetDither(Value: boolean);
    function GetCaretPos: integer;
    procedure SetCaretPos(Value: integer);
    function GetSelText: WideString;   
    function GetSelTextBuf(Buffer: PWideChar; BufSize: integer): integer;
    procedure SetProcessing(Local, Viewer: boolean);
    procedure CheckProcessing(Sender: TObject; ProcessingOn: boolean);
    procedure SetOnPanelCreate(Handler: TPanelCreateEvent);
    procedure SetOnPanelDestroy(Handler: TPanelDestroyEvent);
    procedure SetOnPanelPrint(Handler: TPanelPrintEvent);  
    procedure SetOnParseBegin(Handler: TParseEvent);
    procedure SetOnParseEnd(Handler: TNotifyEvent);
    procedure SetOnObjectTag(Handler: TObjectTagEvent);  

    function GetActiveViewer: ThtmlViewer;  virtual; abstract;
    function GetViewers: TStrings;  virtual; abstract; 

    property CurViewer[I: integer]: ThtmlViewer read GetCurViewer;
    property OnBitmapRequest: TGetBitmapEvent read FOnBitmapRequest
             write SetOnBitmapRequest;
    property ServerRoot: string read FServerRoot write SetServerRoot;
  public
    procedure ClearHistory; virtual; abstract;
    procedure SetFocus; override;
    function InsertImage(Viewer: ThtmlViewer; const Src: string; Stream: TMemoryStream): boolean;
    function NumPrinterPages: integer; overload;
    function NumPrinterPages(var WidthRatio: double): integer; overload;
    procedure Print(FromPage, ToPage: integer);

    property URL: string read GetFURL;
    property Target: string read GetTarget;
    property Processing: boolean read GetProcessing;
    property ActiveViewer: ThtmlViewer read GetActiveViewer;
    property History: TStrings read FHistory;
    property TitleHistory: TStrings read FTitleHistory;
    property Palette: HPalette read GetOurPalette write SetOurPalette;
    property Dither: boolean read FDither write SetDither default True;
    property CaretPos: integer read GetCaretPos write SetCaretPos;
    property SelLength: integer read GetSelLength write SetSelLength;  
    property SelStart: integer read GetSelStart write SetSelStart;
    property SelText: WideString read GetSelText;  
    procedure CopyToClipboard;
    procedure SelectAll;
    function FindEx(const S: WideString; MatchCase, Reverse: boolean): boolean;  
    function Find(const S: WideString; MatchCase: boolean): boolean;
    property Viewers: TStrings read GetViewers;
    property LinkText: string read FLinkText;   
    property LinkAttributes: TStringList read FLinkAttributes;  

  published
    property OnHotSpotTargetCovered: THotSpotTargetEvent read FOnHotSpotTargetCovered
             write FOnHotSpotTargetCovered;
    property OnHotSpotTargetClick: THotSpotTargetClickEvent read FOnHotSpotTargetClick
             write FOnHotSpotTargetClick;
    property ViewImages: boolean read FViewImages write SetViewImages default True;
    property ImageCacheCount: integer read FImageCacheCount
             write SetImageCacheCount default 5;
    property OnHistoryChange: TNotifyEvent read FOnHistoryChange
             write FOnHistoryChange;
    property NoSelect: boolean read FNoSelect write SetNoSelect;

    property OnBlankWindowRequest: TWindowRequestEvent read FOnBlankWindowRequest
             write FOnBlankWindowRequest;
    property OnScript: TScriptEvent read FOnScript write SetOnScript;
    property OnImageClick: TImageClickEvent read FOnImageClick write SetImageClick;
    property OnImageOver: TImageOverEvent read FOnImageOver write SetImageOver;
    property OnFileBrowse: TFileBrowseEvent read FOnFileBrowse write SetOnFileBrowse;  
    property OnObjectClick: TObjectClickEvent read FOnObjectClick write SetOnObjectClick;
    property OnObjectFocus: ThtObjectEvent read FOnObjectFocus write SetOnObjectFocus;
    property OnObjectBlur: ThtObjectEvent read FOnObjectBlur write SetOnObjectBlur;
    property OnObjectChange: ThtObjectEvent read FOnObjectChange write SetOnObjectChange;  
    property OnRightClick:  TRightClickEvent read FOnRightClick write SetOnRightClick;
    property OnMouseDouble: TMouseEvent read FOnMouseDouble write SetMouseDouble;  
    property OnInclude: TIncludeType read FOnInclude write FOnInclude;
    property OnSoundRequest: TSoundType read FOnSoundRequest write FOnSoundRequest;
    property PrintMarginLeft: double read FPrintMarginLeft write SetPrintMarginLeft;
    property PrintMarginRight: double read FPrintMarginRight write SetPrintMarginRight;
    property PrintMarginTop: double read FPrintMarginTop write SetPrintMarginTop;
    property PrintMarginBottom: double read FPrintMarginBottom write SetPrintMarginBottom;
    property PrintScale: double read FPrintScale write SetPrintScale;
    property MarginWidth: integer read FMarginWidth write SetMarginWidth default 10;   
    property MarginHeight: integer read FMarginHeight write SetMarginHeight default 5;   
    property OnPrintHeader: TPagePrinted read FOnPrintHeader write SetPrintHeader;
    property OnPrintFooter: TPagePrinted read FOnPrintFooter write SetPrintFooter;
    property OnPrintHTMLHeader: ThtmlPagePrinted read FOnPrintHTMLHeader write SetPrintHTMLHeader;
    property OnPrintHTMLFooter: ThtmlPagePrinted read FOnPrintHTMLFooter write SetPrintHTMLFooter;
    property OnMeta: TMetaType read FOnMeta write SetOnMeta;
    property OnLink: TLinkType read FOnLink write SetOnLink;
    property OnPanelCreate: TPanelCreateEvent read FOnPanelCreate write SetOnPanelCreate;
    property OnPanelDestroy: TPanelDestroyEvent read FOnPanelDestroy write SetOnPanelDestroy;
    property OnPanelPrint: TPanelPrintEvent read FOnPanelPrint write SetOnPanelPrint;   
    property OnParseBegin: TParseEvent read FOnParseBegin write SetOnParseBegin;
    property OnParseEnd: TNotifyEvent read FOnParseEnd write SetOnParseEnd;

    property DefBackground: TColor read FBackground write SetColor default clBtnFace;

    property DefFontName: TFontName read GetFontName write SetFontName;
    property DefPreFontName: TFontName read GetPreFontName write SetPreFontName;
    property DefFontSize: integer read FFontSize write SetFontSize default 12;
    property DefFontColor: TColor read FFontColor write SetFontColor
             default clBtnText;
    property DefHotSpotColor: TColor read FHotSpotColor write SetHotSpotColor
             default clBlue;
    property DefVisitedLinkColor: TColor read FVisitedColor write SetVisitedColor
             default clPurple;       
    property DefOverLinkColor: TColor read FOverColor write SetActiveColor
             default clBlue;        
    property VisitedMaxCount: integer read FVisitedMaxCount write SetVisitedMaxCount default 50; 
    property HistoryMaxCount: integer read FHistoryMaxCount write SetHistoryMaxCount;
    property Cursor: TCursor read FCursor write SetCursor default crIBeam;
    {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
    property CharSet: TFontCharset read FCharSet write SetCharset;
    {$endif}
    property OnProcessing: TProcessingEvent read FOnProcessing write FOnProcessing;
    property OnObjectTag:  TObjectTagEvent read FOnObjectTag write SetOnObjectTag; 


    property Align;
    {$ifdef ver120_plus}
    property Anchors;     
    {$endif}
    property Enabled;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default False;
    property Visible;
    property Height default 150;
    property Width default 150;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnKeyDown;
    property OnKeyUp;
    property OnKeyPress;
  end;

{TFrameViewer Types}
  PEventRec = ^EventRec;    
  EventRec = record
    LStyle: LoadStyleType;
    NewName: string;
    AString: string;    
    end;

  TFrameSet = class;
  TSubFrameSet = class;

  TFrameBase = class(TCustomPanel)   {base class for other classes}
    MasterSet: TFrameSet;   {Points to top (master) TFrameSet}
  private
    UnLoaded: boolean;
    procedure UpdateFrameList; virtual; abstract;
  protected
    {$ifdef ver100_plus}  {Delphi 3,4,5, C++Builder 3, 4}
    LocalCharSet: TFontCharset;
    {$endif}
    procedure FVMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual; abstract;
    procedure FVMouseMove(Sender: TObject; Shift: TShiftState; X,
           Y: Integer); virtual; abstract;
    procedure FVMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X, Y: Integer); virtual; abstract;
    function CheckNoResize(var Lower, Upper: boolean): boolean; virtual; abstract;
    procedure LoadFiles(PEV: PEventRec); virtual; abstract;
    procedure ReLoadFiles(APosition: integer); virtual; abstract;
    procedure UnloadFiles; virtual; abstract;

  public
    LOwner: TSubFrameSet;
    procedure InitializeDimensions(X, Y, Wid, Ht: integer); virtual; abstract;
  end;

  TfvFrame = class(TFrameBase) {TfvFrame holds a ThtmlViewer or TSubFrameSet}
  protected
    NoScroll: boolean;
    frMarginHeight, frMarginWidth: integer;   
    frHistory: TStringList;
    frPositionHistory: TFreeList;
    frHistoryIndex: integer;
    RefreshTimer: TTimer;
    NextFile: string;

    procedure CreateViewer;
    procedure frBumpHistory(const NewName: string; NewPos, OldPos: integer;
                  OldFormData: TFreeList);  
    procedure frBumpHistory1(const NewName: string; Pos: integer);
    procedure frSetHistoryIndex(Value: integer);
    procedure UpdateFrameList; override;
    procedure RefreshEvent(Sender: TObject; Delay: integer; const URL: string);
    procedure RefreshTimerTimer(Sender: TObject);

  protected
    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;
    function CheckNoResize(var Lower, Upper: boolean): boolean; override;
    procedure LoadFiles(PEV: PEventRec); override;
    procedure ReLoadFiles(APosition: integer); override;
    procedure UnloadFiles; override;
    procedure frLoadFromFile(const FName, Dest: string; Bump, Reload: boolean);  
    procedure ReloadFile(const FName: string; APosition: integer);
  public
    Viewer: ThtmlViewer;    {the ThtmlViewer it holds if any}
    ViewerPosition: integer;
    ViewerFormData: TFreeList;   
    FrameSet: TSubFrameSet; {or the TSubFrameSet it holds}
    Source,         {Dos filename or URL for this frame}
    OrigSource,      {Original Source name}  
    Destination: string;    {Destination offset for this frame}
    WinName: string;     {window name, if any, for this frame}