htmlsubs.pas

查看html文件的控件

    colAlign: string;
    colVAlign: AlignmentType;
    end;

  IntArray = array of Integer;
  TablePartType = (Normal, DoHead, DoBody1, DoBody2, DoBody3, DoFoot);     
  TTablePartRec = class
    TablePart: TablePartType;
    PartStart: integer;
    PartHeight: integer;
    FootHeight: integer;
    end;

  ThtmlTable = class(TSectionBase)
  private
    TablePartRec: TTablePartRec;
    HeaderHeight, HeaderRowCount, FootHeight, FootStartRow, FootOffset: Integer;  
    BodyBreak: integer;
    HeadOrFoot: Boolean;
    procedure DrawTable(Canvas: TCanvas; const ARect: TRect;
      IMgr: IndentManager; X, Y: Integer);
    procedure DrawTableP(Canvas: TCanvas; const ARect: TRect;
      IMgr: IndentManager; X, Y: integer);
    procedure FindRowHeights(Canvas: TCanvas; AHeight: integer);
  public
    Rows: TFreeList;   {a list of TCellLists}
    ListsProcessed: boolean;
    Indent,                   {table indent}
    Border: integer;          {width of border}
    Float: boolean;           {if floating}
    NumCols,                  {Number columns in table}
    TableWidth,               {width of table}
    tblWidthAttr: integer;    {Width attribute as entered}   
    UseAbsolute: boolean;  {width entries are considered absolute}
    TableHeight: integer;     {height of table itself, not incl caption}
    CellPadding, CellSpacing: integer;
    HSpace, VSpace:  integer; {horizontal, vertical extra space}
    BorderColorLight, BorderColorDark: TColor;
    EndList: boolean;     {marker for copy}
    DrawX: integer;
    DrawY: integer;
    BkGnd: boolean;
    BkColor: TColor;
    ColInfo: TFreeList;
    ThisCycle: integer;   
    Widths,                   {holds column widths}    
    MaxWidths, MinWidths, Heights,
    Percents: IntArray;       {percent widths of columns}

    constructor Create(Master: TSectionList;Attr: TAttributeList;
                    Prop: TProperties);
    constructor CreateCopy(AMasterList: TSectionList; T: TSectionBase); override;
    destructor Destroy; override;
    procedure DoColumns(Width: integer; AsPercent: boolean;
                   VAlign: AlignmentType; const Align: string);   
    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); override;
    procedure AddDummyCells;
    procedure GetMinMaxAbs(Canvas: TCanvas; var TotalMinWidth,
                TotalMaxWidth: integer);
    procedure GetWidthsAbs(Canvas: TCanvas; TablWidth: integer; Specified: boolean);
    procedure GetWidths(Canvas: TCanvas; var TotalMinWidth, TotalMaxWidth: integer;
               TheWidth: integer);
    procedure TableSpecifiedAndWillFit(TheWidth: integer);
    procedure TableNotSpecifiedAndWillFit(TotalMinWidth, TotalMaxWidth, TheWidth: integer);
    function DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager;
             var MaxWidth: integer; var Curs: integer): integer; override;
    function Draw1(Canvas: TCanvas; const ARect: TRect;
         IMgr: IndentManager; X, XRef, YRef : integer) : integer;  override;
    function GetURL(Canvas: TCanvas; X: integer; Y: integer;
         var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj;
         var ATitle: string): guResultType; override;
    function PtInObject(X : integer; Y: integer; var Obj: TObject;
         var IX, IY: integer): boolean; override;
    function FindCursor(Canvas: TCanvas; X: integer; Y: integer;
         var XR: integer; var YR: integer; var CaretHt: integer;
         var Intext: boolean): integer; override;
    function CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
             var Y: integer): boolean; override;
    function GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; override;
    function FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; override;
    function FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; override;
    function FindSourcePos(DocPos: integer): integer; override;    
    function FindDocPos(SourcePos: integer; Prev: boolean): integer; override;    
    procedure CopyToClipboard; override;
    end;

  XArray = array[0..300] of integer;
  PXArray = ^XArray;

  IndexObj = class
    Pos: integer;
    Index: integer;
    end;

  TSection = class(TSectionBase)
  {TSection holds <p>, <li>, many other things, and the base for lists}
  private
    SectionNumber: integer;   
    ThisCycle: integer;
    function GetIndexObj(I: integer): IndexObj;
    property PosIndex[I: integer]: IndexObj read GetIndexObj;
    procedure CheckForInlines(LR: Linerec);   
  public
    BuffS: WideString; {holds the text for the section}
    Buff: PWideChar; {same as above}
    Brk: string;        
    XP: PXArray;
    BuffSize: integer;       {buffer may be larger}
    Fonts : TFontList;   {List of FontObj's in this section}
    Images: TImageObjList;   {list of TImageObj's, the images in section}
    FormControls: TList;      {list of TFormControls in section}
    SIndexList: TFreeList;    {list of Source index changes}
    Lines : TFreeList;   {List of LineRecs,  info on all the lines in section}
    Justify: JustifyType; {Left, Centered, Right}
    ClearAttr: ClearAttrType;
    LineHeight: integer;
    DrawX, DrawWidth: integer;
    AnchorName: boolean;
    StoredMin, StoredMax: integer;
    FirstLineIndent: integer;
    FLPercent: integer;
    BreakWord: boolean;  

    constructor Create(AMasterList: TSectionList;  L: TAttributeList;
                Prop: TProperties; AnURL: TUrlTarget; ACell: TCellBasic; FirstItem: boolean); 
    constructor CreateCopy(AMasterList: TSectionList; T: TSectionBase); override;
    destructor Destroy; override;
    procedure CheckFree;
    procedure Finish;
    procedure AddChar(C: WideChar; Index: integer); virtual;
    procedure AddTokenObj(T : TokenObj); virtual;
    procedure AddOpBrk;   
    procedure ProcessText(TagIndex: integer); virtual;   
    procedure Allocate(N : integer);
    function AddImage(L: TAttributeList; ACell: TCellBasic; Index: integer): TImageObj;
    function AddPanel(L: TAttributeList;
                     ACell: TCellBasic; Index: integer): TPanelObj;    
    procedure AddPanel1(PO: TPanelObj; Index: integer);     
    function CreatePanel(L: TAttributeList;
                     ACell: TCellBasic): TPanelObj;    
    function AddFormControl(Which: Symb; AMasterList: TSectionList;
         L: TAttributeList; ACell: TCellBasic; Index: integer;
         Prop: TProperties): TFormControlObj;  
    procedure ChangeFont(Prop: TProperties);
    procedure HRef(Sy: Symb; List: TSectionList; AnURL: TUrlTarget;
              Attributes: TAttributeList; Prop: TProperties);
    function FindCountThatFits(Canvas: TCanvas; Width: integer; Start: PWideChar; Max: integer): integer;
    function FindCountThatFits1(Canvas: TCanvas; Start: PWideChar; Max: integer; X, Y: integer; IMgr: IndentManager;
                    var ImgHt: integer; NxImages: TList) : integer;
    function FindTextWidth(Canvas: TCanvas; Start: PWideChar; N: integer; RemoveSpaces: boolean): integer;
    function FindTextWidthA(Canvas: TCanvas; Start: PWideChar; N: integer): integer;
    function DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager;
             var MaxWidth: integer; var Curs: integer): integer; override;
    function Draw1(Canvas: TCanvas; const ARect: TRect;
         IMgr: IndentManager; X, XRef, YRef : integer) : integer;  override;
    procedure CopyToClipboard; override;
    function GetURL(Canvas: TCanvas; X: integer; Y: integer;
         var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj;
         var ATitle: string): guResultType; override;
    function PtInObject(X : integer; Y: integer; var Obj: TObject;
         var IX, IY: integer): boolean; override;   
    function FindCursor(Canvas: TCanvas; X: integer; Y: integer;
         var XR: integer; var YR: integer; var CaretHt: integer;
         var Intext: boolean): integer; override;
    function FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; override;
    function FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; override;
    function FindSourcePos(DocPos: integer): integer; override;
    function FindDocPos(SourcePos: integer; Prev: boolean): integer; override;
    function CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
             var Y: integer): boolean; override;
    function GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; override;
    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); override;
    end;

  TDrawList = class(TFreeList)
    procedure AddImage(Obj: TImageObj; Canvas: TCanvas; X: integer; TopY,
              YBaseline: integer; FO: TFontObj);
    procedure DrawImages;
    end;

  TCellBasic = class(TFreeList)  {a list which holds sections and blocks}
  public
    MasterList: TSectionList;  {the TSectionList that holds the whole document}
    YValue: integer;   {vertical position at top of cell}
    IMgr: IndentManager;
    StartCurs: integer;
    Len: integer;
    BkGnd: boolean;
    BkColor: TColor;
    tcContentBot, tcDrawTop, tcDrawBot: integer;
    OwnersTag: string;
    Owner:  TBlock;    

    constructor Create(Master: TSectionList);
    constructor CreateCopy(AMasterList: TSectionList; T: TCellBasic);
    procedure Add(Item: TSectionBase; TagIndex: integer);
    function CheckLastBottomMargin: boolean;
    procedure CopyToClipboard;
    function DoLogic(Canvas: TCanvas; Y: integer; Width, AHeight, BlHt: integer;
                  var ScrollWidth: integer; var Curs: integer): integer; virtual;
    procedure MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); virtual;
    function Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
                          Y, XRef, YRef :integer): integer; virtual;
    function GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget;
        var FormControl: TImageFormControlObj; var ATitle: string): guResultType; virtual;
    function PtInObject(X: integer; Y: integer;  var Obj: TObject;
              var IX, IY: integer): boolean;
    function FindCursor(Canvas: TCanvas; X: Integer; Y: integer;
                var XR: integer; var YR: integer; var Ht: integer;
                var Intext: boolean): integer;
    function FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer;
    function FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer;
    function FindSourcePos(DocPos: integer): integer;
    function FindDocPos(SourcePos: integer; Prev: boolean): integer;
    function CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
             var Y: integer): boolean;
    function GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean;
    procedure AddSectionsToList;
    procedure FormTree(Indent: string; var Tree: string);
    end;

  TCell = class(TCellBasic)
    DrawYY: integer;     

    constructor Create(Master: TSectionList);
    constructor CreateCopy(AMasterList: TSectionList; T: TCellBasic);
    destructor Destroy; override;
    function DoLogic(Canvas: TCanvas; Y: integer; Width, AHeight, BlHt: integer;
                  var ScrollWidth: integer; var Curs: integer): integer; override;
    function Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
                          Y, XRef, YRef:integer): integer; override;
    end;

  TBlockCell = class(TCellBasic)
    CellHeight: integer;

    function DoLogicX(Canvas: TCanvas; X, Y: integer; XRef, YRef, Width, AHeight, BlHt: integer;
                  var ScrollWidth: integer; var Curs: integer): integer;
    end;

  TSectionList = class(TCell)    {a list of all the sections--holds document}
  Private
    procedure AdjustFormControls;

  Public
    ShowImages,              {set if showing images}
    Printing: boolean;       {set if printing -- also see IsCopy}
    YOff: integer;           {marks top of window that's displayed}
    YOffChange: boolean;     {when above changes}
    NoPartialLine: boolean;  {set when printing if no partial line allowed
                              at page bottom}
    SelB, SelE: integer;
    PreFontName : string[lf_FaceSize+1];  {<pre>, <code> font for document}
    LinkVisitedColor, LinkActiveColor,
    HotSpotColor: TColor;
    PrintTableBackground: boolean;
    PrintBackground: boolean;
    PrintMonoBlack: boolean;
    TheOwner: TWinControl;        {the viewer that owns this document}
    PPanel: TWinControl;          {the viewer's PaintPanel}
    GetBitmap: TGetBitmapEvent;   {for OnBitmapRequest Event}
    GetImage: TGetImageEvent;     {for OnImageRequest Event}
    ExpandName: TExpandNameEvent;
    ObjectClick: TObjectClickEvent;
    ObjectFocus: ThtObjectEvent;
    ObjectBlur: ThtObjectEvent;
    ObjectChange: ThtObjectEvent;
    FileBrowse: TFileBrowseEvent;   
    BackGround: TColor;

    OnBackgroundChange: TNotifyEvent;
    BackgroundBitmap: TGpObject; //TBitmap;
    BackgroundMask: TBitmap;
    BackgroundAniGif: TGifImage;   
    BackgroundPRec: PtPositionRec; 
    BitmapName: String;      {name of background bitmap}
    BitmapLoaded: boolean;   {if background bitmap is loaded}
    htmlFormList: TFreeList;
    AGifList: TList;      {list of all animated Gifs}
    SubmitForm: TFormSubmitEvent;
    ScriptEvent: TScriptEvent;
    PanelCreateEvent: TPanelCreateEvent;
    PanelDestroyEvent: TPanelDestroyEvent;
    PanelPrintEvent: TPanelPrintEvent;  
    CB: SelTextCount;
    PageBottom: integer;
    PageShortened: boolean;
    MapList: TFreeList;    {holds list of client maps, TMapItems}
    Timer: TTimer;      {for animated GIFs}
    FormControlList:  TList;   {List of all TFormControlObj's in this SectionList}
    PanelList: TList;    {List of all TPanelObj's in this SectionList}
    MissingImages: TStringList;  {images to be supplied later}
    ControlEnterEvent: TNotifyEvent;
    LinkList: TList;    {List of links (TFontObj's)}
    ActiveLink: TFontObj;
    LinksActive: boolean;
    ActiveImage: TImageObj;
    ShowDummyCaret: boolean;
    Styles: TStyleList;    {the stylesheet}
    DrawList: TDrawList;
    FirstLineHtPtr: PInteger;
    IDNameList: TIDNameList;
    PositionList: TList;
    BitmapList: TStringBitmapList;
    SectionCount: integer;
    CycleNumber: integer;
    ProgressStart: integer;
    IsCopy: boolean;         {set when printing or making bitmap/metafile}
    NoOutput: boolean;    
    TabOrderList: TStringList;
    FirstPageItem: boolean;
    StopTab: boolean;
    InlineList: TFreeList;  {actually TInlineList, a list of InlineRec's}
    TableNestLevel: integer;
    InLogic2: boolean;
    LinkDrawnEvent: TLinkDrawnEvent;
    LinkPage: integer;  
    PrintingTable: ThtmlTable;   
    ScaleX, ScaleY: single;

    constructor Create(Owner, APaintPanel: TWinControl);
    constructor CreateCopy(T: TSectionList);
    procedure Clear;
    procedure ClearLists;
    destructor Destroy; override;
    procedure CheckGIFList(Sender: TObject);
    procedure HideControls;
    procedure SetYOffset(Y: integer);
    function GetSelLength: integer;
    procedure CopyToClipboardA(Leng: integer);
    function GetSelTextBuf(Buffer: PWideChar; BufSize: integer): integer;
    procedure SetFonts(const Name, PreName: string; ASize: integer;
              AColor, AHotSpot, AVisitedColor, AActiveColor, ABackground: TColor;
              LnksActive: boolean; LinkUnderLine: boolean; ACharSet: TFontCharSet;
              MarginHeight, MarginWidth: integer);
    procedure SetBackground(ABackground: TColor);
    procedure SetBackgroundBitmap(Name: String; const APrec: PtPositionRec);
    procedure GetBackgroundBitmap;
    function FindSectionAtPosition(Pos: integer;
             var TopPos: integer; var Index: integer): TSectionBase;
    procedure CancelActives;
    function GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget;
          var FormControl: TImageFormControlObj; var ATitle: string): guResultType; override;
    procedure LButtonDown(Down: boolean);   
    function GetTheBitmap(const BMName: String; var Transparent: Transparency;
               var AMask: TBitmap; var FromCache, Delay: boolean): TgpObject;
    function DoLogic(Canvas: TCanvas; Y: integer; Width, AHeight, BlHt: integer;
                  var ScrollWidth: integer; var Curs: integer): integer; override;
    function Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer;
                          Y, XRef, YRef :integer): integer; override;
    procedure InsertImage(const Src: string; Stream: TMemoryStream; var Reformat: boolean);