htmlsubs.pas

查看html文件的控件

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

{$i htmlcons.inc}
                                  
{
This module is comprised mostly of the various Section object definitions.
As the HTML document is parsed, it is divided up into sections.  Some sections
are quite simple, like TParagraphSpace.  Others are more complex such as
TSection which can hold a complete paragraph.

The HTML document is then stored as a list, TSectionList, of the various
sections.

Closely related to TSectionList is TCell.  TCell holds the list of sections for
each cell in a Table (the ThtmlTable section).  In this way each table cell may
contain a document of it's own.

The Section objects each store relevant data for the section such as the text,
fonts, images, and other info needed for formating.

Each Section object is responsible for its own formated layout.  The layout is
done in the DrawLogic method.  Layout for the whole document is done in the
TSectionList.DoLogic method which essentially just calls all the Section
DrawLogic's.  It's only necessary to call TSectionList.DoLogic when a new
layout is required (when the document is loaded or when its width changes).

Each Section is also responsible for drawing itself (its Draw method).  The
whole document is drawn with the TSectionList.Draw method.
}

unit Htmlsubs;
{$R HTML32.Res}

interface
uses
  SysUtils, WinTypes, Windows, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, Dialogs, StdCtrls, ExtCtrls, HTMLUn2, HTMLGif2, mmSystem,
  {$ifdef UseTNT}    
  TntStdCtrls,
  {$endif}
  {$ifdef UseElPack}
  ElListBox, ElCombos, ElEdits, ElPopBtn,
  {$endif}
  StyleUn;

type
  {$ifdef UseTNT} 
  ThtEdit = TTntEdit;
  ThtButton = TTntButton;
  ThtMemo = TTntMemo;
  ThtCombobox = TTntCombobox;
  ThtListbox = TTntListbox;
  {$else}
    {$ifdef UseElPack}  
    ThtEdit = TElEdit;
    ThtButton = TElPopupButton;
    ThtMemo = TElMemo;
    ThtCombobox = TElCombobox;
    ThtListbox = TElListbox;    
    {$else}
    ThtEdit = TEdit;
    ThtButton = TButton;
    ThtMemo = TMemo;
    ThtCombobox = TCombobox;
    ThtListbox = TListbox;
    {$endif}
  {$endif}

  ThvPanel = Class(TPanel)
  public
    FVisible: boolean;
    procedure SetVisible(Value: boolean);
    property Visible: boolean read FVisible write SetVisible default True;
  end;

  TLinkDrawnEvent = procedure(Sender: TObject; Page: integer; const Url, Target: string;  
                        ARect: TRect) of Object;  
  TFileBrowseEvent = procedure(Sender, Obj: TObject; var S: string) of Object;
  TGetBitmapEvent = procedure(Sender: TObject; const SRC: string;
                    var Bitmap: TBitmap; var Color: TColor) of Object;
  TGetImageEvent = procedure(Sender: TObject; const SRC: string;
                    var Stream: TMemoryStream) of Object;
  TFormSubmitEvent = procedure(Sender: TObject; const Action, Target, EncType, Method: string;
                    Results: TStringList) of Object;
  TPanelCreateEvent = procedure(Sender: TObject; const AName, AType, SRC: string; 
                        Panel: ThvPanel) of Object;
  TPanelDestroyEvent = procedure(Sender: TObject; Panel: ThvPanel) of Object;
  TPanelPrintEvent = procedure(Sender: TObject; Panel: ThvPanel; const Bitmap: TBitmap) of Object;
  TObjectTagEvent = procedure(Sender: TObject; Panel: ThvPanel;
                 const Attributes, Params: TStringList; 
                        var WantPanel: boolean) of Object;                 
  TObjectClickEvent = procedure(Sender, Obj: TObject; const OnClick: string) of Object;
  ThtObjectEvent = procedure(Sender, Obj: TObject; const Attribute: string) of Object;   
  TExpandNameEvent = procedure(Sender: TObject; const SRC: string; var Result: string) of Object;
  guResultType = set of (guUrl, guControl, guTitle);  
  TCell = Class;
  TBlockCell = Class;
  TCellBasic = Class;
  TSectionList = Class;
  TSection = Class;
  TBlock = Class;   

  TFontObj = class(TObject)   {font information}
  private
    Section: TSection;
    FVisited, FHover: boolean;
    Title: string;
    FYValue: integer;
    Active: boolean;
    procedure SetVisited(Value: boolean);
    procedure SetHover(Value: boolean);
    function GetURL: string;
    procedure SetAllHovers(List: TList; Value: boolean);
    procedure CreateFIArray;
    {$ifndef NoTabLink}
    procedure EnterEvent(Sender: TObject);  
    procedure ExitEvent(Sender: TObject);  
    procedure CreateTabControl(TabIndex: integer);     
    procedure AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure AssignY(Y: integer);   
    {$endif}
  public
    Pos : integer;        {0..Len  Index where font takes effect}
    TheFont : TMyFont;
    FIArray: TFontInfoArray;
    FontHeight,       {tmHeight+tmExternalLeading}
    tmHeight, tmMaxCharWidth,
    Overhang, Descent : integer;
    SScript: AlignmentType;
    UrlTarget: TUrlTarget;
    TabControl: TWinControl;
    constructor Create(ASection: TSection; F: TMyFont; Position: integer);
    constructor CreateCopy(ASection: TSection; T: TFontObj);
    destructor Destroy; override;
    procedure ReplaceFont(F: TMyFont);
    procedure ConvertFont(FI: ThtFontInfo);  
    procedure FontChanged;
    function GetOverhang : integer;
    function GetHeight(var Desc: integer): integer;

    property URL: string read GetURL;
    property Visited: boolean read FVisited Write SetVisited;
    property Hover: boolean read FHover Write SetHover;
    property YValue: integer read FYValue;  
  end;

  TFontList = class(TFreeList)  {a list of TFontObj's}
  Public
    constructor CreateCopy(ASection: TSection; T: TFontList);
    function GetFontAt(Posn : integer; var OHang : integer) : TMyFont;
    function GetFontCountAt(Posn, Leng : integer) : integer;
    function GetFontObjAt(Posn : integer;
                      var Index : integer) : TFontObj;
    procedure Decrement(N: integer; ParentSectionList: TSectionList);
  end;

  TImageFormControlObj = class;

  TFloatingObj = class(TIDObject)
  protected
    Pos : integer;        {0..Len  index of image position}
    ImageHeight,          {does not include VSpace}
    ImageWidth: integer;
    ObjAlign: AlignmentType;
    Indent: integer;
    HSpaceL, HSpaceR, VSpaceT, VSpaceB:  integer;  {horizontal, vertical extra space}
    SpecWidth: integer;   {as specified by <img or panel> tag}
    SpecHeight: integer;   {as specified by <img or panel> tag}
    PercentWidth: boolean;           {if width is percent}
    PercentHeight: boolean;           {if height is percent}
    ImageTitle:  string;
    FAlt: string;          {the alt= attribute}
    FAltW: WideString;    

    function GetYPosition: integer; override;
  public
    ImageKnown: boolean;      {know size of image}
    DrawYY: integer;
    DrawXX: integer;
    NoBorder: boolean;        {set if don't want blue border}   
    BorderSize: integer;         
    constructor CreateCopy(T: TFloatingObj);
    procedure DrawLogic(SectionList: TSectionList; Canvas: TCanvas;
                  FO: TFontObj; AvailableWidth, AvailableHeight: integer);  virtual; abstract;
    procedure ProcessProperties(Prop: TProperties);  
    property Alt: string read FAlt;    
  end;

  TPanelObj = class(TFloatingObj)
  private
    fMasterList:TSectionList;
    SetWidth, SetHeight: integer; 
    IsCopy: boolean;
  public
    ShowIt: boolean;
    Panel, OPanel: ThvPanel;
    OSender: TObject;
    PanelPrintEvent: TPanelPrintEvent;
    constructor Create(AMasterList: TSectionList; Position: integer;
                    L: TAttributeList; ACell: TCellBasic; ObjectTag: boolean);
    constructor CreateCopy(AMasterList: TSectionList; T: TPanelObj);
    destructor Destroy; override;
    procedure DrawLogic(SectionList: TSectionList; Canvas: TCanvas;
                  FO: TFontObj; AvailableWidth, AvailableHeight: integer);  override; 
    procedure Draw(ACanvas: TCanvas; X1, Y1: integer);
  end;

  HoverType = (hvOff, hvOverUp, hvOverDown);   

  TImageObj = class(TFloatingObj)   {inline image info}
  private
    FBitmap: TBitmap;
    FHover: HoverType;
    FHoverImage: boolean;
    AltHeight, AltWidth: integer;
    Positioning: PositionType;    
    function GetBitmap: TBitmap;
    procedure SetHover(Value: HoverType);
  public
    ObjHeight, ObjWidth: integer;   {width as drawn}
    Source: String;    {the src= attribute}
    Image: TgpObject;  {bitmap possibly converted from GIF, Jpeg, etc or animated GIF}
    OrigImage: TgpObject;  {same as above unless swapped}   
    Mask: TBitmap;    {Image's mask if needed for transparency}
    ParentSectionList: TSectionList;
    Transparent: Transparency;    {None, Lower Left Corner, or Transp GIF}
    IsMap, UseMap: boolean;
    MapName: String;
    MyFormControl: TImageFormControlObj;  {if an <INPUT type=image}
    MyCell: TCellBasic;
    Swapped: boolean;   {image has been replaced}  
    Missing: boolean;   {waiting for image to be downloaded}  

    constructor Create(MasterList: TSectionList; Position: integer; L: TAttributeList);
    constructor SimpleCreate(MasterList: TSectionList; const AnURL: string);
    constructor CreateCopy(AMasterList: TSectionList; T: TImageObj);
    destructor Destroy; override;
    procedure DrawLogic(SectionList: TSectionList; Canvas: TCanvas;
                  FO: TFontObj; AvailableWidth, AvailableHeight: integer);  override;
    procedure DoDraw(Canvas: TCanvas; XX, Y: Integer; ddImage: TgpObject; ddMask: TBitmap);
    procedure Draw(Canvas: TCanvas; X: integer; TopY, YBaseline: integer; FO: TFontObj);
    function InsertImage(const UName: String; Error: boolean; var Reformat: boolean): boolean;

    property Bitmap: TBitmap read GetBitmap;
    property Hover: HoverType read FHover write SetHover;  
    procedure ReplaceImage(NewImage: TStream);   
  end;

  TImageObjList = class(TFreeList)  {a list of TImageObj's and TPanelObj's}
  Public
    constructor CreateCopy(AMasterList: TSectionList; T: TImageObjList);
    function FindImage(Posn: integer): TFloatingObj;
    function GetHeightAt(Posn: integer; var AAlign: AlignmentType;
         var FlObj: TFloatingObj) : Integer;
    function GetWidthAt(Posn: integer; var AAlign: AlignmentType;
           var HSpcL, HSpcR: integer; var FlObj: TFloatingObj) : integer;
    function GetImageCountAt(Posn: integer): integer;
    function PtInImage(X: integer; Y: integer; var IX, IY, Posn: integer;
                var AMap, UMap: boolean; var MapItem: TMapItem;
                var ImageObj: TImageObj): boolean;
    function PtInObject(X : integer; Y: integer; var Obj: TObject;
         var IX, IY: integer): boolean;
    procedure Decrement(N: integer);
  end;

  IndentManager = class(IndentManagerBasic)
    procedure Update(Y: integer; Img: TFloatingObj);
    procedure UpdateBlock(Y: integer; IW: integer; IH: integer; Justify: AlignmentType);
    end;

  TFormControlObj = class;
  TRadioButtonFormControlObj = class;

  ThtmlForm = class(TObject)
  private
    procedure AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  Public
    MasterList: TSectionList;
    Method: string[4];
    Action, Target, EncType: String;
    ControlList: TFreeList;
    NonHiddenCount: integer;
    constructor Create(AMasterList: TSectionList; L : TAttributeList);
    destructor Destroy; override;
    procedure DoRadios(Radio: TRadioButtonFormControlObj);
    procedure InsertControl(Ctrl: TFormControlObj);
    procedure ResetControls;
    function GetFormSubmission: TStringList;
    procedure SubmitTheForm(const ButtonSubmission: string);
    procedure SetFormData(SL: TStringList);
    procedure SetSizes(Canvas: TCanvas);
    procedure ControlKeyPress(Sender: TObject; var Key: char);
  end;

  TFormControlObj = class(TIDObject)
  private
    FYValue: integer;
    Active: boolean;
    PaintBitmap: TBitmap;    
    AttributeList: TStringList;
    FTitle: string; 
    function GetControl: TWinControl; virtual;
    function GetAttribute(const AttrName: string): string;
  protected
    CodePage: integer;
    procedure DoOnChange;  virtual;
    procedure SaveContents; virtual;
    function GetYPosition: integer; override;
  public
    Pos : integer;        {0..Len  index of control position}
    MasterList: TSectionList;
    MyForm: ThtmlForm;
    Value, FName, FID: String;
    FormAlign: AlignmentType;
    HSpaceL, HSpaceR, VSpaceT, VSpaceB, BordT, BordB: integer;
    FHeight, FWidth: integer;
    PercentWidth: boolean;
    Disabled: boolean;
    Readonly: boolean;   
    BkColor: TColor;  
    FControl: TWinControl;
    ShowIt: boolean;
    OnClickMessage: String;
    OnFocusMessage: String;
    OnBlurMessage: String;
    OnChangeMessage: String;

    constructor Create(AMasterList: TSectionList; Position: integer; L: TAttributeList);
    constructor CreateCopy(T: TFormControlObj);
    destructor Destroy; override;
    procedure HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
    procedure ProcessProperties(Prop: TProperties); virtual;
    procedure Draw(Canvas: TCanvas; X1, Y1: integer); virtual;
    procedure ResetToValue; virtual;
    function GetSubmission(Index: integer; var S: string): boolean; virtual;
    procedure SetData(Index: integer; const V: String); virtual;
    procedure SetDataInit; virtual;
    procedure SetHeightWidth(Canvas: TCanvas); virtual;
    procedure EnterEvent(Sender: TObject);    {these two would be better private}
    procedure ExitEvent(Sender: TObject);
    procedure FormControlClick(Sender: TObject);

    property TheControl: TWinControl read GetControl;  {the Delphi control, TButton, TMemo, etc}
    property Name: string read FName;  {Name given to control}