{Version 9.45} {*********************************************************} {* HTMLSUBS.PAS *} {*********************************************************} { Copyright (c) 1995-2008 by L. David Baldwin Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. Note that the source modules, HTMLGIF1.PAS, PNGZLIB1.PAS, DITHERUNIT.PAS, and URLCON.PAS are covered by separate copyright notices located in those modules. } {$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; {$IFNDEF LCL} {$R HTML32.Res} {$ENDIF} interface uses SysUtils, Classes, {$IFNDEF LCL} WinTypes, Windows, WinProcs, Messages, mmSystem, {$ELSE} LclIntf, LMessages, Types, LclType, HtmlMisc, {$ENDIF} Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, HTMLUn2, HTMLGif2, {$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; {$IFNDEF LCL} ThtTabcontrol = class(TWinControl) {$ELSE} ThtTabcontrol = class(TCustomControl) {$ENDIF} private procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE; protected property OnEnter; property OnExit; property TabStop; property OnKeyUp; public destructor Destroy; override; end; 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: ThtTabControl; 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 tag} SpecHeight: integer; {as specified by 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; FUserData: TObject; FMyPanelObj: TPanelObj; 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 ,
  • , 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; 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; TCellObjCell = class(TCell) MyRect: TRect; Title: string; Url, Target: string; constructor CreateCopy(AMasterList: TSectionList; T: TCellObjCell); function GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; 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]; {
    ,  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;
        SkipDraw: boolean;     
    
        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);
        function GetFormcontrolData: TFreeList;     
        procedure SetFormcontrolData(T: TFreeList); 
        function FindDocPos(SourcePos: integer; Prev: boolean): integer;
        function CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer;
                 var Y: integer): boolean;
        procedure ProcessInlines(SIndex: integer; Prop: TProperties; Start: boolean);  
      end;
    
      TCellObj = class(TObject)  {holds a TCell and some other information}
        ColSpan, RowSpan,      {column and row spans for this cell}
        Wd: integer;  {total width (may cover more than one column)}
        Ht,           {total height (may cover more than one row)}
        VSize: integer;     {Actual vertical size of contents}
        SpecHt: integer;    {Height as specified}
        SpecHtPercent: integer;  
        YIndent: integer;   {Vertical indent}
        VAlign: AlignmentType;  {Top, Middle, or Bottom}
        WidthAttr: integer;   {Width attribute (percentage or absolute)}
        AsPercent: boolean;   {it's a percent}
        EmSize, ExSize: integer;
        PRec: PtPositionRec;
        PadTop, PadRight, PadBottom, PadLeft: integer;
        BrdTop, BrdRight, BrdBottom, BrdLeft: integer;   
        HzSpace, VrSpace: integer;   
        BorderStyle: BorderStyleType;
        Cell: TCellObjCell;        
    
        NeedDoImageStuff: boolean;
        BGImage: TImageObj;
        TiledImage: TGpObject;
        TiledMask, FullBG: TBitmap;
        MargArray: TMarginArray;
        MargArrayO: TVMarginArray;
        NoMask: boolean;
        BreakBefore, BreakAfter, KeepIntact: boolean;
    
        constructor Create(Master: TSectionList; AVAlign: AlignmentType;
                    Attr: TAttributeList; Prop: TProperties);
        constructor CreateCopy(AMasterList: TSectionList; T: TCellObj);
        destructor Destroy; override;
        private
        procedure InitializeCell(TablePadding: integer; const BkImageName: string;
                         const APRec: PtPositionRec; Border: boolean);
        procedure Draw(Canvas: TCanvas; const ARect: TRect; X, Y, CellSpacing: integer;
                   Border: boolean; Light, Dark: TColor);
        procedure DrawLogic2(Canvas: TCanvas; Y, CellSpacing: integer;
                    var Curs: integer);
        end;
    
    const
      ImageSpace = 3;   {extra space for left, right images}
      ListIndent = 35;    
    
    var
      CurrentStyle: TFontStyles;  {as set by , , etc.}
      CurrentForm: ThtmlForm;
      UnicodeControls:  boolean;   
    
    implementation
             
    uses
      {$ifdef Delphi6_Plus}
      Variants,
      {$endif}
      HTMLView, ReadHTML, HTMLSbs1, GDIPL2A;
    
    var
      NLevel: integer;  {for debugging}
      
    type
      TSectionClass = Class of TSectionBase;
      EProcessError = class(Exception);
    
      TFormRadioButton = class(TRadioButton)
      private
        IDName: string;
        FChecked: boolean;
        procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
      protected
        procedure CreateWnd; override;   
        function GetChecked: Boolean; override;
        procedure SetChecked(Value: Boolean); override; 
      published
        property Checked: boolean read GetChecked write SetChecked;
      end;
    
      TFormCheckBox = class(TCheckBox)  
      private
        procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;
      end;
    
      BorderRec = class   {record for inline borders} 
      private
        BStart, BEnd: integer;
        OpenStart, OpenEnd: boolean;
        BRect: TRect;
        MargArray: TMarginArray;
        procedure DrawTheBorder(Canvas: TCanvas; XOffset, YOffSet: integer; Printing: boolean);  
        end;
    
      InlineRec = class
      private
        StartB, EndB, IDB, StartBDoc, EndBDoc: integer;  
        MargArray: TMarginArray;
        end;
    
      TInlineList = class(TFreeList)  {a list of InlineRec's}
      private
        NeedsConverting: boolean;
        Owner: TSectionList;
        procedure AdjustValues;
        function GetStartB(I: integer): integer;
        function GetEndB(I: integer): integer;
      public
        constructor Create(AnOwner: TSectionList);
        procedure Clear;
        property StartB[I: integer]: integer read GetStartB;
        property EndB[I: integer]: integer read GetEndB;
        end;
    
    procedure IndentManager.Update(Y: integer; Img: TFloatingObj);
    {Given a new floating image, update the edge information.  Fills  Img.Indent,
     the distance from the left edge to the upper left corner of the image}
    var
      IH, IW: integer;
      IR: IndentRec;
      LIndent: integer;
    begin
    if Assigned(Img) then
      begin
      IW := Img.ImageWidth + Img.HSpaceL + Img.HSpaceR;
      IH := Img.ImageHeight + Img.VSpaceT + Img.VSpaceB;
      if (Img.ObjAlign = ALeft) then
        begin
        IR := IndentRec.Create;
        with IR do
          begin
          LIndent := LeftIndent(Y);    
          Img.Indent := LIndent-LfEdge+Img.HSpaceL;
          X := LIndent-LfEdge + IW;
          YT := Y;
          YB := Y + IH;
          L.Add(IR);
          end;
        end
      else if (Img.ObjAlign = ARight) then
        begin
        IR := IndentRec.Create;
        with IR do
          begin
          X := RightSide(Y) - IW;    
          Img.Indent := X + Img.HSpaceL;
          YT := Y;
          YB := Y + IH;
          R.Add(IR);
          end;
        end;
      end;
    end;
    
    procedure IndentManager.UpdateBlock(Y: integer; IW: integer; IH: integer;
                               Justify: AlignmentType);
    {For a floating block, update the edge information. }
    var
      IR: IndentRec;
    begin
      IR := IndentRec.Create;
      if (Justify = ALeft) then
        begin
        with IR do
          begin
          X := -LfEdge + IW;
          YT := Y;
          YB := Y + IH;
          Float := True;     //ID := CurrentID;
          L.Add(IR);
          end;
        end
      else if (Justify = ARight) then
        begin
        with IR do
          begin
          X := RightSide(Y) - IW;
          YT := Y;
          YB := Y + IH;
          Float := True;     //ID := CurrentID;
          R.Add(IR);
          end;
        end;
    end;
    
    constructor TFontObj.Create(ASection: TSection; F: TMyFont; Position: integer);
    begin
    inherited Create;
    Section := ASection;
    TheFont := F;
    Pos := Position;
    UrlTarget := TUrlTarget.Create;
    FontChanged;
    end;
    
    {$ifndef NoTabLink}
    procedure TFontObj.EnterEvent(Sender: TObject);  
    var
      List: TList;
      I, J: integer;
    begin
    Active := True;
    {Make adjacent fonts in this link active also}
    List := Section.ParentSectionList.LinkList;
    I := List.IndexOf(Self);
    if I >= 0 then
      for J := I+1 to List.Count-1 do
        if (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) then
          TFontObj(List[J]).Active := True
        else Break;
    Section.ParentSectionList.ControlEnterEvent(Self);
    end;
    
    procedure TFontObj.ExitEvent(Sender: TObject);  
    var
      List: TList;
      I, J: integer;
    begin
    Active := False;
    {Make adjacent fonts in this link inactive also}
    List := Section.ParentSectionList.LinkList;
    I := List.IndexOf(Self);
    if I >= 0 then
      for J := I+1 to List.Count-1 do
        if (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) then
          TFontObj(List[J]).Active := False
        else Break;
    Section.ParentSectionList.PPanel.Invalidate;
    end;
    
    procedure TFontObj.AssignY(Y: integer);
    var
      List: TList;
      I, J: integer;
    begin
    if UrlTarget.Url = '' then Exit;
    if Assigned(TabControl) then
      FYValue := Y
    else
      begin  {Look back for the TFontObj with the TabControl}
      List := Section.ParentSectionList.LinkList;
      I := List.IndexOf(Self);
      if I >= 0 then
        for J := I-1 downto 0 do
          if (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) then
            begin
            if Assigned(TFontObj(List[J]).TabControl) then
              begin
              TFontObj(List[J]).FYValue := Y;
              break;
              end;
            end
          else Break;
      end;
    end;
    
    procedure TFontObj.AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    var
      Viewer: ThtmlViewer;
    begin
    Viewer := ThtmlViewer(Section.ParentSectionList.TheOwner);
    if (Key = vk_Return) then
      begin
      Viewer.Url := UrlTarget.Url;
      Viewer.Target := UrlTarget.Target;
      Viewer.LinkAttributes.Text := UrlTarget.Attr;  
      Viewer.LinkText := Viewer.GetTextByIndices(UrlTarget.Start, UrlTarget.Last);   
      Viewer.TriggerUrlAction;  {call to UrlAction via message}
      end
    else  {send other keys to ThtmlViewer}
      Viewer.KeyDown(Key, Shift);
    end;
    
    procedure TFontObj.CreateTabControl(TabIndex: integer);     
    var
      PntPanel: TPaintPanel;
      I, J: integer;
      List: TList;
    begin
    if Assigned(TabControl) then
      Exit;
      {Look back for the TFontObj with the TabControl}
    List := Section.ParentSectionList.LinkList;
    I := List.IndexOf(Self);
    if I >= 0 then
      for J := I-1 downto 0 do
        if (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) then
          if Assigned(TFontObj(List[J]).TabControl) then
            Exit;
    
    PntPanel := TPaintPanel(Section.ParentSectionList.PPanel);
    TabControl := ThtTabcontrol.Create(PntPanel);
    with ThtTabcontrol(TabControl) do
      begin
      Left := -4000  ;   {so will be invisible until placed}
      Width := 1;
      Height := 1;
      TabStop := True;
      OnEnter := EnterEvent;
      OnExit := ExitEvent;
      OnKeyDown := Self.AKeyDown;   
      end;
    TabControl.Parent := PntPanel;
    
    if TabIndex > 0 then
      {Adding leading 0's to the number string allows it to be sorted numerically,
       and the Count takes care of duplicates}
      with Section.ParentSectionList.TabOrderList do
        AddObject(Format('%.5d%.3d', [TabIndex, Count]), TabControl);   
    end;
    {$endif}
    
    procedure TFontObj.CreateFIArray;
    begin
    if not Assigned(FIArray) then
      FIArray := TFontInfoArray.Create;
    end;
    
    procedure TFontObj.ReplaceFont(F: TMyFont);
    begin
    TheFont.Free;
    TheFont := F;
    FontChanged;
    end;
    
    procedure TFontObj.ConvertFont(FI: ThtFontInfo);
    begin
      with TheFont, FI do
        begin
        Name := iName;
        Height := -Round(iSize * Screen.PixelsPerInch / 72);   
        Style := iStyle;
        bgColor := ibgColor;
        Color := iColor;
        CharSet:= ICharSet;
        FontChanged;
        end;
    end;
    
    constructor TFontObj.CreateCopy(ASection: TSection; T: TFontObj); 
    begin
    inherited Create;
    Section := ASection;
    Pos := T.Pos;
    SScript := T.SScript;
    TheFont := TMyFont.Create;
    TheFont.Assign(T.TheFont);
    if Assigned(T.FIArray) then
      ConvertFont(T.FIArray.Ar[LFont]);
    UrlTarget := TUrlTarget.Create;
    UrlTarget.Copy(T.UrlTarget);
    FontChanged;
    end;
    
    destructor TFontObj.Destroy;
    begin
    FIArray.Free;
    TheFont.Free;
    UrlTarget.Free;
    TabControl.Free;   
    inherited Destroy;
    end;
    
    procedure TFontObj.SetVisited(Value: boolean);    
    begin
    if Value <> FVisited then
      begin
      FVisited := Value;
      if Value then
        if Hover then
          ConvertFont(FIArray.Ar[HVFont])
        else
          ConvertFont(FIArray.Ar[VFont])
      else
        if Hover then
          ConvertFont(FIArray.Ar[HLFont])
        else
          ConvertFont(FIArray.Ar[LFont]);
      FontChanged;
      end;
    end;
    
    procedure TFontObj.SetHover(Value: boolean);
    begin
    if Value <> FHover then
      begin
      FHover := Value;
      if Value then
        if FVisited then
          ConvertFont(FIArray.Ar[HVFont])
        else ConvertFont(FIArray.Ar[HLFont])
      else
        if FVisited then
          ConvertFont(FIArray.Ar[VFont])
        else ConvertFont(FIArray.Ar[LFont]);
      FontChanged;
      end;
    end;
    
    procedure TFontObj.SetAllHovers(List: TList; Value: boolean);
    {Set/Reset Hover on this item and all adjacent item with the same URL}
    var
      I, J: integer;
    begin
    SetHover(Value);
    I := List.IndexOf(Self);
    if I >= 0 then
      begin
      J := I+1;
      while (J < List.Count) and (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) do
        begin
        TFontObj(List[J]).Hover := Value;
        Inc(J);
        end;
      J := I-1;
      while (J >= 0) and (Self.UrlTarget.ID = TFontObj(List[J]).UrlTarget.ID) do
        begin
        TFontObj(List[J]).Hover := Value;
        Dec(J);
        end;
      end;
    end;
    
    function TFontObj.GetURL: string;
    begin
    try                            
      Result := UrlTarget.Url;
    except
      Result := '';
      {$ifdef DebugIt}
      ShowMessage('Bad TFontObj, htmlsubs.pas, TFontObj.GetUrl');
      {$endif}
      end;
    end;
    
    procedure TFontObj.FontChanged;   
    begin
    tmHeight := TheFont.tmHeight;
    tmMaxCharWidth := TheFont.tmMaxCharWidth;
    FontHeight := TheFont.tmHeight + TheFont.tmExternalLeading;
    Descent := TheFont.tmDescent;
    if fsItalic in TheFont.Style then  {estimated overhang}
      Overhang := TheFont.tmheight div 10
    else Overhang := 0;
    TheFont.Charset := TheFont.tmCharset;
    end;
    
    function TFontObj.GetOverhang: integer;
    begin
    Result := Overhang;
    end;
    
    function TFontObj.GetHeight(var Desc: integer): integer;
    begin
    Desc := Descent;
    Result := FontHeight;
    end;
    
    constructor TFontList.CreateCopy(ASection: TSection; T: TFontList);
    var
      I: integer;
    begin
    inherited create;
    for I := 0 to T.Count-1 do
      Add(TFontObj.CreateCopy(ASection, TFontObj(T.Items[I])));
    end;
    
    function TFontList.GetFontAt(Posn : integer;
                    var OHang : integer) : TMyFont;
    {given a character index, find the font that's effective there}
    var
      I, PosX: integer;
      F : TFontObj;
    begin
    I := 0;
    PosX := 0;
    while (I < Count)  do
      begin
      PosX := TFontObj(Items[I]).Pos;
      Inc(I);
      if PosX >= Posn then Break;
      end;
    Dec(I);
    if PosX > Posn then Dec(I);
    F := TFontObj(Items[I]);
    OHang := F.Overhang;   
    Result := F.TheFont;
    end;
    
    function TFontList.GetFontCountAt(Posn, Leng : integer) : integer;
    {Given a position, return the number of chars before the font changes}
    var
      I, PosX : integer;
    begin
    I := 0;
    PosX := 0;
    while I < Count do
      begin
      PosX := TFontObj(Items[I]).Pos;
      if PosX >= Posn then Break;
      Inc(I);
      end;
    if PosX = Posn then Inc(I);
    if I = Count then
      Result := Leng-Posn
    else
      Result := TFontObj(Items[I]).Pos - Posn;
    end;
    
    {----------------TFontList.GetFontObjAt}
    function TFontList.GetFontObjAt(Posn : integer;
                          var Index : integer) : TFontObj;
    {Given a position, returns the FontObj which applies there and the index of
     the FontObj in the list}
    var
      PosX: integer;
    begin
    Index := 0;
    PosX := 0;
    while (Index < Count)  do
      begin
      PosX := TFontObj(Items[Index]).Pos;
      Inc(Index);
      if PosX >= Posn then Break;
      end;
    Dec(Index);
    if PosX > Posn then Dec(Index);
    Result := TFontObj(Items[Index]);
    end;
    
    {----------------TFontList.Decrement}
    procedure TFontList.Decrement(N: integer; ParentSectionList: TSectionList);   
    {called when a character is removed to change the Position figure}
    var
      I, J: integer;
      FO, FO1: TFontObj;
    begin
    I := 0;
    while I < Count do
      begin
      FO := TFontObj(Items[I]);
      if FO.Pos > N then
          Dec(FO.Pos);
      if (I > 0) and (TFontObj(Items[I-1]).Pos = FO.Pos) then
        begin
        FO1 := TFontObj(Items[I-1]);
        J := ParentSectionList.LinkList.IndexOf(FO1);
        if J >=0 then
          ParentSectionList.LinkList.Delete(J);
        {$ifndef NoTabLink}
        if Assigned(FO1.TabControl) then  
          if FO.UrlTarget.Id = FO1.UrlTarget.ID then
            begin      {if the same link, transfer the TabControl to the survivor}
            FO.TabControl := FO1.TabControl;
            FO.TabControl.OnEnter := FO.EnterEvent;
            FO.TabControl.OnExit := FO.ExitEvent;
            FO1.TabControl := Nil;
            end
          else    
            begin   {remove the TabControl from the TabOrderList}
            J := ParentSectionList.TabOrderList.IndexOfObject(FO1.TabControl);
            if J >= 0 then
              ParentSectionList.TabOrderList.Delete(J);
            end;       
        {$endif}
        FO1.Free;
        Delete(I-1);
        end
      else Inc(I);
      end;
    end;
    
    {----------------TImageObj.Create}
    constructor TImageObj.Create(MasterList: TSectionList; Position: integer; L: TAttributeList);
    var
      I: integer;
      S: string;
      NewSpace: integer;
      T: TAttribute;
    begin
    inherited Create;
    ParentSectionList := MasterList;
    Pos := Position;
    ObjAlign := ABottom;   {default}
    NewSpace := -1;
    SpecHeight := -1;
    SpecWidth := -1;    
    for I := 0 to L.Count-1 do
      with TAttribute(L[I]) do
        case Which of
          SrcSy: Source := Trim(Name);   
          AltSy:
            begin
            FAlt := Name;
            while (Length(FAlt) > 0) and (FAlt[Length(FAlt)] in [#$D, #$A]) do
              Delete(FAlt, Length(FAlt), 1);
            ImageTitle := FAlt;    {use Alt as default Title}
            FAltW := MultibyteToWideString(CodePage, FAlt);
            end;
          IsMapSy:  IsMap := True;
          UseMapSy:
            begin
            UseMap := True;
            S := Trim(Uppercase(Name));
            if (Length(S) > 1) and (S[1] = '#') then
              System.Delete(S, 1, 1);
            MapName := S;
            end;
          AlignSy:
            begin
            S := UpperCase(Name);
            if S = 'TOP' then ObjAlign := ATop
            else if (S = 'MIDDLE') or (S = 'ABSMIDDLE') then ObjAlign := AMiddle
            else if S = 'LEFT' then ObjAlign := ALeft
            else if S = 'RIGHT' then ObjAlign := ARight;
            end;
          BorderSy: begin
                    NoBorder := Value = 0;
                    BorderSize := IntMin(IntMax(0, Value), 10);
                    end;
          TranspSy: Transparent := LLCorner;
          HeightSy:if System.Pos('%', Name) > 0 then   
                     begin
                     if (Value >= 0) and (Value <=100) then
                       begin
                       SpecHeight := Value;
                       PercentHeight := True;
                       end;
                     end
                   else
                     SpecHeight := Value;
          WidthSy:if System.Pos('%', Name) > 0 then
                    begin
                    if (Value >= 0) and (Value <=100) then
                      begin
                      SpecWidth := Value;
                      PercentWidth := True;
                      end;
                    end
                  else
                    SpecWidth := Value;
          HSpaceSy:  NewSpace := IntMin(40, Abs(Value));
          VSpaceSy:  VSpaceT := IntMin(40, Abs(Value));
          ActiveSy:  FHoverImage := True;
          NameSy: ParentSectionList.IDNameList.AddObject(Name, Self);  
          end;
    if L.Find(TitleSy, T) then
      ImageTitle := T.Name;   {has higher priority than Alt loaded above}
    if L.TheID <> '' then
      ParentSectionList.IDNameList.AddObject(L.TheID, Self);
    
    if NewSpace >= 0 then   
      HSpaceL := NewSpace
    else if ObjAlign in [ALeft, ARight] then
      HSpaceL := ImageSpace   {default}
    else HSpaceL := 0;
    HSpaceR := HSpaceL;
    VSpaceB := VSpaceT;
    end;
    
    constructor TImageObj.SimpleCreate(MasterList: TSectionList; const AnURL: string);
    begin
    inherited Create;
    ParentSectionList := MasterList;
    ObjAlign := ABottom;   {default}
    Source := AnURL;
    NoBorder := True;
    BorderSize := 0;
    SpecHeight := -1;   
    SpecWidth := -1;    
    end;
    
    procedure TFloatingObj.ProcessProperties(Prop: TProperties);
    const     
      DummyHtWd = 200;
    var
      MargArrayO: TVMarginArray;
      MargArray: TMarginArray;
      Align: AlignmentType;
      EmSize, ExSize: integer;
    begin
    if Prop.GetVertAlign(Align) then
      ObjAlign := Align;
    if Prop.GetFloat(Align) and (Align <> ANone) then
      begin
      if HSpaceR = 0 then
        begin  {default is different for Align = left/right}
        HSpaceR := ImageSpace;
        HSpaceL := ImageSpace;
        end;
      ObjAlign := Align;
      end;
    if ImageTitle = '' then  {a Title attribute will have higher priority than inherited}
      ImageTitle := Prop.PropTitle;
    Prop.GetVMarginArray(MargArrayO);
    EmSize := Prop.EmSize;
    ExSize := Prop.ExSize;
    ConvInlineMargArray(MargArrayO, DummyHtWd, DummyHtWd, EmSize, ExSize, MargArray);
    
    if MargArray[MarginLeft] <> IntNull then
      HSpaceL := MargArray[MarginLeft];
    if MargArray[MarginRight] <> IntNull then
      HSpaceR := MargArray[MarginRight];
    if MargArray[MarginTop] <> IntNull then
      VSpaceT := MargArray[MarginTop];
    if MargArray[MarginBottom] <> IntNull then
      VSpaceB := MargArray[MarginBottom];
    
    if Prop.GetBorderStyle <> bssNone then   
      begin
      Inc(HSpaceL, MargArray[BorderLeftWidth]);
      Inc(HSpaceR, MargArray[BorderRightWidth]);
      Inc(VSpaceT, MargArray[BorderTopWidth]);
      Inc(VSpaceB, MargArray[BorderBottomWidth]);
      end;
    
    if MargArray[Width] <> IntNull then
      begin
      PercentWidth := False;
      if MargArray[Width] = Auto then
        SpecWidth := -1
      else if (VarType(MargArrayO[Width]) = varString)
               and (System.Pos('%', MargArrayO[Width]) > 0) then
        begin
        PercentWidth := True;
        SpecWidth := MulDiv(MargArray[Width], 100, DummyHtWd);  
        end
      else
        SpecWidth := MargArray[Width];    
      end;
    if MargArray[Height] <> IntNull then
      begin
      PercentHeight := False;
      if MargArray[Height] = Auto then
        SpecHeight := -1
      else if (VarType(MargArrayO[Height]) = varString)
               and (System.Pos('%', MargArrayO[Height]) > 0) then
        begin
        PercentHeight := True;
        SpecHeight := MulDiv(MargArray[Height], 100, DummyHtWd);    
        end
      else
        SpecHeight := MargArray[Height];      
      end;
    
    if Prop.GetVertAlign(Align) then
      ObjAlign := Align;
    if Prop.GetFloat(Align) and (Align <> ANone) then
      ObjAlign := Align;
    if Prop.BorderStyleNotBlank then
      begin
      NoBorder := True;    {will have inline border instead}
      BorderSize := 0;      
      end;
    end;
    
    constructor TImageObj.CreateCopy(AMasterList: TSectionList; T: TImageObj);
    begin
    inherited CreateCopy(T);
    ParentSectionList := AMasterList;
    ImageKnown := T.ImageKnown;
    ObjHeight := T.ObjHeight;
    ObjWidth := T.ObjWidth;
    SpecHeight := T.SpecHeight;
    SpecWidth := T.SpecWidth;
    PercentWidth := T.PercentWidth;
    PercentHeight := T.PercentHeight;
    Image := T.Image;
    Mask := T.Mask;
    IsMap := T.IsMap;
    Transparent := T.Transparent;
    FBitmap := Nil;
    end;
    
    destructor TImageObj.Destroy;
    begin
    if not ParentSectionList.IsCopy then
      begin
      if (Source <> '') and Assigned(OrigImage) then  
        ParentSectionList.BitmapList.DecUsage(Source);
      if Swapped and (Image <> OrigImage) then   
        begin      {not in cache}
        Image.Free;
        Mask.Free;
        end;
      if (OrigImage is TGifImage) and TGifImage(OrigImage).IsCopy then
        OrigImage.Free;
      end;
    FreeAndNil(FBitmap);    
    inherited Destroy;
    end;
    
    function TImageObj.GetBitmap: TBitmap;    
    begin
    Result := Nil;
    if Image = ErrorBitmap then
      Exit;
    if (Image is TGifImage) then
      Result := TGifImage(Image).Bitmap
    else if (Image is TBitmap) or (Image is TGpBitmap) then 
      begin
      if Assigned(FBitmap) then
        Result := FBitmap
      else
        begin
        if (Image is TBitmap) then
          begin
          FBitmap := TBitmap.Create;
          FBitmap.Assign(TBitmap(Image));
          if ColorBits = 8 then
            FBitmap.Palette := CopyPalette(ThePalette);
          end
        else    {it's a TGpBitmap}       
          FBitmap := TGpBitmap(Image).GetTBitmap;
        Result := FBitmap;
        end;
      end
    {$ifndef NoMetafile}
    else if (Image is ThtMetaFile) then     
      Result := ThtMetaFile(Image).WhiteBGBitmap;    
    {$endif}
    end;
    
    procedure TImageObj.SetHover(Value: HoverType);    
    begin
    if (Value <> FHover) and FHoverImage and (Image is TGifImage) then   
      with TGifImage(Image) do
        begin
        if Value <> hvOff then
          case NumFrames of
            2: CurrentFrame := 2;
            3: if Value = hvOverDown then
                CurrentFrame := 3
               else CurrentFrame := 2;
          else
            begin
            Animate := True;
            ParentSectionList.AGifList.Add(Image);
            end;
          end
        else
          begin
          Animate := False;
          if NumFrames <= 3 then    
            CurrentFrame := 1;
          ParentSectionList.AGifList.Remove(Image);
          end;
        FHover := Value;
        ParentSectionList.PPanel.Invalidate;
        end;
    end;    
    
    {----------------TImageObj.ReplaceImage}
    procedure TImageObj.ReplaceImage(NewImage: TStream);   
    var
      TmpImage: TGpObject;
      NonAnimated: boolean;
      AMask: TBitmap;
      Stream: TMemoryStream;
      Tmp: TGifImage;
      I: integer;
    begin
    Transparent := NotTransp;
    AMask := Nil;
    TmpImage := Nil;
    Stream := TMemoryStream.Create;
    try
      Stream.LoadFromStream(NewImage);
      if Assigned(Stream) and (Stream.Memory <> Nil) and (Stream.Size >= 1) then
        begin
        NonAnimated := True;
        if KindOfImage(Stream.Memory) in [GIF, Gif89] then
          TmpImage := CreateAGifFromStream(NonAnimated, Stream);
        if Assigned(TmpImage) then
          begin
          if NonAnimated then
            begin     {else already have animated GIF}
            Tmp := TGifImage(TmpImage);
            TmpImage := TBitmap.Create;
            TBitmap(TmpImage).Assign(Tmp.MaskedBitmap);    
            if Tmp.IsTransparent then
              begin
              AMask := TBitmap.Create;
              AMask.Assign(Tmp.Mask);
              Transparent := TGif;
              end;
            Tmp.Free;
            end;
          end
        else
          TmpImage := GetImageAndMaskFromStream(Stream, Transparent, AMask);
        end;
    finally
      Stream.Free;
      end;
    if Assigned(TmpImage) then
      begin
      if not Swapped then
        begin
        {OrigImage is left in cache and kept}
        if (Image is TGifImage) then
          ParentSectionList.AGifList.Remove(Image);
        Swapped := True;
        end
      else   {swapped already}
        begin
        if (Image is TGifImage) then
          begin
          ParentSectionList.AGifList.Remove(Image);
          end;
        Image.Free;     
        FreeAndNil(Mask);
        end;
      FreeAndNil(FBitmap);
      Image := TmpImage;
      if (Image is TGifImage) then
        begin
        if not FHoverImage then
          begin
          TGifImage(Image).Animate := True;
          ParentSectionList.AGifList.Add(Image);
          end
        else
          begin
          TGifImage(Image).Animate := False;
          SetHover(hvOff);
          end;
        end;
      Mask := AMask;
      if Missing then
        begin    {if waiting for image, no longer want it}
        with ParentSectionList.MissingImages do
          for I := 0 to count-1 do
            if Objects[I] = Self then
              begin
              Delete(I);
              break;
              end;
        Missing := False;
        end;
      ParentSectionList.PPanel.Invalidate;
      end;
    end;
    
    {----------------TImageObj.InsertImage}     
    function TImageObj.InsertImage(const UName: string; Error: boolean; var Reformat: boolean): boolean;
    var
      TmpImage: TgpObject;
      FromCache, IsAniGIF, Delay: boolean;
    begin
    Result := False;
    Reformat := False;
    if (Image = DefBitmap) then
      begin
      Result := True;
      if Error then   
        begin
        Image := ErrorBitmap;
        Mask := ErrorBitmapMask;
        Transparent := LLCorner;
        end
      else
        begin
        TmpImage := ParentSectionList.GetTheBitmap(UName, Transparent, Mask, FromCache, Delay);
        if not Assigned(TmpImage) then
          Exit;
        IsAniGIF := TmpImage is TGifImage;
    
        if IsAniGIF then
          begin
          if FromCache then   {it would be}
            Image := TGifImage.CreateCopy(TGifImage(TmpImage))  {it's in Cache already, make copy}
          else
            Image := TmpImage;
          if not FHoverImage then
            begin
            ParentSectionList.AGifList.Add(Image);
            TGifImage(Image).Animate := True;
            if Assigned(ParentSectionList.Timer) then
              ParentSectionList.Timer.Enabled := True;
            end
          else TGifImage(Image).Animate := False;
          end
        else Image := TmpImage;
        OrigImage := Image;
        end;
      Missing := False;
    
      if not ImageKnown then
        Reformat := True;  {need to get the dimensions}
      end;
    end;
    
    {----------------TImageObj.DrawLogic}
    procedure TImageObj.DrawLogic(SectionList: TSectionList; Canvas: TCanvas;
                  FO: TFontObj; AvailableWidth, AvailableHeight: integer);
    {calculate the height and width}
    var
      TmpImage: TgpObject;
      ImHeight, ImWidth: integer;
      ViewImages, FromCache: boolean;
      Rslt: string;
      ARect: TRect;
      SubstImage: Boolean;
      HasBlueBox: Boolean;   
    
    begin
    ViewImages := ParentSectionList.ShowImages;
    
    TmpImage := Image;
    if ViewImages and not Assigned(TmpImage) then
      begin
      if Source <> '' then
        with SectionList do
          begin  
          if not Assigned(GetBitmap) and not Assigned(GetImage) then
            Source := (TheOwner as ThtmlViewer).HTMLExpandFilename(Source)
          else if Assigned(ExpandName) then
            begin
            ExpandName(TheOwner, Source, Rslt);
            Source := Rslt;
            end;
          if MissingImages.IndexOf(Uppercase(Source)) = -1 then
            TmpImage := ParentSectionList.GetTheBitmap(Source, Transparent, Mask, FromCache, Missing)
          else Missing := True;  {already in list, don't request it again}  
          end;
      if not Assigned(TmpImage) then
        begin
        if Missing then
          begin
          Image := DefBitmap;
          TmpImage := DefBitmap;
          ParentSectionList.MissingImages.AddObject(Source, Self); {add it even if it's there already}
          end
        else
          begin
          Image := ErrorBitmap;
          TmpImage := ErrorBitmap;
          Mask := ErrorBitmapMask;
          Transparent := LLCorner;
          end;
        end
      else if TmpImage is TGifImage then
        begin
        if FromCache then
          begin  {it's in Cache already, make copy}
          Image := TGifImage.CreateCopy(TGifImage(TmpImage));
          TmpImage := Image;
          end
        else
          Image := TmpImage;
        OrigImage := Image;   
        if not FHoverImage then
          ParentSectionList.AGifList.Add(Image)
        else TGifImage(Image).Animate := False;
        end
      else
        begin
        Image := TmpImage; //TBitmap(TmpImage);
        OrigImage := Image;  
        end;
      end;
    if not ViewImages then
      TmpImage := DefBitMap;
    
    ImHeight := GetImageHeight(TmpImage);
    ImWidth := GetImageWidth(TmpImage);
    
    SubstImage := (Image = ErrorBitmap) or (TmpImage = DefBitmap);  
    
    if not ImageKnown or PercentWidth or PercentHeight then
      begin
      if PercentWidth then
        begin
        ObjWidth := MulDiv(AvailableWidth-2*BorderSize, SpecWidth, 100);  
        if SpecHeight >= 0 then    
          if PercentHeight then
            ObjHeight := MulDiv(AvailableHeight-2*BorderSize, SpecHeight, 100)  
          else ObjHeight := SpecHeight
        else ObjHeight := MulDiv(ObjWidth, ImHeight, ImWidth);
        end
      else if PercentHeight then
        begin
        ObjHeight := MulDiv(AvailableHeight-2*BorderSize, SpecHeight, 100);  
        if SpecWidth >= 0 then ObjWidth := SpecWidth    
          else ObjWidth := MulDiv(ObjHeight, ImWidth, ImHeight);
        end
      else if (SpecWidth >= 0) and (SpecHeight >= 0) then
        begin       {Both width and height specified}
        ObjHeight := SpecHeight;
        ObjWidth := SpecWidth;
        ImageKnown := True;
        end
      else if SpecHeight >= 0 then
        begin
        ObjHeight := SpecHeight;
        ObjWidth := MulDiv(SpecHeight, ImWidth, ImHeight);
        ImageKnown := not SubstImage;
        end
      else if SpecWidth >= 0 then
        begin
        ObjWidth := SpecWidth;
        ObjHeight := MulDiv(SpecWidth, ImHeight, ImWidth);
        ImageKnown := not SubstImage;
        end
      else
        begin       {neither height and width specified}
        ObjHeight := ImHeight;
        ObjWidth := ImWidth;
        ImageKnown := not SubstImage;  
        end;
      end;
    
    if (not ViewImages or SubstImage) then 
      begin
      if (SpecWidth >= 0) or (SpecHeight >= 0) then
        begin  {size to whatever is specified}
        AltWidth := ObjWidth;
        AltHeight := ObjHeight;
        end
      else if FAltW <> '' then   {Alt text and no size specified, take as much space as necessary}
        begin
        Canvas.Font.Name := 'Arial';{use same font as in Draw}
        Canvas.Font.Size := 8;      
        ARect := Rect(0, 0, 0, 0);
        DrawTextW(Canvas.Handle, PWideChar(FAltW+CRLF), -1, ARect, DT_CALCRECT);  
        with ARect do
          begin
          AltWidth := Right + 16+8+2;
          AltHeight := IntMax(16+8, Bottom);
          end;
        end
      else
        begin  {no Alt text and no size spedified}
        AltWidth := IntMax(ObjWidth, 16+8);   
        AltHeight := IntMax(ObjHeight, 16+8);
        end;
      ImageHeight := AltHeight;
      ImageWidth := AltWidth;
      end
    else
      begin
      ImageHeight := ObjHeight;
      ImageWidth := ObjWidth;
      end;
    
    HasBlueBox := not NoBorder and Assigned(FO) and (FO.URLTarget.Url <> '');  
    if HasBlueBox then
      BorderSize := IntMax(1, BorderSize);
    
    if (BorderSize > 0) then
      begin
      Inc(ImageHeight, 2*BorderSize);      {extra pixels top and bottom for border}  
      Inc(ImageWidth, 2*BorderSize);
      end;
    end;
    
    {----------------TImageObj.DoDraw}
    procedure TImageObj.DoDraw(Canvas: TCanvas; XX: integer; Y: integer;
                   ddImage: TgpObject; ddMask: TBitmap);
    {Y relative to top of display here}
    var
      DC: HDC;
      Img: TBitmap;
      W, H: integer;
      BMHandle: HBitmap;
      PrintTransparent: boolean;
    begin
    DC := Canvas.Handle;
    if TObject(ddImage) is TGPImage then
      begin
      if not ParentSectionList.Printing then
        StretchDrawGpImage(DC, TGPImage(ddImage),XX,Y, ObjWidth, ObjHeight)
      else if not ParentSectionList.PrintBackground and (Positioning = posStatic) then  {Printing}
        StretchPrintGpImageOnColor(Canvas, TGpImage(ddImage), XX, Y, ObjWidth, ObjHeight)
      else
        StretchPrintGpImageDirect(DC, TGPImage(ddImage),XX,Y, ObjWidth, ObjHeight,
               ParentSectionList.ScaleX, ParentSectionList.ScaleY);
      Exit;
      end;
    if (ddImage is TGifImage) and not ParentSectionList.IsCopy then
      with TGifImage(ddImage) do
        begin
        ShowIt := True;
        Visible := True;
        Draw(Canvas, XX, Y, ObjWidth, ObjHeight);
        Exit;
        end;
    try
      if not ParentSectionList.IsCopy then
        begin
        if ((Transparent <> NotTransp) or (ddImage = ErrorBitmap)) and Assigned(ddMask) then  
          if ddImage = ErrorBitmap then
            FinishTransparentBitmap(DC, TBitmap(ddImage), Mask, XX, Y,
                        TBitmap(ddImage).Width, TBitmap(ddImage).Height)
          else
            FinishTransparentBitmap(DC, TBitmap(ddImage), Mask, XX, Y, ObjWidth, ObjHeight)
        else
          begin
          Img := TBitmap(ddImage);
          if (ddImage = DefBitMap) or (ddImage = ErrorBitmap) then
            BitBlt(DC, XX, Y, Img.Width, Img.Height, Img.Canvas.Handle, 0, 0, SRCCOPY)
          else if ddImage is TBitmap then   
            begin
            SetStretchBltMode(DC, ColorOnColor);
            StretchBlt(DC, XX, Y, ObjWidth, ObjHeight, Img.Canvas.Handle, 0, 0, Img.Width, Img.Height, SRCCOPY);
            end
          {$ifndef NoMetafile}
          else if ddImage is ThtMetaFile then    
            Canvas.StretchDraw(Rect(XX, Y, XX+ObjWidth, Y+ObjHeight), ThtMetaFile(ddImage));
          {$endif}
          end;
        end
      else
        begin       {printing}
        if ddImage is TGifImage then
          with TGifImage(ddImage) do
            begin
            ddMask := Mask;
            if Assigned(ddMask) then Transparent := TGif;
            ddImage := MaskedBitmap;
            TBitmap(ddImage).Palette := CopyPalette(ThePalette);
            TBitmap(ddImage).HandleType := bmDIB;
            end;
        if (ddImage = DefBitMap) or (ddImage = ErrorBitmap) then
          begin
          W := TBitmap(ddImage).Width;
          H := TBitmap(ddImage).Height;
          end
        else
          begin
          W := ObjWidth;
          H := ObjHeight;
          end;
    
        PrintTransparent := ((Transparent <> NotTransp) or (ddImage = ErrorBitmap))
                         and Assigned(ddMask);
        if PrintTransparent then
          PrintTransparentBitmap3(Canvas, XX, Y, W, H, TBitmap(ddImage), ddMask, 0, TBitmap(ddImage).Height)
        else if ddImage is TBitmap then
          begin   {printing, not transparent}
          BMHandle := TBitmap(ddImage).Handle;
          PrintBitmap(Canvas, XX, Y, W, H, BMHandle);
          end
        {$ifndef NoMetafile}
        else if ddImage is ThtMetaFile then
          Canvas.StretchDraw(Rect(XX, Y, XX+ObjWidth, Y+ObjHeight), ThtMetaFile(ddImage));
        {$endif}
        end;
    except
      end;
    end;
    
    {----------------TImageObj.Draw}
    procedure TImageObj.Draw(Canvas: TCanvas; X: integer; TopY, YBaseline: integer;
                                     FO: TFontObj);
    var
      TmpImage: TgpObject;
      TmpMask: TBitmap;
      MiddleAlignTop: integer;
      ViewImages: boolean;
      SubstImage: boolean;
      Ofst: integer;
      SaveColor: TColor;
      ARect: TRect;
      SaveWidth: Integer;
      SaveStyle: TPenStyle;
      YY: Integer;
    
    begin
    with ParentSectionList do
      begin
      ViewImages := ShowImages;
      Dec(TopY, YOff);
      Dec(YBaseLine, YOff);
      end;
    if ViewImages then
      begin
      TmpImage := Image;
      if Image is TBitmap then
        TmpMask := Mask
      else TmpMask := Nil;
      end
    else
      begin
      TmpImage := DefBitMap;
      TmpMask := Nil;
      end;
    SubstImage := not ViewImages or (TmpImage = ErrorBitmap) or (TmpImage = DefBitmap); {substitute image}
    
    with Canvas do
      begin
      Brush.Style := bsClear;
      Font.Size := 8;
      Font.Name := 'Arial';        {make this a property?}
      Font.Style := Font.Style - [fsBold];  
      if SubstImage then Ofst := 4 else Ofst := 0;
      if ObjAlign = AMiddle then
        MiddleAlignTop := YBaseLine+FO.Descent-(FO.tmHeight div 2)-((ImageHeight-VSpaceT+VSpaceB) div 2)
      else MiddleAlignTop := 0;   {not used}
    
      DrawXX := X;
      case ObjAlign of
          ALeft, ARight, ATop: DrawYY := TopY+VSpaceT;
          AMiddle: DrawYY := MiddleAlignTop;
          ABottom, ABaseline: DrawYY := YBaseLine-ImageHeight-VSpaceB;
          end;
      if (BorderSize > 0) then
        begin
        Inc(DrawXX, BorderSize);
        Inc(DrawYY, BorderSize);
        end;
    
      if not SubstImage or (AltHeight >= 16+8) and (AltWidth >= 16+8) then
        DoDraw(Canvas, DrawXX+Ofst, DrawYY+Ofst, TmpImage, TmpMask);
      Inc(DrawYY, ParentSectionList.YOff);
      SetTextAlign(Canvas.Handle, TA_Top);
      if SubstImage and (BorderSize = 0) then
        begin
        Font.Color := FO.TheFont.Color;
        {calc the offset from the image's base to the alt= text baseline}
        case ObjAlign of
          ATop, ALeft, ARight:
            begin
            if FAltW <> '' then
              WrapTextW(Canvas, X+24, TopY+Ofst+VSpaceT, X+AltWidth-2, TopY+AltHeight-1+VSpaceT, FAltW);
            RaisedRect(ParentSectionList, Canvas, X, TopY+VSpaceT,
                                          X+AltWidth-1, TopY+AltHeight-1+VSpaceT, False, 1);
            end;
          AMiddle:
            begin   {MiddleAlignTop is always initialized}
            if FAltW <> '' then
              WrapTextW(Canvas, X+24, MiddleAlignTop+Ofst, X+AltWidth-2,
                  MiddleAlignTop+AltHeight-1, FAltW);
            RaisedRect(ParentSectionList, Canvas, X, MiddleAlignTop,
                             X+AltWidth-1, MiddleAlignTop+AltHeight-1, False, 1);
            end;
          ABottom, ABaseline:
            begin
            if FAltW <> '' then
              WrapTextW(Canvas, X+24, YBaseLine-AltHeight+Ofst-VSpaceB, X+AltWidth-2,
                       YBaseLine-VSpaceB-1, FAltW);  
            RaisedRect(ParentSectionList, Canvas, X, YBaseLine-AltHeight-VSpaceB,
                                          X+AltWidth-1, YBaseLine-VSpaceB-1, False, 1);
            end;
          end;
        end;
      if (BorderSize > 0) then   
        begin
        SaveColor := Pen.Color;
        SaveWidth := Pen.Width;
        SaveStyle := Pen.Style;
        Pen.Color := FO.TheFont.Color;
        Pen.Width := BorderSize;  
        Pen.Style := psInsideFrame;   
        Font.Color := Pen.Color;
        try
          if (FAltW <> '') and SubstImage then  {output Alt message}
            begin
            YY := DrawYY-ParentSectionList.YOff;
            case ObjAlign of
              ALeft, ARight, ATop:
                WrapTextW(Canvas, DrawXX+24, YY+Ofst, DrawXX+AltWidth-2, YY+AltHeight-1, FAltW);
              AMiddle:
                WrapTextW(Canvas, DrawXX+24, YY+Ofst, DrawXX+AltWidth-2,
                    YY+AltHeight-1, FAltW);
              ABottom, ABaseline:
                WrapTextW(Canvas, DrawXX+24, YY+Ofst, DrawXX+AltWidth-2,
                         YY+AltHeight-1, FAltW);
              end;
            end;
          case ObjAlign of   {draw border}  
            ALeft, ARight, ATop: Rectangle(X, TopY+VSpaceT, X+ImageWidth, TopY+VSpaceT+ImageHeight);
            AMiddle: Rectangle(X, MiddleAlignTop, X+ImageWidth, MiddleAlignTop + ImageHeight);
            ABottom, ABaseline: Rectangle(X, YBaseLine-ImageHeight-VSpaceB, X+ImageWidth, YBaseLine-VSpaceB);
            end;
        finally
          Pen.Color := SaveColor;
          Pen.Width:= SaveWidth;
          Pen.Style:= SaveStyle;
          end;
        end;
      if (Assigned(MyFormControl) and MyFormControl.Active or FO.Active) or
             ParentSectionList.IsCopy and Assigned(ParentSectionList.LinkDrawnEvent)
                                 and (FO.UrlTarget.Url <> '') then
        begin
        SaveColor := SetTextColor(Handle, clBlack);
        Brush.Color := clWhite;
        case ObjAlign of
          ALeft, ARight, ATop:
              ARect := Rect(X, TopY+VSpaceT, X+ImageWidth, TopY+VSpaceT+ImageHeight);
          AMiddle:
              ARect := Rect(X, MiddleAlignTop, X+ImageWidth, MiddleAlignTop + ImageHeight);
          ABottom, ABaseline:
              ARect := Rect(X, YBaseLine-ImageHeight-VSpaceB, X+ImageWidth, YBaseLine-VSpaceB);
          end;
        if not ParentSectionList.IsCopy then
          Canvas.DrawFocusRect(ARect)  {draw focus box}
        else
          ParentSectionList.LinkDrawnEvent(ParentSectionList.TheOwner, ParentSectionList.LinkPage,
                   FO.UrlTarget.Url, FO.UrlTarget.Target, ARect);
        SetTextColor(handle, SaveColor);
        end;
      end;
    end;
    
    {----------------TImageObjList.CreateCopy}
    constructor TImageObjList.CreateCopy(AMasterList: TSectionList; T: TImageObjList);
    var
      I: integer;
      Item: TObject;  
    begin
    inherited create;
    for I := 0 to T.Count-1 do
      begin
      Item := T.Items[I];
      if Item is TImageObj then
        Add(TImageObj.CreateCopy(AMasterList, TImageObj(Item)))
      else Add(TPanelObj.CreateCopy(AMasterList, TPanelObj(Item)));
      end;
    end;
    
    function TImageObjList.FindImage(Posn: integer): TFloatingObj;  
    {find the image at a given character position}
    var
      I: integer;
    begin
    for I := 0 to Count-1 do
      if TFloatingObj(Items[I]).Pos = Posn then  
        begin
        Result := Items[I];
        Exit;
        end;
    Result := Nil;
    end;
    
    function TImageObjList.GetHeightAt(Posn: integer; var AAlign: AlignmentType;
             var FlObj: TFloatingObj) : Integer;
    begin
    FLObj := FindImage(Posn);
    if Assigned(FLObj) then
      begin
      Result := FLObj.ImageHeight+FLObj.VSpaceT+FLObj.VSpaceB;
      AAlign := FLObj.ObjAlign;
      end
    else Result := -1;
    end;
    
    function TImageObjList.GetWidthAt(Posn: integer; var AAlign: AlignmentType;
                    var HSpcL, HSpcR: integer; var FlObj: TFloatingObj) : integer;
    begin
    FLObj := FindImage(Posn);
    if Assigned(FLObj) then
      begin
      Result := FLObj.ImageWidth;
      AAlign := FLObj.ObjAlign;
      HSpcL := FLObj.HSpaceL;    
      HSpcR := FLObj.HSpaceR;    
      end
    else Result := -1;
    end;
    
    function TImageObjList.GetImageCountAt(Posn: integer): integer;
    {Return count of chars before the next image.  0 if at the image, 99999999 if no
     images after Posn}
    var
      I, Pos: integer;
    begin
    if Count = 0 then
      begin
      Result := 99999999;
      Exit;
      end;
    I := 0;
    while I < count do
      begin
      Pos := TFloatingObj(Items[I]).Pos;
      if Pos >= Posn then break;
      Inc(I);
      end;
    if I = Count then Result := 99999999
    else
      Result := TFloatingObj(Items[I]).Pos - Posn;
    end;
    
    {----------------TImageObjList.Decrement}
    procedure TImageObjList.Decrement(N: integer);
    {called when a character is removed to change the Position figure}
    var
      I: integer;
    begin
    for I := 0 to Count-1 do
      with TImageObj(Items[I]) do
        if Pos > N then
          Dec(Pos);
    end;
    
    {----------------TImageObjList.PtInImage}
    function TImageObjList.PtInImage(X: integer; Y: integer; var IX, IY, Posn: integer;
                    var AMap, UMap: boolean; var MapItem: TMapItem;
                    var ImageObj: TImageObj): boolean;
    var
      I, J, LimX, LimY: integer;
      LIY: integer;
      Obj: TObject;   
    begin
    Result := False;
    for I := 0 to Count-1 do
      begin
      Obj := Items[I];   
      if Obj is TImageObj then
        with TImageObj(Obj) do
          begin
          IX := X-DrawXX;    {these are actual image, box if any is outside}
          LIY := Y - DrawYY;
          LimX := ImageWidth-2*BorderSize;   
          LimY:= ImageHeight-2*BorderSize;
          if (IX >= 0) and (IX < LimX) and (LIY >= 0) and (LIY < LimY) then
            begin
            IY := LIY;
            Result := True;
            AMap := IsMap;
            Posn := Pos;
            UMap := False;
            ImageObj := TImageObj(Obj);   
            if UseMap then
              with ParentSectionList.MapList do
                for J := 0 to Count-1 do
                  begin
                  MapItem := Items[J];
                  if MapItem.MapName = MapName then
                    begin
                    UMap := True;
                    Exit;
                    end;
                  end;
            Exit;
            end;
          end;
      end;
    end;
    
    function TImageObjList.PtInObject(X : integer; Y: integer; var Obj: TObject;
             var IX, IY: integer): boolean;
    var
      I, LimX, LimY: integer;
      LIY: integer;
      Item: TObject;   
    begin
    Result := False;
    for I := 0 to Count-1 do
      begin
      Item := Items[I]; 
      if Item is TImageObj then
        with TImageObj(Item) do
          begin
          IX := X-DrawXX;    {these are actual image, box if any is outside}
          LIY := Y - DrawYY;
          LimX := ImageWidth-2*BorderSize;   
          LimY:= ImageHeight-2*BorderSize;
          if (IX >= 0) and (IX < LimX) and (LIY >= 0) and (LIY < LimY) then
            begin
            IY := LIY;
            Result := True;
            Obj := Item;  
            Exit;
            end;
          end;
      end;
    end;
    
    {----------------ThtmlForm.Create}
    constructor ThtmlForm.Create(AMasterList: TSectionList; L : TAttributeList);
    var
      I: integer;
    begin
    inherited Create;
    MasterList := AMasterList;
    AMasterList.htmlFormList.Add(Self);
    Method := 'Get';
    if Assigned(L) then
      for I := 0 to L.Count-1 do
        with TAttribute(L[I]) do
          case Which of
            MethodSy: Method := Name;
            ActionSy: Action := Name;
            TargetSy: Target := Name;
            EncTypeSy: EncType := Name;
            end;
    ControlList := TFreeList.Create;
    end;
    
    destructor ThtmlForm.Destroy;
    begin
    ControlList.Free;
    inherited Destroy;
    end;
    
    procedure ThtmlForm.InsertControl(Ctrl: TFormControlObj);
    begin
    ControlList.Add(Ctrl);
    if not (Ctrl is THiddenFormControlObj) then Inc(NonHiddenCount);
    end;
    
    procedure ThtmlForm.DoRadios(Radio: TRadioButtonFormControlObj);
    var
      S: string;
      Ctrl: TFormControlObj;
      I: integer;
    begin
    if Radio.FName <>'' then
      begin
      S := Radio.FName;
      for I := 0 to ControlList.Count-1 do
        begin
        Ctrl := TFormControlObj(ControlList.Items[I]);
        if  (Ctrl is TRadioButtonFormControlObj) and (Ctrl <> Radio) then
          if CompareText(Ctrl.FName, S) = 0 then     
            begin
            TFormRadioButton(Ctrl.TheControl).Checked := False;
            TFormRadioButton(Ctrl.TheControl).TabStop := False;   {first check turns off other tabstops}
            TRadioButtonFormControlObj(Ctrl).DoOnchange;
            end;
        end;
      end;
    end;
    
    procedure ThtmlForm.AKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);  
    var
      S: string;
      Ctrl: TFormControlObj;
      I: integer;
      List: TList;
    begin
    if (Key in [vk_up, vk_down, vk_left, vk_right]) and (Sender is TFormRadioButton) then
      begin
      S := TFormRadioButton(Sender).IDName;
      List:= TList.Create;
      try
        for I := 0 to ControlList.Count-1 do
          begin
          Ctrl := TFormControlObj(ControlList.Items[I]);
          if  (Ctrl is TRadioButtonFormControlObj) and
                    (CompareText(Ctrl.FName, S) = 0) then
              List.Add(TRadioButtonFormControlObj(Ctrl).TheControl);
          end;
        I := List.IndexOf(Sender);
        if I >= 0 then
          begin
          if (Key in [vk_up, vk_left]) then
            begin
            if I > 0 then
              Dec(I);
            end
          else if I < List.Count-1 then
            Inc(I);
          TFormRadioButton(List.Items[I]).SetFocus;
          end;
      finally
        List.Free;
        end;
      end
    else  {send other keys to ThtmlViewer}
      ThtmlViewer(MasterList.TheOwner).KeyDown(Key, Shift);
    end;
    
    procedure ThtmlForm.ResetControls;
    var
      I: integer;
    begin
    for I := 0 to ControlList.Count-1 do
      TFormControlObj(ControlList.Items[I]).ResetToValue;
    end;
    
    procedure ThtmlForm.ControlKeyPress(Sender: TObject; var Key: char);
    begin
    if (Sender is ThtEdit) then
      if (Key = #13) then
        begin
        SubmitTheForm('');
        Key := #0;
        end;
    end;
    
    function ThtmlForm.GetFormSubmission: TStringList;
    var                                                    
      I, J: integer;
      S: string;
    begin
    Result := TStringList.Create;
    for I := 0 to ControlList.Count-1 do
      with  TFormControlObj(ControlList.Items[I]) do
        begin
        J := 0;
        while GetSubmission(J, S) do
          begin
          if S <> '' then
            Result.Add(S);
          Inc(J);
          end;
        end;
    end;
    
    procedure ThtmlForm.SubmitTheForm(const ButtonSubmission: string);
    var
      I, J: integer;
      SL: TStringList;
      S: string;                              
    begin
    if Assigned(MasterList.SubmitForm) then
      begin
      SL := TStringList.Create;
      for I := 0 to ControlList.Count-1 do
        with  TFormControlObj(ControlList.Items[I]) do
          begin
          J := 0;
          if not Disabled then   
            while GetSubmission(J, S) do
              begin
              if S <> '' then
                SL.Add(S);
              Inc(J);
              end;
          end;
      if ButtonSubmission <> '' then
        SL.Add(ButtonSubmission);
      MasterList.SubmitForm(MasterList.TheOwner, Action, Target, EncType, Method, SL);
      end;
    end;
    
    procedure ThtmlForm.SetFormData(SL: TStringList);    
    var
      I, J, K, Index: integer;
      Value: string;
      FormControl: TFormControlObj;
    begin
    for I := 0 to ControlList.Count-1 do
      begin
      FormControl := TFormControlObj(ControlList[I]);
      FormControl.SetDataInit;
      Index := 0;
      for J := 0 to SL.Count-1 do
        if CompareText(FormControl.FName, SL.Names[J]) = 0 then
          begin
          K := Pos('=', SL[J]);
          if K > 0 then
            begin
            Value := Copy(SL[J], K+1, Length(SL[J])-K);
            FormControl.SetData(Index, Value);
            Inc(Index);
            end;
          end;
      end;
    end;
    
    procedure ThtmlForm.SetSizes(Canvas: TCanvas);
    var
      I: integer;
    begin
    for I := 0 to ControlList.Count-1 do
      TFormControlObj(ControlList.Items[I]).SetHeightWidth(Canvas);
    end;
    
    {----------------TFormControlObj.Create}
    constructor TFormControlObj.Create(AMasterList: TSectionList;
                Position: integer; L: TAttributeList);
    var
      I: integer;
    begin
    inherited Create;
    Pos := Position;
    MasterList := AMasterList;
    if not Assigned(CurrentForm) then   {maybe someone forgot the 
    tag} CurrentForm := ThtmlForm.Create(AMasterList, Nil); AMasterList.FormControlList.Add(Self); MyForm := CurrentForm; for I := 0 to L.Count-1 do with TAttribute(L[I]) do case Which of ValueSy: Self.Value := Name; NameSy: Self.FName := Name; IDSy: FID := Name; OnClickSy: OnClickMessage := Name; OnFocusSy: OnFocusMessage := Name; OnBlurSy: OnBlurMessage := Name; OnChangeSy: OnChangeMessage := Name; TabIndexSy: if Value > 0 then {Adding leading 0's to the number string allows it to be sorted numerically, and the Count takes care of duplicates} with AMasterList.TabOrderList do AddObject(Format('%.5d%.3d', [Value, Count]), Self); TitleSy: FTitle := Name; DisabledSy: Disabled := (Lowercase(Name) <> 'no') and (Name <> '0'); ReadonlySy: ReadOnly := True; end; if L.TheID <> '' then MasterList.IDNameList.AddObject(L.TheID, Self); AttributeList := L.CreateStringList; FormAlign := ABottom; {ABaseline set individually} MyForm.InsertControl(Self); end; constructor TFormControlObj.CreateCopy(T: TFormControlObj); begin inherited Create; {$IFNDEF FPC} System.Move(T.Pos, Pos, DWord(@FControl)-DWord(@Pos)); {$ELSE} System.Move(T.Pos, Pos, PtrUInt(@FControl)-PtrUInt(@Pos)); {$ENDIF} end; destructor TFormControlObj.Destroy; begin if Assigned(FControl) then {hidden controls are Nil} begin FControl.Parent := Nil; FControl.Free; end; AttributeList.Free; PaintBitmap.Free; inherited Destroy; end; procedure TFormControlObj.HandleMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); begin ThtmlViewer(MasterList.TheOwner).ControlMouseMove(Self, Shift, X, Y); end; function TFormControlObj.GetYPosition: integer; begin Result := YValue; end; procedure TFormControlObj.ProcessProperties(Prop: TProperties); var MargArrayO: TVMarginArray; MargArray: TMarginArray; Align: AlignmentType; EmSize, ExSize: integer; begin Prop.GetVMarginArray(MargArrayO); EmSize := Prop.EmSize; ExSize := Prop.ExSize; PercentWidth := (VarType(MargArrayO[Width]) = VarString) and (System.Pos('%', MargArrayO[Width]) > 0); ConvInlineMargArray(MargArrayO, 100, 200, EmSize, ExSize, MargArray); VSpaceT := 1; VSpaceB := 1; if MargArray[MarginLeft] <> IntNull then HSpaceL := MargArray[MarginLeft]; if MargArray[MarginRight] <> IntNull then HSpaceR := MargArray[MarginRight]; if MargArray[MarginTop] <> IntNull then VSpaceT := MargArray[MarginTop]; if MargArray[MarginBottom] <> IntNull then VSpaceB := MargArray[MarginBottom]; if Prop.GetBorderStyle <> bssNone then begin Inc(HSpaceL, MargArray[BorderLeftWidth]); Inc(HSpaceR, MargArray[BorderRightWidth]); BordT := MargArray[BorderTopWidth]; BordB := MargArray[BorderBottomWidth]; Inc(VSpaceT, BordT); Inc(VSpaceB, BordB); end; if MargArray[Width] > 0 then {excludes IntNull and Auto} if PercentWidth then begin if MargArray[Width] <= 100 then FWidth := MargArray[Width] else PercentWidth := False; end else FWidth := MargArray[Width]; if MargArray[Height] > 0 then FHeight:= MargArray[Height]-BordT-BordB; if Prop.GetVertAlign(Align) then FormAlign := Align; BkColor := Prop.GetBackgroundColor; end; procedure TFormControlObj.EnterEvent(Sender: TObject); {Once form control entered, insure all form controls are tab active} {$ifndef FastRadio} var I: integer; {$endif} begin if MasterList.IsCopy then Exit; Active := True; MasterList.PPanel.Invalidate; MasterList.ControlEnterEvent(Self); {$ifndef FastRadio} with MasterList.FormControlList do begin for I := 0 to Count-1 do with TFormControlObj(Items[I]) do if not ShowIt and Assigned(FControl) then begin FControl.Show; {makes it tab active} FControl.Left := -4000; {even if it can't be seen} end; end; {$endif} if Assigned(MasterList.ObjectFocus) and (OnFocusMessage <> '') then MasterList.ObjectFocus(MasterList.TheOwner, Self, OnFocusMessage); if OnChangeMessage <> '' then SaveContents; end; procedure TFormControlObj.SaveContents; {Save the current value to see if it has changed when focus is lost} begin end; procedure TFormControlObj.ExitEvent(Sender: TObject); begin {$ifndef FastRadio} MasterList.AdjustFormControls; {$endif} Active := False; if OnChangeMessage <> '' then DoOnChange; if Assigned(MasterList.ObjectBlur) and (OnBlurMessage <> '') then MasterList.ObjectBlur(MasterList.TheOwner, Self, OnBlurMessage); MasterList.PPanel.Invalidate; end; procedure TFormControlObj.DoOnChange; begin end; function TFormControlObj.GetControl: TWinControl; begin Result := FControl; end; procedure TFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer); begin end; procedure TFormControlObj.ResetToValue; begin end; function TFormControlObj.GetSubmission(Index: integer; var S: string): boolean; begin Result := False; end; procedure TFormControlObj.SetDataInit; begin end; procedure TFormControlObj.SetData(Index: integer; const V: String); begin end; procedure TFormControlObj.SetHeightWidth(Canvas: TCanvas); begin end; procedure TFormControlObj.FormControlClick(Sender: TObject); begin if Assigned(MasterList.ObjectClick) then MasterList.ObjectClick(MasterList.TheOwner, Self, OnClickMessage); end; function TFormControlObj.GetAttribute(const AttrName: string): string; begin Result := AttributeList.Values[AttrName]; end; {----------------TImageFormControlObj.Create} constructor TImageFormControlObj.Create(AMasterList: TSectionList; Position: integer; L: TAttributeList); var PntPanel: TPaintPanel; begin inherited Create(AMasterList, Position, L); XPos := -1; {so a button press won't submit image data} PntPanel := TPaintPanel(AMasterList.PPanel); FControl := TButton.Create(PntPanel); with TButton(FControl) do begin Left := -4000 ; {so will be invisible until placed} Width := 1; Height := 1; OnEnter := EnterEvent; OnExit := ExitEvent; OnClick := ImageClick; Enabled := not Disabled; end; FControl.Parent := PntPanel; end; procedure TImageFormControlObj.ProcessProperties(Prop: TProperties); begin MyImage.ProcessProperties(Prop); end; procedure TImageFormControlObj.ImageClick(Sender: TObject); begin if FControl.CanFocus then FControl.SetFocus; FormControlClick(Self); XPos := XTmp; YPos := YTmp; if not Disabled then MyForm.SubmitTheForm(''); end; function TImageFormControlObj.GetSubmission(Index: integer; var S: string): boolean; begin Result := False; if (Index <= 1) and (XPos >= 0) then begin S := ''; if FName <> '' then S := FName+'.'; if Index = 0 then S := S+'x='+IntToStr(XPos) else begin {index = 1} S := S+'y='+IntToStr(YPos); XPos := -1; end; Result := True; end; end; {----------------THiddenFormControlObj.GetSubmission} function THiddenFormControlObj.GetSubmission(Index: integer; var S: string): boolean; begin Result := Index = 0; if Result then S := FName+'='+Value; end; procedure THiddenFormControlObj.SetData(Index: integer; const V: String); begin Value := V; end; {----------------TEditFormControlObj.Create} constructor TEditFormControlObj.Create(AMasterList: TSectionList; Position: integer; L: TAttributeList; const Typ: string; Prop: TProperties); var T: TAttribute; PntPanel: TPaintPanel; I: integer; Tmp: TMyFont; begin inherited Create(AMasterList, Position, L); CodePage := Prop.CodePage; EditSize := 15; if L.Find(SizeSy, T) then begin if T.Value > 0 then EditSize := T.Value else begin {see if it's comma delimited list} I := IntMin(System.Pos(',', T.Name), System.Pos(' ', T.Name)); if I > 1 then EditSize := StrToIntDef(copy(T.Name, 1, I-1), 20); end; end; PntPanel := TPaintPanel(AMasterList.PPanel); FControl := ThtEdit.Create(PntPanel); with ThtEdit(FControl) do begin Left := -4000 ; {so will be invisible until placed} Width := 120; if (Prop.GetBorderStyle <> bssNone) then BorderStyle := bsNone; Parent := PntPanel; Tmp := Prop.GetFont; Font.Assign(Tmp); FHeight := Height; {Height can change when font assigned} tmAveCharWidth := Tmp.tmAveCharWidth; Tmp.Free; if UnicodeControls then Text := MultibyteToWideString(CodePage, Value) else Text := Value; if L.Find(MaxLengthSy, T) then MaxLength := T.Value; if Typ = 'password' then PassWordChar := '*'; OnKeyPress := MyForm.ControlKeyPress; OnEnter := EnterEvent; OnExit := ExitEvent; OnClick := FormControlClick; OnMouseMove := HandleMouseMove; Enabled := not Disabled; ReadOnly := Self.Readonly; end; end; procedure TEditFormControlObj.ProcessProperties(Prop: TProperties); begin inherited; if BkColor <> clNone then ThtEdit(FControl).Color := BkColor; end; procedure TEditFormControlObj.ResetToValue; begin if UnicodeControls then ThtEdit(FControl).Text := MultibyteToWideString(CodePage, Value) else ThtEdit(FControl).Text := Value; end; {$ifdef bloop} procedure TEditFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer); var H2, Addon: integer; ARect: TRect; begin if ThtEdit(FControl).BorderStyle <> bsNone then Addon := 4 {normal 3D border} else Addon := 2; {inline border, 3D Border removed} with ThtEdit(FControl) do begin Canvas.Font := Font; H2 := Abs(Font.Height); if BorderStyle <> bsNone then FormControlRect(Canvas, X1, Y1, X1+Width, Y1+Height, False, MasterList.PrintMonoBlack, False, Color) else FillRectWhite(Canvas, X1, Y1, X1+Width, Y1+Height, Color); SetTextAlign(Canvas.handle, TA_Left); {$IFNDEF LCL} SetBkMode(Canvas.Handle, Windows.Transparent); {$ELSE} SetBkMode(Canvas.Handle, LclType.Transparent); {$ENDIF} Canvas.Brush.Style := bsClear; ARect := Rect(X1+Addon, Y1, X1+Width-(Addon div 2), Y1+Height); if UnicodeControls then {$Warnings Off} ExtTextOutW(Canvas.Handle, X1+Addon, Y1+(Height-H2)div 2, ETO_CLIPPED, @ARect, PWideChar(Text), Length(Text), nil) {$Warnings On} else Canvas.TextRect(ARect, X1+Addon, Y1+(Height-H2)div 2-1, Text); end end; {$endif} procedure TEditFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer); var H2, Addon: integer; ARect: TRect; begin if ThtEdit(FControl).BorderStyle <> bsNone then Addon := 4 {normal 3D border} else Addon := 2; {inline border, 3D Border removed} with ThtEdit(FControl) do begin Canvas.Font := Font; H2 := Abs(Font.Height); if BorderStyle <> bsNone then FormControlRect(Canvas, X1, Y1, X1+Width, Y1+Height, False, MasterList.PrintMonoBlack, False, Color) else FillRectWhite(Canvas, X1, Y1, X1+Width, Y1+Height, Color); SetTextAlign(Canvas.handle, TA_Left); {$IFNDEF LCL} SetBkMode(Canvas.Handle, Windows.Transparent); {$ELSE} SetBkMode(Canvas.Handle, LclType.Transparent); {$ENDIF} Canvas.Brush.Style := bsClear; ARect := Rect(X1+Addon, Y1, X1+Width-(Addon div 2), Y1+Height); if UnicodeControls then {$Warnings Off} ExtTextOutW(Canvas.Handle, X1+Addon, Y1+(Height-H2)div 2, ETO_CLIPPED, @ARect, PWideChar(Text), Length(Text), nil) {$Warnings On} else Canvas.TextRect(ARect, X1+Addon, Y1+(Height-H2)div 2-1, Text); end end; function TEditFormControlObj.GetSubmission(Index: integer; var S: string): boolean; begin if Index = 0 then begin Result := True; if UnicodeControls then S := FName+'='+WideStringToMultibyte(CodePage, ThtEdit(FControl).Text) else S := FName+'='+ThtEdit(FControl).Text; end else Result := False; end; procedure TEditFormControlObj.SetData(Index: integer; const V: String); begin if UnicodeControls then ThtEdit(FControl).Text := MultibyteToWideString(CodePage, V) else ThtEdit(FControl).Text := V;; end; procedure TEditFormControlObj.SetHeightWidth(Canvas: TCanvas); begin with ThtEdit(FControl) do begin Canvas.Font := Font; if not PercentWidth then if (FWidth >= 10) then Width := FWidth else Width := tmAveCharWidth*EditSize+23 else begin {percent width set later} Left := -4000; Width := 10; end; Height := IntMax(FHeight, IntMax(Canvas.TextHeight('A'), 10)); end; end; procedure TEditFormControlObj.SaveContents; {Save the current value to see if it has changed when focus is lost} begin EnterContents := ThtEdit(FControl).Text; end; procedure TEditFormControlObj.DoOnChange; begin if ThtEdit(FControl).Text <> EnterContents then if Assigned(MasterList.ObjectChange) then MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage); end; {----------------TButtonFormControlObj.Create} constructor TButtonFormControlObj.Create(AMasterList: TSectionList; Position: integer; L: TAttributeList; const Typ: string; Prop: TProperties); var PntPanel: TPaintPanel; Tmp: TMyFont; begin inherited Create(AMasterList, Position, L); if Typ = 'submit' then begin Which := Submit; if Value = '' then Value := 'Submit'; end else if Typ = 'reset' then begin Which := ResetB; if Value = '' then Value := 'Reset'; end else if Typ = 'file' then begin Which := Browse; Value := ''; FName := ''; FId := ''; end else begin Which := Button; if Value = '' then Value := 'Button'; end; PntPanel := TPaintPanel(AMasterList.PPanel); FControl := ThtButton.Create(PntPanel); with ThtButton(FControl) do begin Left := -4000 ; {so will be invisible until placed} Tmp := Prop.GetFont; Font.Assign(Tmp); Tmp.Free; OnClick := Self.ButtonClick; if Which = Browse then Caption := 'Browse...' else if UnicodeControls then Caption := MultibyteToWideString(Prop.CodePage, Value) else Caption := Value; OnEnter := EnterEvent; OnExit := ExitEvent; OnMouseMove := HandleMouseMove; Enabled := not Disabled; end; FControl.Parent := PntPanel; {$ifdef UseElPack} ThtButton(FControl).Color := clBtnFace; {$endif} end; procedure TButtonFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer); var H2: integer; MonoBlack: boolean; begin with ThtButton(FControl) do begin MonoBlack := MasterList.PrintMonoBlack and (GetDeviceCaps(Canvas.Handle, BITSPIXEL) = 1) and (GetDeviceCaps(Canvas.Handle, PLANES) = 1); if not MonoBlack then begin try if not Assigned(PaintBitmap) then begin PaintBitmap := TBitmap.Create; PaintBitmap.Width := Width; PaintBitmap.Height := Height; PaintBitmap.Canvas.Lock; PaintTo(PaintBitmap.Canvas.Handle, 0, 0); PaintBitmap.Canvas.UnLock; end; PrintBitmap(Canvas, X1, Y1, Width, Height, PaintBitmap.Handle); except end; end else begin Canvas.Brush.Style := bsClear; Canvas.Font := Font; FormControlRect(Canvas, X1, Y1, X1+Width, Y1+Height, True, MasterList.PrintMonoBlack, False, clWhite); H2 := Canvas.TextHeight('A'); SetTextAlign(Canvas.handle, TA_Center+TA_Top); Canvas.TextRect(Rect(X1, Y1, X1+Width, Y1+Height), X1+(Width div 2), Y1+(Height-H2)div 2, Value); end; end; end; procedure TButtonFormControlObj.ButtonClick(Sender: TObject); var S: string; begin FormControlClick(Self); if Which = ResetB then MyForm.ResetControls else if Which = Submit then if FName = '' then MyForm.SubmitTheForm('') else begin S := FName; MyForm.SubmitTheForm(S+'='+Value); end else if Which = Browse then if Assigned(MasterList.FileBrowse) and Assigned(MyEdit) and (MyEdit.TheControl is ThtEdit) then begin S := ThtEdit(MyEdit.TheControl).Text; MasterList.FileBrowse(MasterList.TheOwner, MyEdit, S); ThtEdit(MyEdit.TheControl).Text := S; end; end; procedure TButtonFormControlObj.SetHeightWidth(Canvas: TCanvas); begin with ThtButton(FControl) do begin Canvas.Font := Font; if FHeight >= Canvas.TextHeight('A') then Height := FHeight else Height := Canvas.TextHeight('A')+8; if (FWidth >= 10) and not PercentWidth then {percent width set later} Width := FWidth else Width := Canvas.TextWidth(Caption)+20; end; end; {----------------TCheckBoxFormControlObj.Create} constructor TCheckBoxFormControlObj.Create(AMasterList: TSectionList; Position: integer; L: TAttributeList; Prop: TProperties); var T: TAttribute; PntPanel: TPaintPanel; begin inherited Create(AMasterList, Position, L); if Value = '' then Value := 'on'; FormAlign := ABaseline; if L.Find(CheckedSy, T) then IsChecked := True; PntPanel := TPaintPanel(AMasterList.PPanel); FControl := TFormCheckBox.Create(PntPanel); with TFormCheckBox(FControl) do begin Left := -4000 ; {so will be invisible until placed} Width := 13; Height := 13; OnKeyDown := MyForm.AKeyDown; OnEnter := EnterEvent; OnExit := ExitEvent; OnMouseMove := HandleMouseMove; Enabled := not Disabled; Parent := PntPanel; Checked := IsChecked; {must precede setting OnClick} OnClick := FormControlClick; end; end; procedure TCheckBoxFormControlObj.ResetToValue; begin TCheckBox(FControl).Checked := IsChecked; end; procedure TCheckBoxFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer); var x, y: integer; begin with TCheckBox(FControl) do begin FormControlRect(Canvas, X1, Y1, X1+Width, Y1+Height, False, MasterList.PrintMonoBlack, Disabled, clWhite); if Checked then with Canvas do begin Pen.Color := clBlack; x := X1+3; y := Y1+Height div 2; MoveTo(x, y); LineTo(x+2, y+2); LineTo(x+6, y-2); end; end; end; function TCheckBoxFormControlObj.GetSubmission(Index: integer; var S: string): boolean; begin if (Index = 0) and TCheckBox(FControl).Checked then begin Result := True; S := FName+'='+Value; end else Result := False; end; procedure TCheckBoxFormControlObj.SetDataInit; begin TCheckBox(FControl).Checked := False; {not checked unless later data says so} end; procedure TCheckBoxFormControlObj.SetData(Index: integer; const V: String); begin if CompareText(V, Value) = 0 then TCheckBox(FControl).Checked := True; end; procedure TCheckBoxFormControlObj.SaveContents; {Save the current value to see if it has changed when focus is lost} begin WasChecked := TCheckBox(FControl).Checked; end; procedure TCheckBoxFormControlObj.DoOnChange; begin if TCheckBox(FControl).Checked <> WasChecked then if Assigned(MasterList.ObjectChange) then MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage); end; {----------------TRadioButtonFormControlObj.Create} constructor TRadioButtonFormControlObj.Create(AMasterList: TSectionList; Position: integer; L: TAttributeList; ACell: TCellBasic); var T: TAttribute; PntPanel: TPaintPanel; Ctrl: TFormControlObj; I: integer; SetTabStop: boolean; begin inherited Create(AMasterList, Position, L); MyCell := ACell; PntPanel := TPaintPanel(AMasterList.PPanel); FControl := TFormRadioButton.Create(PntPanel); FormAlign := ABaseline; if L.Find(CheckedSy, T) then IsChecked := True; with TFormRadioButton(FControl) do begin Left := -4000 ; {so will be invisible until placed} if Screen.PixelsPerInch > 100 then begin Width := 16; Height := 16; end else begin Width := 13; Height := 14; end; IDName := Self.FName; OnEnter := EnterEvent; OnExit := ExitEvent; OnKeyDown := MyForm.AKeyDown; OnMouseMove := HandleMouseMove; Enabled := not Disabled; Parent := PntPanel; {must precede Checked assignment} {The Tabstop for the first radiobutton in a group will be set in case no radiobuttons that follow are checked. This insures that the tab key can access the group} SetTabStop := True; {Examine all other radiobuttons in this group (same FName)} for I := 0 to MyForm.ControlList.Count-1 do begin Ctrl := TFormControlObj(MyForm.ControlList.Items[I]); if (Ctrl is TRadioButtonFormControlObj) and (TRadioButtonFormControlObj(Ctrl).TheControl <> FControl) then {skip the current radiobutton} if CompareText(Ctrl.FName, FName) = 0 then {same group} if not IsChecked then begin {if the current radiobutton is not checked and there are other radio buttons, then the tabstop will not be set for the current radio button since it is not the first} SetTabStop := False; Break; end else begin {if the current radio button is checked, then uncheck all the others and make sure no others have tabstop set} TRadioButtonFormControlObj(Ctrl).IsChecked := False; TFormRadioButton(TRadioButtonFormControlObj(Ctrl).TheControl).Checked := False; TRadioButtonFormControlObj(Ctrl).TheControl.TabStop := False; end; end; if not IsChecked then TabStop := SetTabStop; Checked := IsChecked; {must precede setting OnClick} OnClick := RadioClick; end; end; function TRadioButtonFormControlObj.GetControl: TWinControl; begin Result := FControl; end; procedure TRadioButtonFormControlObj.RadioClick(Sender: TObject); begin MyForm.DoRadios(Self); FormControlClick(Self); end; procedure TRadioButtonFormControlObj.ResetToValue; begin TFormRadioButton(TheControl).Checked := IsChecked; end; procedure TRadioButtonFormControlObj.Draw(Canvas: TCanvas; X1, Y1: integer); var OldStyle: TPenStyle; OldWidth, XW, YH, XC, YC: integer; OldColor, OldBrushColor: TColor; OldBrushStyle: TBrushStyle; MonoBlack: boolean; begin with Canvas do begin XW := X1+14; YH := Y1+14; OldStyle := Pen.Style; OldWidth := Pen.Width; OldBrushStyle := Brush.Style; OldBrushColor := Brush.Color; MonoBlack := MasterList.PrintMonoBlack and (GetDeviceCaps(Handle, BITSPIXEL) = 1) and (GetDeviceCaps(Handle, PLANES) = 1); if Disabled and not MonoBlack then Brush.Color := clBtnFace else Brush.Color := clWhite; Pen.Color := clWhite; Ellipse(X1, Y1, XW, YH); Pen.Style := psInsideFrame; if MonoBlack then begin Pen.Width := 1; Pen.Color := clBlack; end else begin Pen.Width := 2; Pen.Color := clBtnShadow; end; Arc(X1, Y1, XW, YH, XW, Y1, X1, YH); if not MonoBlack then Pen.Color := clSilver; Arc(X1, Y1, XW, YH, X1, YH, XW, Y1); if TFormRadioButton(TheControl).Checked then begin Pen.Color := clBlack; OldColor := Brush.Color; Brush.Color := clBlack; Brush.Style := bsSolid; XC := X1+7; YC := Y1+7; Ellipse(XC-2, YC-2, XC+2, YC+2); Brush.Color := OldColor; end; Pen.Width := OldWidth; Pen.Style := OldStyle; Brush.Color := OldBrushColor; Brush.Style := OldBrushStyle; end; end; function TRadioButtonFormControlObj.GetSubmission(Index: integer; var S: string): boolean; begin if (Index = 0) and TFormRadioButton(TheControl).Checked then begin Result := True; S := FName+'='+Value; end else Result := False; end; procedure TRadioButtonFormControlObj.SetData(Index: integer; const V: String); begin if CompareText(V, Value) = 0 then TFormRadioButton(TheControl).Checked := True; end; procedure TRadioButtonFormControlObj.SaveContents; {Save the current value to see if it has changed when focus is lost} begin WasChecked := TFormRadioButton(TheControl).Checked; end; procedure TRadioButtonFormControlObj.DoOnChange; begin if TFormRadioButton(TheControl).Checked <> WasChecked then if Assigned(MasterList.ObjectChange) then MasterList.ObjectChange(MasterList.TheOwner, Self, OnChangeMessage); end; {----------------TCellBasic.Create} constructor TCellBasic.Create(Master: TSectionList); begin inherited Create; MasterList := Master; end; {----------------TCellBasic.CreateCopy} constructor TCellBasic.CreateCopy(AMasterList: TSectionList; T: TCellBasic); var I: integer; Tmp, Tmp1: TSectionBase; begin inherited Create; MasterList := AMasterList; OwnersTag := T.OwnersTag; for I := 0 to T.Count-1 do begin Tmp := T.Items[I]; Tmp1 := TSectionClass(Tmp.ClassType).CreateCopy(AMasterList, Tmp); Add(Tmp1, 0); end; end; {----------------TCellBasic.Add} procedure TCellBasic.Add(Item: TSectionBase; TagIndex: integer); begin if Assigned(Item) then begin if (Item is TSection) and Assigned(TSection(Item).XP) then {XP not assigned if printing} begin TSection(Item).ProcessText(TagIndex); if not (Item is TPreFormated) and (TSection(Item).Len = 0) and not TSection(Item).AnchorName and (TSection(Item).ClearAttr = clrNone) then begin TSection(Item).CheckFree; Item.Free; {discard empty TSections that aren't anchors} Exit; end; end; inherited Add(Item); Item.SetParent(MasterList); end; end; function TCellBasic.CheckLastBottomMargin: boolean; {Look at the last item in this cell. If its bottom margin was set to Auto, set it to 0} var TB: TObject; I: integer; Done: boolean; begin Result := False; I := Count-1; {find the preceding block that isn't absolute positioning} Done := False; while (I >= 0) and not Done do begin TB := Items[I]; if (TB is TBlock) and (TBlock(TB).Positioning <> PosAbsolute) then Done := True else Dec(I); end; if I >= 0 then begin TB := Items[I]; if (TB is TBlock) then with TBlock(TB) do if BottomAuto then begin MargArray[MarginBottom] := 0; Result := True; end; if (TB is TBlockLI) then Result := TBlockLI(TB).MyCell.CheckLastBottomMargin; end; end; {----------------TCellBasic.GetURL} function TCellBasic.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; {Y is absolute} var I: integer; SB: TSectionBase; begin Result := []; FormControl := Nil; UrlTarg := Nil; for I := 0 to Count-1 do begin SB := TSectionBase(Items[I]); with SB do begin if (Y >= DrawTop) and (Y < DrawBot) then begin Result := GetURL(Canvas, X, Y, UrlTarg, FormControl, ATitle); if Result <> [] then Exit; end; end; end; end; {----------------TCellBasic.PtInObject} function TCellBasic.PtInObject(X: integer; Y: integer; var Obj: TObject; var IX, IY: integer): boolean; {Y is absolute} var I: integer; begin Result := False; Obj := Nil; for I := 0 to Count-1 do with TSectionBase(Items[I]) do begin if (Y >= DrawTop) and (Y < DrawBot) then begin Result := PtInObject(X, Y, Obj, IX, IY); if Result then Exit; end; end; end; {----------------TCellBasic.FindCursor} function TCellBasic.FindCursor(Canvas: TCanvas; X: Integer; Y: integer; var XR: integer; var YR: integer; var Ht: integer; var Intext: boolean): integer; var I: integer; SB: TSectionBase; begin Result := -1; for I := 0 to Count-1 do begin SB := TSectionBase(Items[I]); with SB do begin if (Y >= DrawTop) and (Y < DrawBot) then Result := TSectionBase(Items[I]).FindCursor(Canvas, X, Y, XR, YR, Ht, InText); if Result >= 0 then Break; end; end; end; procedure TCellBasic.AddSectionsToList; var I: integer; begin for I := 0 to Count-1 do TSectionBase(Items[I]).AddSectionsToList; end; {----------------TCellBasic.FindString} function TCellBasic.FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; var I: integer; begin Result := -1; for I := 0 to Count-1 do begin Result := TSectionBase(Items[I]).FindString(From, ToFind, MatchCase); if Result >= 0 then Break; end; end; {----------------TCellBasic.FindStringR} function TCellBasic.FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; var I: integer; begin Result := -1; for I := Count-1 downto 0 do begin Result := TSectionBase(Items[I]).FindStringR(From, ToFind, MatchCase); if Result >= 0 then Break; end; end; {----------------TCellBasic.FindSourcePos} function TCellBasic.FindSourcePos(DocPos: integer): integer; var I: integer; begin Result := -1; for I := 0 to Count-1 do begin Result := TSectionBase(Items[I]).FindSourcePos(DocPos); if Result >= 0 then Break; end; end; procedure TCellBasic.FormTree(Indent: string; var Tree: string); var I: integer; Item: TSectionBase; begin for I := 0 to Count-1 do begin Item := Items[I]; if Item is TBlock then TBlock(Item).FormTree(Indent, Tree) else if Item is TSection then Tree := Tree + Indent + Copy(TSection(Item).BuffS, 1, 10)+^M+^J else Tree := Tree + Indent + '----'^M+^J; end; end; {----------------TCellBasic.FindDocPos} function TCellBasic.FindDocPos(SourcePos: integer; Prev: boolean): integer; var I: integer; begin Result := -1; if not Prev then for I := 0 to Count-1 do begin Result := TSectionBase(Items[I]).FindDocPos(SourcePos, Prev); if Result >= 0 then Break; end else {Prev, iterate backwards} for I := Count-1 downto 0 do begin Result := TSectionBase(Items[I]).FindDocPos(SourcePos, Prev); if Result >= 0 then Break; end end; {----------------TCellBasic.CursorToXY} function TCellBasic.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer; var Y: integer): boolean; var I: integer; begin Result := False; for I := 0 to Count-1 do begin Result := TSectionBase(Items[I]).CursorToXY(Canvas, Cursor, X, Y); if Result then Break; end; end; {----------------TCellBasic.GetChAtPos} function TCellBasic.GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; var I: integer; begin Result := False; if (Pos >= StartCurs) and (Pos <= StartCurs+Len) then for I := 0 to Count-1 do begin Result := TSectionBase(Items[I]).GetChAtPos(Pos, Ch, Obj); if Result then Break; end; end; {----------------TCellBasic.CopyToClipboard} procedure TCellBasic.CopyToClipboard; var I: integer; SLE, SLB: integer; begin if not Assigned(MasterList) then Exit; {dummy cell} SLB := MasterList.SelB; SLE := MasterList.SelE; if SLE <= SLB then Exit; {nothing to do} for I := 0 to Count-1 do with TSectionBase(Items[I]) do begin if (SLB >= StartCurs + Len) then Continue; if (SLE <= StartCurs) then Break; CopyToClipboard; end; end; {----------------TCellBasic.DoLogic} function TCellBasic.DoLogic(Canvas: TCanvas; Y: integer; Width, AHeight, BlHt: integer; var ScrollWidth: integer; var Curs: integer): integer; {Do the entire layout of the cell or document. Return the total document pixel height} var I, Sw, TheCount: integer; H, Tmp: integer; SB: TSectionBase; begin YValue := Y; StartCurs := Curs; H := 0; ScrollWidth := 0; TheCount := Count; I := 0; while I < TheCount do begin try SB := TSectionBase(Items[I]); Tmp := SB.DrawLogic(Canvas, 0, Y+H, 0, 0, Width, AHeight, BlHt, IMgr, Sw, Curs); H := H+Tmp; ScrollWidth := IntMax(ScrollWidth, Sw); Inc(I); except on E:EProcessError do begin MessageDlg(E.Message, mtError, [mbOK], 0); TSectionBase(Items[I]).Free; Delete(I); Dec(TheCount); end; end; end; Len := Curs - StartCurs; Result := H; end; {----------------TCellBasic.MinMaxWidth} procedure TCellBasic.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); {Find the Width the cell would take if no wordwrap, Max, and the width if wrapped at largest word, Min} var I, Mn, Mx: integer; begin Max := 0; Min := 0; for I := 0 to Count-1 do begin TSectionBase(Items[I]).MinMaxWidth(Canvas, Mn, Mx); Max := IntMax(Max, Mx); Min := IntMax(Min, Mn); end; end; {----------------TCellBasic.Draw} function TCellBasic.Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer; Y, XRef, YRef : integer): integer; {draw the document or cell. Note: individual sections not in ARect don't bother drawing} var I: integer; H: integer; begin H := Y; for I := 0 to Count-1 do begin H := TSectionBase(Items[I]).Draw1(Canvas, ARect, IMgr, X, XRef, YRef); end; Result := H; end; {----------------TBlock.Create} constructor TBlock.Create(Master: TSectionList; Prop: TProperties; AnOwnerCell: TCellBasic; Attributes: TAttributeList); var Clr: ClearAttrType; S: string; begin inherited Create(Master); OwnerCell := AnOwnerCell; MyCell := TBlockCell.Create(Master); MyCell.OwnersTag := Prop.PropTag; MyCell.Owner := Self; DrawList := TList.Create; Prop.GetVMarginArray(MargArrayO); if Prop.GetClear(Clr) then ClearAttr := Clr; if not Prop.GetFloat(FloatLR) then FloatLR := ANone; BorderStyle := Prop.GetBorderStyle; FGColor := Prop.Props[Color]; EmSize := Prop.EmSize; ExSize := Prop.ExSize; DisplayNone := Prop.DisplayNone; BlockTitle := Prop.PropTitle; if not (Self is TBodyBlock) and not (Self is TTableAndCaptionBlock) and Prop.GetBackgroundImage(S) and (S <> '') then begin {body handles its own image} BGImage := TImageObj.SimpleCreate(Master, S); Prop.GetBackgroundPos(EmSize, ExSize, PRec); end; Positioning := Prop.GetPosition; if Positioning = posAbsolute then FloatLR := ANone; Visibility := Prop.GetVisibility; Prop.GetPageBreaks(BreakBefore, BreakAfter, KeepIntact); if Positioning <> posStatic then begin ZIndex := 10*Prop.GetZIndex; if (Positioning = posAbsolute) and (ZIndex = 0) then ZIndex := 1; {abs on top unless otherwise specified} if Positioning = posAbsolute then MyCell.IMgr := IndentManager.Create; end; if (FloatLR in [ALeft, ARight]) and (ZIndex = 0) then ZIndex := 1; TagClass := Prop.PropTag+'.'+Prop.PropClass; if not (Self is TTableBlock) and not (Self is TTableAndCaptionBlock) then CollapseMargins; if Assigned(Attributes) and (Attributes.TheID <> '') then Master.IDNameList.AddObject(Attributes.TheID, Self); HideOverflow := Prop.IsOverflowHidden; if Prop.Props[TextAlign] = 'right' then Justify := Right else if Prop.Props[TextAlign] = 'center' then Justify := Centered else Justify := Left; end; procedure TBlock.CollapseMargins; {adjacent vertical margins need to be reduced} var TopAuto, Done: boolean; TB: TSectionBase; LastMargin, Negs, I: integer; Tag: string; begin ConvVertMargins(MargArrayO, 400, {height not known at this point} EmSize, ExSize, MargArray, TopAuto, BottomAuto); if Positioning = posAbsolute then begin if TopAuto then MargArray[MarginTop] := 0; end else if FloatLR in [ALeft, ARight] then {do nothing} else with OwnerCell do begin I := Count-1; {find the preceding block that isn't absolute positioning} Done := False; while (I >= 0) and not Done do begin TB := TSectionBase(Items[I]); if ((TB is TBlock) and (TBlock(TB).Positioning <> PosAbsolute)) or not (TB is TBlock) then {allow for a TSection} Done := True else Dec(I); end; Tag := OwnerCell.OwnersTag; if I < 0 then begin {no previous non absolute block, remove any Auto paragraph space} if TopAuto then begin if (Tag = 'li') then begin MargArray[MarginTop] := 0; end else MargArray[MarginTop] := 0; end else if (Tag = 'default') or (Tag = 'body') then MargArray[MarginTop] := IntMax(0, MargArray[MarginTop]-OwnerCell.Owner.MargArray[MarginTop]); end else begin TB := Items[I]; if ((TB is TTableBlock) or (TB is TTableAndCaptionBlock)) and (TBlock(TB).FloatLR in [ALeft, ARight]) and TopAuto then MargArray[MarginTop] := 0 else if (TB is TBlock) then begin LastMargin := TBlock(TB).MargArray[MarginBottom]; TBlock(TB).MargArray[MarginBottom] := 0; if LastMargin >= 0 then {figure out how many are negative} if MargArray[MarginTop] >=0 then Negs := 0 else Negs := 1 else if MargArray[MarginTop] >=0 then Negs := 1 else Negs := 2; case Negs of 0: MargArray[MarginTop] := IntMax(MargArray[MarginTop], LastMargin); 1: MargArray[MarginTop] := MargArray[MarginTop] + LastMargin; 2: MargArray[MarginTop] := IntMin(MargArray[MarginTop], LastMargin); end; end else if (Tag = 'li') and TopAuto and ((Pos('ul.', TagClass)=1) or (Pos('ol.', TagClass)=1)) then MargArray[MarginTop] := 0; {removes space from nested lists} end; end; end; {----------------TBlock.CreateCopy} constructor TBlock.CreateCopy(AMasterList: TSectionList; T: TSectionBase); var TT: TBlock; begin inherited CreateCopy(AMasterList, T); TT := T as TBlock; {$IFNDEF FPC} System.Move(TT.MargArray, MargArray, DWord(@Converted)-DWord(@MargArray)+Sizeof(Converted)); {$ELSE} System.Move(TT.MargArray, MargArray, PtrUInt(@Converted)-PtrUInt(@MargArray)+Sizeof(Converted)); {$ENDIF} MyCell := TBlockCell.CreateCopy(AMasterList, TT.MyCell); MyCell.Owner := Self; DrawList := TList.Create; TagClass := TT.TagClass; if Assigned(TT.BGImage) and AMasterlist.PrintTableBackground then BGImage := TImageObj.CreateCopy(AMasterList, TT.BGImage); MargArrayO := TT.MargArrayO; if Positioning = posAbsolute then MyCell.IMgr := IndentManager.Create; end; destructor TBlock.Destroy; begin BGImage.Free; TiledImage.Free; TiledMask.Free; FullBG.Free; if Positioning = posAbsolute then FreeAndNil(MyCell.IMgr); FreeAndNil(MyCell); DrawList.Free; inherited; end; procedure TBlock.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); var MinCell, MaxCell: integer; LeftSide, RightSide, AutoCount: integer; begin if DisplayNone or (Positioning = PosAbsolute) then begin Min := 0; Max := 0; Exit; end; ConvMargArray(MargArrayO, 0, 400, EmSize, ExSize, BorderStyle, AutoCount, MargArray); HideOverflow := HideOverflow and (MargArray[Width] <> Auto) and (MargArray[Width] > 20); if HideOverflow then begin MinCell := MargArray[Width]; MaxCell := MinCell; end else MyCell.MinMaxWidth(Canvas, MinCell, MaxCell); if MargArray[MarginLeft] = Auto then MargArray[MarginLeft] := 0; if MargArray[MarginRight] = Auto then MargArray[MarginRight] := 0; if MargArray[Width] = Auto then MargArray[Width] := 0; LeftSide := MargArray[MarginLeft]+MargArray[BorderLeftWidth]+MargArray[PaddingLeft]; RightSide := MargArray[MarginRight]+MargArray[BorderRightWidth]+MargArray[PaddingRight]; Min := IntMax(MinCell, MargArray[Width]) + LeftSide + RightSide; if MargArray[Width] > 0 then Max := Min else Max := IntMax(MaxCell, MargArray[Width]) + LeftSide + RightSide; end; {----------------TBlock.GetURL} function TBlock.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; begin if DisplayNone then Result := [] else begin if (BlockTitle <> '') and PtInRect(MyRect, Point(X, Y-ParentSectionList.YOFF)) then begin ATitle := BlockTitle; Include(Result, guTitle); end; Result := MyCell.GetURL(Canvas, X, Y, UrlTarg, FormControl, ATitle); end; end; {----------------TBlock.FindString} function TBlock.FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; begin if DisplayNone then Result := -1 else Result := MyCell.FindString(From, ToFind, MatchCase); end; {----------------TBlock.FindStringR} function TBlock.FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; begin if DisplayNone then Result := -1 else Result := MyCell.FindStringR(From, ToFind, MatchCase); end; {----------------TBlock.FindCursor} function TBlock.FindCursor(Canvas: TCanvas; X: integer; Y: integer; var XR: integer; var YR: integer; var CaretHt: integer; var Intext: boolean): integer; var I: integer; begin if DisplayNone then Result := -1 else begin {check this in z order} Result := -1; with DrawList do for I := Count-1 downto 0 do with TSectionBase(Items[I]) do begin if (Y >= DrawTop) and (Y < DrawBot) then begin Result := FindCursor(Canvas, X, Y, XR, YR, CaretHt, Intext); if Result>= 0 then Exit; end; end; end; end; procedure TBlock.AddSectionsToList; begin MyCell.AddSectionsToList; end; {----------------TBlock.PtInObject} function TBlock.PtInObject(X : integer; Y: integer; var Obj: TObject; var IX, IY: integer): boolean; {Y is absolute} var I: integer; begin if DisplayNone then Result := False else begin {check this in z order} Result := False; Obj := Nil; with DrawList do for I := Count-1 downto 0 do with TSectionBase(Items[I]) do begin if (Y >= DrawTop) and (Y < DrawBot) then begin Result := PtInObject(X, Y, Obj, IX, IY); if Result then Exit; end; end; end; end; {----------------TBlock.GetChAtPos} function TBlock.GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; begin if DisplayNone then Result := False else Result := MyCell.GetChAtPos(Pos, Ch, Obj); end; function TBlock.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer; var Y: integer): boolean; begin if DisplayNone then Result := False else Result := MyCell.CursorToXY(Canvas, Cursor, X, Y); end; function TBlock.FindDocPos(SourcePos: integer; Prev: boolean): integer; begin if DisplayNone then Result := -1 else Result := MyCell.FindDocPos(SourcePos, Prev); end; function TBlock.FindSourcePos(DocPos: integer): integer; begin if DisplayNone then Result := -1 else Result := MyCell.FindSourcePos(DocPos); end; procedure TBlock.CopyToClipboard; begin if not DisplayNone then begin MyCell.CopyToClipboard; if (Pos('p.', TagClass) = 1) and (ParentSectionList.SelE > MyCell.StartCurs+MyCell.Len) then ParentSectionList.CB.AddTextCR('', 0); end; end; {----------------TBlock.FindWidth} function TBlock.FindWidth(Canvas: TCanvas; AWidth, AHeight, AutoCount: integer): integer; var Marg2: integer; MinWidth, MaxWidth: integer; function BordPad: integer; begin Result := MargArray[BorderLeftWidth]+MargArray[BorderRightWidth]+ MargArray[PaddingLeft]+MargArray[PaddingRight]; end; procedure CalcWidth; begin if Positioning = posAbsolute then MargArray[Width] := IntMax(MinWidth, AWidth-BordPad-MargArray[MarginLeft]-MargArray[MarginRight]-LeftP) else if (FloatLR in [ALeft, ARight]) then MargArray[Width] := IntMin(MaxWidth, AWidth-BordPad-MargArray[MarginLeft]-MargArray[MarginRight]) else MargArray[Width] := IntMax(MinWidth, AWidth-BordPad-MargArray[MarginLeft]-MargArray[MarginRight]); end; procedure CalcMargRt; begin MargArray[MarginRight] := IntMax(0, AWidth-BordPad-MargArray[MarginLeft]-MargArray[Width]); end; procedure CalcMargLf; begin MargArray[MarginLeft] := IntMax(0, AWidth-BordPad-MargArray[MarginRight]-MargArray[Width]); end; begin MyCell.MinMaxWidth(Canvas, MinWidth, MaxWidth); HideOverflow := HideOverflow and (MargArray[Width] <> Auto) and (MargArray[Width] > 20); case AutoCount of 0: begin if not HideOverflow then MargArray[Width] := IntMax(MinWidth, MargArray[Width]); if (Justify in [centered, Right]) and (Positioning = posStatic) and not (FloatLR in [ALeft, ARight]) and (MargArray[MarginLeft] = 0) and (MargArray[MarginRight] = 0) then begin Marg2 := IntMax(0, AWidth-MargArray[Width]-BordPad); case Justify of centered: begin MargArray[MarginLeft] := Marg2 div 2; MargArray[MarginRight] := Marg2 div 2; end; right: MargArray[MarginLeft] := Marg2; end; end; end; 1: if MargArray[Width] = Auto then CalcWidth else begin if not HideOverflow then MargArray[Width] := IntMax(MargArray[Width], MinWidth); if MargArray[MarginRight] = Auto then if (FloatLR in [ALeft, ARight]) then MargArray[MarginRight] := 0 else CalcMargRt else CalcMargLf; end; 2: if MargArray[Width] = Auto then begin if MargArray[MarginLeft] = Auto then MargArray[MarginLeft] := 0 else MargArray[MarginRight] := 0; CalcWidth; end else begin if not HideOverflow then MargArray[Width] := IntMax(MargArray[Width], MinWidth); Marg2 := IntMax(0, AWidth-MargArray[Width]-BordPad); MargArray[MarginLeft] := Marg2 div 2; MargArray[MarginRight] := Marg2 div 2; end; 3: begin MargArray[MarginLeft] := 0; MargArray[MarginRight] := 0; CalcWidth; end; end; Result := MargArray[Width]; end; procedure DoImageStuff(Canvas: TCanvas; IW, IH: integer; BGImage: TImageObj; PRec: PtPositionRec; var TiledImage: TgpObject; var TiledMask: TBitmap; var NoMask: boolean); {Set up for the background image. Allow for tiling, and transparency BGImage is the image PRec describes the location and tiling IW, IH, the width and height of the background } var I, OW, OH, X, XX, Y, X2, Y2: integer; P: array[1..2] of integer; TheMask, NewBitmap, NewMask: TBitmap; TheGpObj: TGpObject; g: TgpGraphics; procedure Tile(Bitmap, Mask: TBitmap; W, H: integer); begin repeat {tile BGImage in the various dc's} XX := X; repeat TBitmap(TiledImage).Canvas.Draw(XX, Y, Bitmap); if Assigned(TheMask) then TiledMask.Canvas.Draw(XX, Y, Mask) else if not NoMask then PatBlt(TiledMask.Canvas.Handle, XX, Y, Bitmap.Width, Bitmap.Height, Blackness); Inc(XX, Bitmap.Width); until XX >= X2; Inc(Y, Bitmap.Height); until Y >= Y2; end; procedure TileGpImage(Image: TgpImage; W, H: integer); var ImW, ImH: integer; graphics: TgpGraphics; begin ImW := Image.Width; ImH := Image.Height; try graphics := TGPGraphics.Create(TgpImage(TiledImage)); try repeat {tile Image in the various dc's} XX := X; repeat graphics.DrawImage(Image,XX,Y, Image.Width, Image.Height); Inc(XX, ImW); until XX >= X2; Inc(Y, ImH); until Y >= Y2; except end; graphics.Free; except end; end; begin if (BGImage.Image is TBitmap) then begin TheGpObj := TBitmap(BGImage.Image); TheMask := BGImage.Mask; end else if BGImage.Image is TGifImage then begin TheGpObj := TGifImage(BGImage.Image).MaskedBitmap; TheMask := TGifImage(BGImage.Image).Mask; end {$ifndef NoMetafile} else if BGImage.Image is ThtMetafile then begin TheGpObj := ThtMetafile(BGImage.Image).Bitmap; TheMask := ThtMetafile(BGImage.Image).Mask; end {$endif} else begin TheGpObj := BGImage.Image; TheMask := Nil; end; NoMask := not Assigned(TheMask) and PRec[1].RepeatD and PRec[2].RepeatD; OW := GetImageWidth(BGImage.Image); OH := GetImageHeight(BGImage.Image); if (BGImage.Image is TgpImage) and not ((OW = 1) or (OH = 1)) then begin {TiledImage will be a TGpBitmap unless Image needs to be enlarged} with TgpBitmap(TiledImage) do if Assigned(TiledImage) and ((IW <> Width) or (IH <> Height)) then FreeAndNil(TiledImage); if not Assigned(TiledImage) then TiledImage := TgpBitmap.Create(IW, IH); g := TgpGraphics.Create(TgpBitmap(TiledImage)); g.Clear(0); {clear to transparent black} g.Free; end else begin {TiledImage will be a TBitmap} if not Assigned(TiledImage) then TiledImage := TBitmap.Create; TBitmap(TiledImage).Palette := CopyPalette(ThePalette); TBitmap(TiledImage).Height := IH; TBitmap(TiledImage).Width := IW; PatBlt(TBitmap(TiledImage).Canvas.Handle, 0, 0, IW, IH, Blackness); end; if not NoMask and ((BGImage.Image is TBitmap) {$ifndef NoMetafile} or (BGImage.Image is ThtMetafile) {$endif} ) then begin if not Assigned(TiledMask) then TiledMask := TBitmap.Create; TiledMask.Monochrome := True; TiledMask.Height := IH; TiledMask.Width := IW; if not Assigned(TheMask) then PatBlt(TiledMask.Canvas.Handle, 0, 0, IW, IH, Whiteness); end; {compute the location and tiling of BGImage in the background} P[1] := 0; P[2] := 0; for I := 1 to 2 do with PRec[I] do begin case PosType of pTop: P[I] := 0; pCenter: if I = 1 then P[1] := IW div 2 - OW div 2 else P[2] := IH div 2 - OH div 2; pBottom: P[I] := IH - OH; pLeft: P[I] := 0; pRight: P[I] := IW - OW; PPercent: if I = 1 then P[1] := ((IW-OW) * Value) div 100 else P[2] := ((IH-OH) * Value) div 100; pDim: P[I] := Value; end; if I=1 then P[1] := Intmin(IntMax(P[1], -OW), IW) else P[2] := Intmin(IntMax(P[2], -OH), IH); end; X := P[1]; Y := P[2]; if PRec[2].RepeatD then begin while Y > 0 do Dec(Y, OH); Y2 := IH; end else Y2 := Y; if PRec[1].RepeatD then begin while X > 0 do Dec(X, OW); X2 := IW; end else X2 := X; if ((OW = 1) or (OH = 1)) then begin {in case a 1 pixel bitmap is being tiled. EnlargeImage returns a TBitmap regardless of TheGpObj type.} NewBitmap := EnlargeImage(TheGpObj, X2-X+1, Y2-Y+1); try if Assigned(TheMask) then NewMask := EnlargeImage(TheMask, X2-X+1, Y2-Y+1) else NewMask := Nil; try Tile(NewBitmap, NewMask, X2-X+1, Y2-Y+1); finally NewMask.Free; end; finally NewBitmap.Free; end; end else if (TheGpObj is TBitmap) then Tile(TBitmap(TheGpObj), TheMask, OW, OH) else TileGpImage(TgpImage(TheGpObj), OW, OH); end; {----------------TBlock.DrawLogic} function TBlock.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; var ScrollWidth, YClear: integer; LIndex, RIndex: integer; SaveID: TObject; TotalWidth, MiscWidths: integer; AutoCount: integer; BlockHeight: integer; IB, Xin: Integer; function GetClearSpace(CA: ClearAttrType): integer; var CL, CR: integer; begin Result := 0; if (CA <> clrNone) then begin {may need to move down past floating image} IMgr.GetClearY(CL, CR); case CA of clLeft: Result := IntMax(0, CL-Y-1); clRight: Result := IntMax(0, CR-Y-1); clAll: Result := IntMax(CL-Y-1, IntMax(0, CR-Y-1)); end; end; end; begin if DisplayNone then begin SectionHeight := 0; DrawHeight := 0; ContentBot := 0; DrawBot := 0; MaxWidth := 0; Result := 0; Exit; end; YDraw := Y; Xin := X; ClearAddOn := GetClearSpace(ClearAttr); StartCurs := Curs; MaxWidth := AWidth; ConvMargArray(MargArrayO, AWidth, AHeight, EmSize, ExSize, BorderStyle, AutoCount, MargArray); TopP := MargArray[TopPos]; LeftP := MargArray[LeftPos]; if Positioning = PosRelative then begin if TopP = Auto then TopP := 0; if LeftP = Auto then LeftP := 0; end else if Positioning = PosAbsolute then begin if TopP = Auto then TopP := 0; if (LeftP = Auto) then if (MargArray[RightPos] <> Auto) and (AutoCount = 0) then LeftP := AWidth-MargArray[RightPos]-MargArray[Width]-MargArray[MarginRight] -MargArray[MarginLeft]-MargArray[PaddingLeft]-MargArray[PaddingRight] -MargArray[BorderLeftWidth]-MargArray[BorderRightWidth] else LeftP := 0; end; if Positioning = posAbsolute then begin X := LeftP; Y := TopP+YRef; end; NewWidth := FindWidth(Canvas, AWidth, AHeight, AutoCount); if Positioning <> posAbsolute then MyCell.IMgr := IMgr else begin RefIMgr := IMgr; IMgr := MyCell.IMgr; IMgr.Clear; IMgr.Reset(0, NewWidth); IMgr.Width := NewWidth; end; SaveID := IMgr.CurrentID; IMgr.CurrentID := Self; MiscWidths := MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth] +MargArray[MarginRight]+MargArray[PaddingRight]+MargArray[BorderRightWidth]; TotalWidth := MiscWidths + NewWidth; YClear := Y+ClearAddon; if MargArray[MarginTop] > 0 then DrawTop := YClear else DrawTop := YClear + MargArray[MarginTop]; {Border top} if FloatLR = ALeft then begin Indent := IntMax(X, IMgr.LeftIndent(YClear)) + MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth]-X; end else if FloatLR = ARight then Begin Indent := IntMin(AWidth, IMgr.RightSide(YClear))- (MargArray[MarginRight]+MargArray[PaddingRight]+MargArray[BorderRightWidth]) - NewWidth; end else begin Indent := MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth]; end; X := X + Indent; ContentTop := Y+ClearAddon+MargArray[MarginTop]+MargArray[PaddingTop]+MargArray[BorderTopWidth]; LIndex := IMgr.SetLeftIndent(X, ContentTop); RIndex := IMgr.SetRightIndent(X+NewWidth, ContentTop); ContentLeft := X; if MargArray[Height] > 0 then BlockHeight := MargArray[Height] else if AHeight > 0 then BlockHeight := AHeight else BlockHeight := BlHt; if Positioning = posRelative then MyCell.DoLogicX(Canvas, X, ContentTop+TopP, XRef, ContentTop+TopP, NewWidth, MargArray[Height], BlockHeight, ScrollWidth, Curs) else if Positioning = posAbsolute then MyCell.DoLogicX(Canvas, X, ContentTop, XRef+LeftP+MargArray[MarginLeft]+MargArray[BorderLeftWidth], YRef+TopP+MargArray[MarginTop]+MargArray[BorderTopWidth], NewWidth, MargArray[Height], BlockHeight, ScrollWidth, Curs) else MyCell.DoLogicX(Canvas, X, ContentTop, XRef, YRef, NewWidth, MargArray[Height], BlockHeight, ScrollWidth, Curs); Len := Curs-StartCurs; if Positioning in [posAbsolute, posRelative] then MaxWidth := ScrollWidth+MiscWidths-MargArray[MarginRight]+LeftP-Xin else MaxWidth := ScrollWidth+MargArray[MarginRight]+MargArray[PaddingRight]+MargArray[BorderRightWidth]+Indent; if Positioning = posRelative then ClientContentBot := IntMax(ContentTop, MyCell.tcContentBot-TopP) else ClientContentBot := IntMax(ContentTop, MyCell.tcContentBot); if HideOverflow and (MargArray[Height] > 3) then ClientContentBot := ContentTop + MargArray[Height] else if ClientContentBot - ContentTop < MargArray[Height] then ClientContentBot := ContentTop + MargArray[Height]; if Positioning = posAbsolute then begin IB := IMgr.ImageBottom; {check for image overhang} if IB > ClientContentBot then ClientContentBot := IB; end; ContentBot := ClientContentBot + MargArray[PaddingBottom]+ MargArray[BorderBottomWidth]+MargArray[MarginBottom]; DrawBot := IntMax(ClientContentBot, MyCell.tcDrawBot) + MargArray[PaddingBottom] +MargArray[BorderBottomWidth]; Result := ContentBot-Y; if Assigned(BGImage) and ParentSectionList.ShowImages then begin BGImage.DrawLogic(ParentSectionList, Canvas, Nil, 100, 0); if (BGImage.Image = ErrorBitmap) then begin FreeAndNil(BGImage); NeedDoImageStuff := False; end else begin BGImage.ImageKnown := True; {won't need reformat on InsertImage} NeedDoImageStuff := True; end; end; SectionHeight := Result; IMgr.FreeLeftIndentRec(LIndex); IMgr.FreeRightIndentRec(RIndex); if (FloatLR in [ALeft, ARight]) or (Positioning = posAbsolute) then begin if Positioning = posAbsolute then DrawHeight := 0 else DrawHeight := SectionHeight; if FloatLR = ALeft then IMgr.UpdateBlock(Y, X+NewWidth + MargArray[MarginRight]+ MargArray[PaddingRight]+MargArray[BorderRightWidth], DrawBot-Y, FloatLR) else if FloatLR = ARight then IMgr.UpdateBlock(Y, TotalWidth, DrawBot-Y, FloatLR); SectionHeight := 0; Result := 0; end else begin DrawHeight := IMgr.ImageBottom - Y; {in case image overhangs} if DrawHeight < SectionHeight then DrawHeight := SectionHeight; end; IMgr.CurrentID := SaveID; if DrawList.Count = 0 then DrawSort; end; {----------------TBlock.DrawSort} procedure TBlock.DrawSort; var I, ZeroIndx, EndZeroIndx, SBZIndex: integer; SB: TSectionBase; procedure InsertSB(I1, I2: integer); var J: integer; Inserted: boolean; begin Inserted := False; for J := I1 to I2-1 do if SBZIndex < TSectionBase(DrawList[J]).ZIndex then begin DrawList.Insert(J, SB); Inserted := True; Break; end; if not Inserted then DrawList.Insert(I2, SB); end; begin ZeroIndx := 0; EndZeroIndx := 0; for I := 0 to MyCell.Count-1 do begin SB := TSectionBase(MyCell.Items[I]); SB.MyBlock := Self; SBZIndex := SB.ZIndex; if SBZIndex < 0 then begin InsertSB(0, ZeroIndx); Inc(ZeroIndx); Inc(EndZeroIndx); end else if SBZIndex = 0 then {most items go here} begin DrawList.Insert(EndZeroIndx, SB); Inc(EndZeroIndx); end else InsertSB(EndZeroIndx, DrawList.Count); end; end; {----------------TBlock.Draw1} function TBlock.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; var Y, YO: integer; HeightNeeded, Spacing: Integer; begin if DisplayNone then begin Result := 0; Exit; end; Y := YDraw; YO := Y - ParentSectionList.YOff; Result := Y+SectionHeight; if ParentSectionList.SkipDraw then begin ParentSectionList.SkipDraw := False; Exit; end; with ParentSectionList do if Printing and (Positioning <> posAbsolute) then if BreakBefore and not FirstPageItem then begin if ARect.Top + YOff < YDraw+MargArray[MarginTop] then {page-break-before} begin if YDraw+MargArray[MarginTop] < PageBottom then PageBottom := YDraw+MargArray[MarginTop]; SkipDraw := True; {prevents next block from drawing a line} Exit; end; end else if KeepIntact then begin {if we're printing and block won't fit on this page and block will fit on next page, then don't do block now} if (YO > ARect.Top) and (Y+DrawHeight > PageBottom) and (DrawHeight-MargArray[MarginTop] < ARect.Bottom - ARect.Top) then begin if Y+MargArray[MarginTop] < PageBottom then PageBottom := Y+MargArray[MarginTop]; Exit; end; end else if BreakAfter then begin if ARect.Top + YOff < Result then {page-break-after} if Result < PageBottom then PageBottom := Result; end else if Self is TTableBlock and not TTableBlock(Self).Table.HeadOrFoot then {ordinary tables} {if we're printing and we're 2/3 down page and table won't fit on this page and table will fit on next page, then don't do table now} begin if (YO > ARect.Top + ((ARect.Bottom - ARect.Top)*2) div 3) and (Y+DrawHeight > PageBottom) and (DrawHeight < ARect.Bottom - ARect.Top) then begin if Y+MargArray[MarginTop] < PageBottom then PageBottom := Y+MargArray[MarginTop]; Exit; end; end else if Self is TTableBlock then {try to avoid just a header and footer at page break} with TTableBlock(Self).Table do if HeadOrFoot and (ParentSectionList.TableNestLevel = 0) and ((ParentSectionList.PrintingTable = Nil) or (ParentSectionList.PrintingTable = TTableBlock(Self).Table)) then begin Spacing := CellSpacing div 2; HeightNeeded := HeaderHeight+FootHeight+ TCellList(Rows.Items[HeaderRowCount]).RowHeight; if (YO > ARect.Top) and (Y+HeightNeeded > ParentSectionList.PageBottom) and (HeightNeeded < ARect.Bottom - ARect.Top) then begin {will go on next page} if Y+Spacing < ParentSectionList.PageBottom then begin ParentSectionList.PageShortened := True; ParentSectionList.PageBottom := Y+Spacing; end; Exit; end; end; if Visibility <> viHidden then if Positioning = posRelative then {for debugging} DrawBlock(Canvas, ARect, IMgr, X+LeftP, Y+TopP, XRef, YRef) else if Positioning = posAbsolute then DrawBlock(Canvas, ARect, IMgr, XRef+LeftP, YRef+TopP, XRef, YRef) else if FloatLR in [ALeft, ARight] then DrawBlock(Canvas, ARect, IMgr, X, Y, XRef, YRef) else DrawBlock(Canvas, ARect, IMgr, X, Y, XRef, YRef); end; {----------------TBlock.DrawBlock} procedure TBlock.DrawBlock(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, Y, XRef, YRef : integer); var YOffset: integer; XR, YB, BL, BT, BR, BB, PL, PT, PR, PB, RefX, TmpHt: integer; SaveID: TObject; ImgOK, HasBackgroundColor: boolean; IT, IH, FT: integer; Rgn, SaveRgn, SaveRgn1: HRgn; OpenRgn: Boolean; procedure InitFullBg(W, H: integer); begin if not Assigned(FullBG) then begin FullBG := TBitmap.Create; if ParentSectionList.IsCopy then begin FullBG.HandleType := bmDIB; if ColorBits <= 8 then FullBG.Palette := CopyPalette(ThePalette); end; end; FullBG.Height := IntMax(H, 2); FullBG.Width := IntMax(W, 2); end; begin YOffset := ParentSectionList.YOff; case FLoatLR of ALeft, ARight: RefX := X+Indent-(MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth]); else RefX := X; end; X := X+Indent; XR := RefX + MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth] + NewWidth + MargArray[MarginRight]+ MargArray[PaddingRight]+MargArray[BorderRightWidth]; {current right edge} if Positioning = posRelative then YB := ContentBot - YOffset + TopP else if FLoatLR in [ALeft, ARight] then YB := DrawBot + MargArray[MarginBottom] - YOffset else YB := ContentBot - YOffset; BL := RefX + MargArray[MarginLeft]; {Border left and right} BR := XR - MargArray[MarginRight]; PL := BL + MargArray[BorderLeftWidth]; {Padding left and right} PR := BR - MargArray[BorderRightWidth]; BT := Y + ClearAddon + MargArray[MarginTop] - YOffset; {Border Top and Bottom} BB := YB - MargArray[MarginBottom]; PT := BT + MargArray[BorderTopWidth]; {Padding Top and Bottom} PB := BB - MargArray[BorderBottomWidth]; IT := IntMax(0, Arect.Top-2-PT); FT := IntMax(PT, ARect.Top-2); {top of area drawn, screen coordinates} IH := IntMin(PB-FT, Arect.Bottom-FT); {height of area actually drawn} SaveRgn1 := 0; OpenRgn := (Positioning <> PosStatic) and (ParentSectionList.TableNestLevel > 0); if OpenRgn then begin SaveRgn1 := CreateRectRgn(0, 0, 1, 1); GetClipRgn(Canvas.Handle, SaveRgn1); SelectClipRgn(Canvas.Handle, 0); end; MyRect := Rect(BL, BT, BR, BB); if (BT <= ARect.Bottom) and (BB >= ARect.Top) then begin HasBackgroundColor := MargArray[BackgroundColor] <> clNone; try if NeedDoImageStuff and Assigned(BGImage) and (BGImage.Image <> DefBitmap) then begin if BGImage.Image = ErrorBitmap then {Skip the background image} FreeAndNil(BGImage) else try if FloatLR in [ALeft, ARight] then TmpHt := DrawBot-ContentTop+MargArray[PaddingTop]+MargArray[PaddingBottom] else TmpHt := ClientContentBot-ContentTop+MargArray[PaddingTop]+MargArray[PaddingBottom]; DoImageStuff(Canvas, MargArray[PaddingLeft]+NewWidth+MargArray[PaddingRight], TmpHt, BGImage, PRec, TiledImage, TiledMask, NoMask); if ParentSectionList.IsCopy and (TiledImage is TBitmap) then TBitmap(TiledImage).HandleType := bmDIB; except {bad image, get rid of it} FreeAndNil(BGImage); FreeAndNil(TiledImage); FreeAndNil(TiledMask); end; NeedDoImageStuff := False; end; ImgOK := Not NeedDoImageStuff and Assigned(BGImage) and (BGImage.Bitmap <> DefBitmap) and ParentSectionList.ShowImages; if HasBackgroundColor and (not ParentSectionList.Printing or ParentSectionList.PrintTableBackground) then begin {color the Padding Region} Canvas.Brush.Color := MargArray[BackgroundColor] or PalRelative; Canvas.Brush.Style := bsSolid; if ParentSectionList.IsCopy and ImgOK then begin InitFullBG(PR-PL, IH); FullBG.Canvas.Brush.Color := MargArray[BackgroundColor] or PalRelative; FullBG.Canvas.Brush.Style := bsSolid; FullBG.Canvas.FillRect(Rect(0, 0, PR-PL, IH)); end else Canvas.FillRect(Rect(PL, FT, PR, FT+IH)); end; if ImgOK then begin if not ParentSectionList.IsCopy then if TiledImage is TgpBitmap then //DrawGpImage(Canvas.Handle, TgpImage(TiledImage), PL, PT) DrawGpImage(Canvas.Handle, TgpImage(TiledImage), PL, FT, 0, IT, PR-PL, IH) //BitBlt(Canvas.Handle, PL, FT, PR-PL, IH, TiledImage.Canvas.Handle, 0, IT, SrcCopy) else if NoMask then BitBlt(Canvas.Handle, PL, FT, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SrcCopy) else begin InitFullBG(PR-PL, IH); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, Canvas.Handle, PL, FT, SrcCopy); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SrcInvert); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TiledMask.Canvas.Handle, 0, IT, SRCAND); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SRCPaint); BitBlt(Canvas.Handle, PL, FT, PR-PL, IH, FullBG.Canvas.Handle, 0, 0, SRCCOPY); end else if TiledImage is TgpBitmap then {printing} begin if HasBackgroundColor then begin DrawGpImage(FullBg.Canvas.Handle, TgpImage(TiledImage), 0, 0); PrintBitmap(Canvas, PL, FT, PR-PL, IH, FullBG.Handle); end else PrintGpImageDirect(Canvas.Handle, TgpImage(TiledImage), PL, PT, ParentSectionList.ScaleX, ParentSectionList.ScaleY); end else if NoMask then {printing} PrintBitmap(Canvas, PL, FT, PR-PL, IH, TBitmap(TiledImage).Handle) else if HasBackgroundColor then begin BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SrcInvert); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TiledMask.Canvas.Handle, 0, IT, SRCAND); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SRCPaint); PrintBitmap(Canvas, PL, FT, PR-PL, IH, FullBG.Handle); end else PrintTransparentBitmap3(Canvas, PL, FT, PR-PL, IH, TBitmap(TiledImage), TiledMask, IT, IH) end; except end; end; if HideOverflow then GetClippingRgn(Canvas, Rect(PL+MargArray[PaddingLeft], PT+MargArray[PaddingTop], PR-MargArray[PaddingRight], PB-MargArray[PaddingBottom]), ParentSectionList.Printing, Rgn, SaveRgn); SaveID := IMgr.CurrentID; Imgr.CurrentID := Self; if Positioning = posRelative then DrawTheList(Canvas, ARect, NewWidth, X, RefX+MargArray[MarginLeft]+MargArray[BorderLeftWidth]+MargArray[PaddingLeft], Y+MargArray[MarginTop]+MargArray[BorderTopWidth]+MargArray[PaddingTop]) else if Positioning = posAbsolute then DrawTheList(Canvas, ARect, NewWidth, X, RefX+MargArray[MarginLeft]+MargArray[BorderLeftWidth], Y+MargArray[MarginTop]+MargArray[BorderTopWidth]) else DrawTheList(Canvas, ARect, NewWidth, X, XRef, YRef); Imgr.CurrentID := SaveID; if HideOverflow then {restore any previous clip region} begin SelectClipRgn(Canvas.Handle, SaveRgn); DeleteObject(Rgn); if SaveRgn <> 0 then DeleteObject(SaveRgn); end; DrawBlockBorder(Canvas, Rect(BL, BT, BR, BB), Rect(PL, PT, PR, PB)); if OpenRgn then begin SelectClipRgn(Canvas.Handle, SaveRgn1); DeleteObject(SaveRgn1); end; end; procedure TBlock.DrawBlockBorder(Canvas: TCanvas; ORect, IRect: TRect); begin if BorderStyle <> bssNone then DrawBorder(Canvas, ORect, IRect, htColors(MargArray[BorderLeftColor], MargArray[BorderTopColor], MargArray[BorderRightColor], MargArray[BorderBottomColor]), htStyles(BorderStyleType(MargArray[BorderLeftStyle]), BorderStyleType(MargArray[BorderTopStyle]), BorderStyleType(MargArray[BorderRightStyle]), BorderStyleType(MargArray[BorderBottomStyle])), MargArray[BackgroundColor], ParentSectionList.Printing) end; procedure TBlock.DrawTheList(Canvas: TCanvas; ARect: TRect; ClipWidth, X, XRef, YRef :integer); {draw the list sorted by Z order.} var I: integer; SB: TSectionBase; SaveID: TObject; begin if Positioning = posAbsolute then with MyCell do begin SaveID := IMgr.CurrentID; IMgr.Reset(RefIMgr.LfEdge, RefIMgr.LfEdge+IMgr.Width); IMgr.ClipWidth := ClipWidth; IMgr.CurrentID := SaveID; end else MyCell.IMgr.ClipWidth := ClipWidth; with DrawList do for I := 0 to Count-1 do begin SB := TSectionBase(Items[I]); SB.Draw1(Canvas, ARect, MyCell.IMgr, X, XRef, YRef); end; end; procedure TBlock.FormTree(Indent: string; var Tree: string); var MyIndent: string; TM, BM: string; begin MyIndent := Indent + ' '; TM := IntToStr(MargArray[MarginTop]); BM := IntToStr(MargArray[MarginBottom]); Tree := Tree+Indent+TagClass+' '+TM+' '+BM+^M+^J; MyCell.FormTree(MyIndent, Tree); end; {----------------TTableAndCaptionBlock.Create} constructor TTableAndCaptionBlock.Create(Master: TSectionList; Prop: TProperties; AnOwnerCell: TCellBasic; Attributes: TAttributeList; ATableBlock: TTableBlock); var I: integer; begin inherited Create(Master, Prop, AnOwnerCell, Attributes); TableBlock := ATableBlock; Justify := TableBlock.Justify; for I := 0 to Attributes.Count-1 do with TAttribute(Attributes[I]) do case Which of AlignSy: if CompareText(Name, 'CENTER') = 0 then Justify := Centered else if CompareText(Name, 'LEFT') = 0 then begin if FloatLR = ANone then FloatLR := ALeft; end else if CompareText(Name, 'RIGHT') = 0 then begin if FloatLR = ANone then FloatLR := ARight; end; end; TableID := Attributes.TheID; {CollapseMargins has already been called by TableBlock, copy the results here} MargArray[MarginTop] := TableBlock.MargArray[MarginTop]; MargArray[MarginBottom] := TableBlock.MargArray[MarginBottom]; TagClass := 'TableAndCaption.'; end; {----------------TTableAndCaptionBlock.CancelUsage} procedure TTableAndCaptionBlock.CancelUsage; {called when it's found that this block isn't needed (no caption)} begin {assign the ID back to the Table} if TableID <> '' then ParentSectionList.IDNameList.AddObject(TableID, TableBlock); end; {----------------TTableAndCaptionBlock.CreateCopy} constructor TTableAndCaptionBlock.CreateCopy(AMasterList: TSectionList; T: TSectionBase); var TT: TTableAndCaptionBlock; Item: TObject; I1, I2: integer; begin inherited; TT := T as TTableAndCaptionBlock; TopCaption := TT.TopCaption; Justify := TT.Justify; TagClass := 'TableAndCaption.'; I1 := Ord(TopCaption); I2 := Ord(not TopCaption); Item := MyCell.Items[I2]; FCaptionBlock := (Item as TBlock); Item := MyCell.Items[I1]; TableBlock := (Item as TTableBlock); end; procedure TTableAndCaptionBlock.SetCaptionBlock(Value: TBlock); begin FCaptionBlock := Value; TableBlock.HasCaption := True; end; {----------------TTableAndCaptionBlock.FindWidth} function TTableAndCaptionBlock.FindWidth(Canvas: TCanvas; AWidth, AHeight, AutoCount: integer): integer; var Mx, Mn, FWidth: integer; begin BorderStyle := bssNone; {has no border} MargArray[BorderLeftWidth] := 0; MargArray[BorderTopWidth] := 0; MargArray[BorderRightWidth] := 0; MargArray[BorderBottomWidth] := 0; MargArray[PaddingLeft] := 0; MargArray[PaddingTop] := 0; MargArray[PaddingRight] := 0; MargArray[PaddingBottom] := 0; MargArray[BackgroundColor] := clNone; TableBlock.FloatLR := ANone; TableBlock.Table.Float := False; CaptionBlock.MinMaxWidth(Canvas, Mn, Mx); FWidth := TableBlock.FindWidth1(Canvas, AWidth, MargArray[MarginLeft]+MargArray[MarginRight]); Result := IntMax(FWidth, Mn); if (Result < AWidth) and (MargArray[MarginLeft] = 0) and (MargArray[MarginRight] = 0) then case Justify of Centered: MargArray[MarginLeft] := (AWidth - Result) div 2; Right: MargArray[MarginLeft] := AWidth - Result; end; TableBlock.Justify := Centered; end; {----------------TTableAndCaptionBlock.MinMaxWidth} procedure TTableAndCaptionBlock.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); var Mx, Mn, MxTable, MnTable: integer; begin TableBlock.MinMaxWidth(Canvas, MnTable, MxTable); FCaptionBlock.MinMaxWidth(Canvas, Mn, Mx); Min := IntMax(MnTable, Mn); Max := IntMax(MxTable, Mn); end; function TTableAndCaptionBlock.FindDocPos(SourcePos: integer; Prev: boolean): integer; begin if not Prev then begin Result := FCaptionBlock.FindDocPos(SourcePos, Prev); if Result < 0 then Result := TableBlock.FindDocPos(SourcePos, Prev); end else {Prev, iterate backwards} begin Result := TableBlock.FindDocPos(SourcePos, Prev); if Result < 0 then Result := FCaptionBlock.FindDocPos(SourcePos, Prev); end; end; {----------------TTableBlock.Create} constructor TTableBlock.Create(Master: TSectionList; Prop: TProperties; AnOwnerCell: TCellBasic; ATable: ThtmlTable; TableAttr: TAttributeList; TableLevel: integer); var I, AutoCount: integer; Percent: boolean; J: PropIndices; begin inherited Create(Master, Prop, AnOwnerCell, TableAttr); Table := ATable; Justify := NoJustify; for I := 0 to TableAttr.Count-1 do with TAttribute(TableAttr[I]) do case Which of AlignSy: if CompareText(Name, 'CENTER') = 0 then Justify := Centered else if CompareText(Name, 'LEFT') = 0 then begin if FloatLR = ANone then FloatLR := ALeft; end else if CompareText(Name, 'RIGHT') = 0 then begin if FloatLR = ANone then FloatLR := ARight; end; BGColorSy: BkGnd := ColorFromString(Name, False, BkColor); BackgroundSy: if not Assigned(BGImage) then begin BGImage := TImageObj.SimpleCreate(Master, Name); PRec[1].PosType := pDim; PRec[1].Value := 0; PRec[1].RepeatD := True; PRec[2] := PRec[1]; end; HSpaceSy: HSpace := IntMin(40, Abs(Value)); VSpaceSy: VSpace := IntMin(200, Abs(Value)); WidthSy: if Pos('%', Name) > 0 then begin if (Value > 0) and (Value <= 100) then WidthAttr := Value*10; AsPercent := True; end else WidthAttr := Value; HeightSy: if (VarType(MargArrayO[Height]) in VarInt) and (MargArrayO[Height] = IntNull) then MargArrayO[Height] := Name; end; if (Table.Border > 0) and (MargArrayO[BorderLeftStyle]=bssNone) and (MargArrayO[BorderTopStyle]=bssNone) and (MargArrayO[BorderRightStyle]=bssNone) and (MargArrayO[BorderBottomStyle]=bssNone) then begin {no CSS border} for J := BorderTopWidth to BorderLeftWidth do MargArrayO[J] := Table.Border; for J := BorderTopStyle to BorderLeftStyle do MargArrayO[J] := bssOutSet; TableBorder := True; end else TableBorder := False; {need to see if width is defined in style} Percent := (VarType(MargArrayO[Width]) = VarString) and (Pos('%', MargArrayO[Width]) > 0); ConvMargArray(MargArrayO, 100, 0, EmSize, ExSize, BorderStyle, AutoCount, MargArray); if MargArray[Width] > 0 then begin if Percent then begin AsPercent := True; WidthAttr := IntMin(1000, MargArray[Width] * 10); end else begin WidthAttr := MargArray[Width]; {By custom (not by specs), tables handle CSS Width property differently. The Width includes the padding and border.} MargArray[Width] := WidthAttr-MargArray[BorderLeftWidth]-MargArray[BorderRightWidth] -MargArray[PaddingLeft]-MargArray[PaddingRight]; MargArrayO[Width] := MargArray[Width]; AsPercent := False; end; end; CollapseMargins; Table.Float := FloatLR in [ALeft, ARight]; if Table.Float and (ZIndex = 0) then ZIndex := 1; end; {----------------TTableBlock.CreateCopy} constructor TTableBlock.CreateCopy(AMasterList: TSectionList; T: TSectionBase); var TT: TTableBlock; Item: TObject; begin inherited; TT := T as TTableBlock; {$IFNDEF FPC} System.Move(TT.WidthAttr, WidthAttr, DWord(@Justify)-DWord(@WidthAttr)+Sizeof(Justify)); {$ELSE} System.Move(TT.WidthAttr, WidthAttr, PtrUInt(@Justify)-PtrUInt(@WidthAttr)+Sizeof(Justify)); {$ENDIF} Item := MyCell.Items[0]; Table := Item as ThtmlTable; end; {----------------TTableBlock.MinMaxWidth} procedure TTableBlock.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); var TmpWidth: integer; begin TmpWidth := 0; if AsPercent then Table.tblWidthAttr := 0 else begin TmpWidth := IntMax(0, WidthAttr-MargArray[BorderLeftWidth]-MargArray[BorderRightWidth] -MargArray[PaddingLeft]-MargArray[PaddingRight]); Table.tblWidthAttr := TmpWidth; end; inherited MinMaxWidth(Canvas, Min, Max); if TmpWidth > 0 then begin Min := IntMax(Min, TmpWidth); Max := Min; end; end; {----------------TTableBlock.FindWidth1} function TTableBlock.FindWidth1(Canvas: TCanvas; AWidth, ExtMarg: integer): integer; {called by TTableAndCaptionBlock to assist in it's FindWidth Calculation. This method is called before TTableBlockFindWidth but is called only if there is a caption on the table. AWidth is the full width available to the TTableAndCaptionBlock.} var LeftSide, RightSide: integer; Min, Max, Allow: integer; begin MargArray[MarginLeft] := 0; MargArray[MarginRight] := 0; MargArray[MarginTop] := 0; MargArray[MarginBottom] := 0; LeftSide := MargArray[PaddingLeft]+MargArray[BorderLeftWidth]; RightSide := MargArray[PaddingRight]+MargArray[BorderRightWidth]; Table.tblWidthAttr := 0; if WidthAttr > 0 then begin if AsPercent then Result := IntMin(MulDiv(AWidth, WidthAttr, 1000), AWidth-ExtMarg) else Result := WidthAttr; Result := Result - (LeftSide + RightSide); Table.tblWidthAttr := Result; Table.MinMaxWidth(Canvas, Min, Max); Result := IntMax(Min, Result); Table.tblWidthAttr := Result; end else begin Table.MinMaxWidth(Canvas, Min, Max); Allow := AWidth - LeftSide - RightSide; if Max <= Allow then Result := Max else if Min >= Allow then Result := Min else Result := Allow; end; Result := Result + LeftSide + RightSide; end; {----------------TTableBlock.FindWidth} function TTableBlock.FindWidth(Canvas: TCanvas; AWidth, AHeight, AutoCount: integer): integer; var LeftSide, RightSide: integer; Min, Max, Allow: integer; begin if Not HasCaption then begin if MargArray[MarginLeft] = Auto then MargArray[MarginLeft] := 0; if MargArray[MarginRight] = Auto then MargArray[MarginRight] := 0; if FloatLR in [ALeft, ARight] then begin if MargArray[MarginLeft] = 0 then MargArray[MarginLeft] := HSpace; if MargArray[MarginRight] = 0 then MargArray[MarginRight] := HSpace; if MargArray[MarginTop] = 0 then MargArray[MarginTop] := VSpace; if MargArray[MarginBottom] = 0 then MargArray[MarginBottom] := VSpace; end; end else begin MargArray[MarginLeft] := 0; MargArray[MarginRight] := 0; end; if BkGnd and (MargArray[BackgroundColor] = clNone) then MargArray[BackgroundColor] := BkColor; Table.BkGnd := (MargArray[BackgroundColor] <> clNone) and not Assigned(BGImage); Table.BkColor := MargArray[BackgroundColor]; {to be passed on to cells} LeftSide := MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth]; RightSide := MargArray[MarginRight]+MargArray[PaddingRight]+MargArray[BorderRightWidth]; if not HasCaption then Table.tblWidthAttr := 0; if WidthAttr > 0 then begin if not HasCaption then {already done if HasCaption} begin if AsPercent then begin Result := MulDiv(AWidth, WidthAttr, 1000); Dec(Result, (LeftSide+RightSide)); end else Result := WidthAttr - (MargArray[PaddingLeft]+MargArray[BorderLeftWidth] +MargArray[PaddingRight]+MargArray[BorderRightWidth]); Table.tblWidthAttr := Result; Table.MinMaxWidth(Canvas, Min, Max); Result := IntMax(Min, Result); Table.tblWidthAttr := Result; end else Result := Table.tblWidthAttr; end else begin Table.MinMaxWidth(Canvas, Min, Max); Allow := AWidth - LeftSide - RightSide; if Max <= Allow then Result := Max else if Min >= Allow then Result := Min else Result := Allow; end; MargArray[Width] := Result; if (MargArray[MarginLeft] = 0) and (MargArray[MarginRight] = 0) and (Result + LeftSide + RightSide < AWidth) then case Justify of Centered: MargArray[MarginLeft] := (AWidth - (Result + LeftSide + RightSide)) div 2; Right: MargArray[MarginLeft] := AWidth - (Result + LeftSide + RightSide); end; end; function TTableBlock.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; var X1, Tmp: integer; begin if not (FloatLR in [ALeft, ARight]) then begin Tmp := X; X := IntMax(Tmp, IMgr.LeftIndent(Y)); TableIndent := X-Tmp; X1 := IntMin(Tmp+AWidth, IMgr.RightSide(Y)); AWidth := X1 - X; end; Result := inherited DrawLogic(Canvas, X, Y, XRef, YRef, AWidth, AHeight, BlHt, IMgr, MaxWidth, Curs); end; function TTableBlock.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; begin X := X+TableIndent; Result := inherited Draw1(Canvas, ARect, IMgr, X, XRef, YRef); end; procedure TTableBlock.DrawBlockBorder(Canvas: TCanvas; ORect, IRect: TRect); begin with Table, IRect do if TableBorder then begin if (BorderColorLight = clBtnHighLight) and (BorderColorDark = clBtnShadow) then RaisedRect(ParentSectionList, Canvas, Left-1, Top-1, Right, Bottom, True, Border) else RaisedRectColor(ParentSectionList, Canvas, Left-1, Top-1, Right, Bottom, BorderColorLight, BorderColorDark, True, Border); end else inherited; end; procedure TTableBlock.AddSectionsToList; begin {Sections in Table not added only table itself} ParentSectionList.PositionList.Add(Table); end; constructor THRBlock.CreateCopy(AMasterList: TSectionList; T: TSectionBase); begin inherited; Align := (T as THRBlock).Align; end; {----------------THRBlock.FindWidth} function THRBlock.FindWidth(Canvas: TCanvas; AWidth, AHeight, AutoCount: integer): integer; var LeftSide, RightSide, SWidth: integer; Diff: integer; begin if Positioning = posAbsolute then Align := Left; LeftSide := MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth]; RightSide := MargArray[MarginRight]+MargArray[PaddingRight]+MargArray[BorderRightWidth]; SWidth := MargArray[Width]; if SWidth > 0 then Result := IntMin(SWidth, AWidth - LeftSide - RightSide) else Result := IntMax(15, AWidth - LeftSide - RightSide); MargArray[Width] := Result; {note that above could be inherited; if LeftSide and Rightside were fields of TBlock} if Align <> Left then begin Diff := AWidth-Result-LeftSide-RightSide; if Diff > 0 then case Align of Centered: Inc(MargArray[MarginLeft], Diff div 2); Right: Inc(MargArray[MarginLeft], Diff); end; end; if not ParentSectionList.IsCopy then THorzline(MyHRule).VSize := MargArray[StyleUn.Height]; end; {----------------TBlockLI.Create} constructor TBlockLI.Create(Master: TSectionList; Prop: TProperties; AnOwnerCell: TCellBasic; Sy: Symb; APlain: boolean; AIndexType: char; AListNumb, ListLevel: integer; Attributes: TAttributeList); var Tmp: ListBulletType; S: string; TmpFont: TMyFont; begin inherited Create(Master, Prop, AnOwnerCell, Attributes); case Sy of UlSy, DirSy, MenuSy: begin ListType := Unordered; if APlain then ListStyleType := lbNone else case ListLevel Mod 3 of 1: ListStyleType := lbDisc; 2: ListStyleType := lbCircle; 0: ListStyleType := lbSquare; end; end; OLSy: begin ListType := Ordered; case AIndexType of 'a': ListStyleType := lbLowerAlpha; 'A': ListStyleType := lbUpperAlpha; 'i': ListStyleType := lbLowerRoman; 'I': ListStyleType := lbUpperRoman; else ListStyleType := lbDecimal; end; end; DLSy: ListType := Definition; else begin ListType := liAlone; ListStyleType := lbDisc; if (VarType(MargArrayO[MarginLeft]) in varInt) and ((MargArrayO[MarginLeft] = IntNull) or (MargArrayO[MarginLeft] = 0)) then MargArrayO[MarginLeft] := 16; end; end; ListNumb := AListNumb; Tmp := Prop.GetListStyleType; if Tmp <> lbBlank then ListStyleType := Tmp; ListFont := TMyFont.Create; TmpFont := Prop.GetFont; ListFont.Assign(TmpFont); TmpFont.Free; S := Prop.GetListStyleImage; if S <> '' then Image := TImageObj.SimpleCreate(Master, S); end; constructor TBlockLI.CreateCopy(AMasterList: TSectionList; T: TSectionBase); var TT: TBlockLI; begin inherited CreateCopy(AMasterList, T); TT := T as TBlockLI; ListType := TT.ListType; ListNumb := TT.ListNumb; ListStyleType := TT.ListStyleType; if Assigned(TT.Image) then Image := TImageObj.CreateCopy(AMasterList, TT.Image); ListFont := TMyFont.Create; ListFont.Assign(TT.ListFont); end; destructor TBlockLI.Destroy; begin ListFont.Free; Image.Free; inherited; end; function TBlockLI.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; begin if Assigned(Image) then begin Image.DrawLogic(ParentSectionList, Canvas, Nil, 100, 0); if (Image.Image = ErrorBitmap) then begin Image.Free; Image := Nil; end; end; ParentSectionList.FirstLineHtPtr := @FirstLineHt; FirstLineHt := 0; try Result := inherited DrawLogic(Canvas, X, Y, XRef, YRef, AWidth, AHeight, BlHt, IMgr, MaxWidth, Curs); finally ParentSectionList.FirstLineHtPtr := Nil; end; end; {----------------TBlockLI.Draw} function TBlockLI.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; const MaxRoman = 20; LowRoman: array[1..MaxRoman] of string[5] = ('i', 'ii', 'iii', 'iv', 'v', 'vi', 'vii', 'viii', 'ix', 'x', 'xi', 'xii', 'xiii', 'xiv', 'xv', 'xvi', 'xvii', 'xviii', 'xix', 'xx'); HighRoman: array[1..MaxRoman] of string[5] = ('I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX', 'X', 'XI', 'XII', 'XIII', 'XIV', 'XV', 'XVI', 'XVII', 'XVIII', 'XIX', 'XX'); var NStr : string[7]; {$IFNDEF MSWINDOWS} NWideStr : WideString; //LCL port: see below. {$ENDIF} BkMode, TAlign: integer; PenColor, BrushColor: TColor; PenStyle: TPenStyle; BrushStyle: TBrushStyle; YB, AlphaNumb: integer; procedure Circle(X, Y, Rad: integer); begin Canvas.Ellipse(X, Y-Rad, X+Rad, Y); end; begin Result := inherited Draw1(Canvas, ARect, IMgr, X, XRef, YRef); X := X+Indent; if FirstLineHt > 0 then begin YB := FirstLineHt-ParentSectionList.YOff; if (YB < ARect.Top-50) or (YB > ARect.Bottom+50) then Exit; if Assigned(Image) and (Image.Image <> DefBitmap) and ParentSectionList.ShowImages then begin Image.DoDraw(Canvas, X-16, YB-Image.ObjHeight, Image.Image, Image.Mask); end else if not (ListType in [None, Definition]) then begin if ListStyleType in [lbDecimal, lbLowerAlpha, lbLowerRoman, lbUpperAlpha, lbUpperRoman] then begin AlphaNumb := IntMin(ListNumb-1, 25); case ListStyleType of lbLowerAlpha: NStr := chr(ord('a')+AlphaNumb); lbUpperAlpha: NStr := chr(ord('A')+AlphaNumb); lbLowerRoman: NStr := LowRoman[IntMin(ListNumb, MaxRoman)]; lbUpperRoman: NStr := HighRoman[IntMin(ListNumb, MaxRoman)]; else NStr := IntToStr(ListNumb); end; Canvas.Font := ListFont; NStr := NStr+'.'; BkMode := SetBkMode(Canvas.Handle, Transparent); TAlign := SetTextAlign(Canvas.Handle, TA_BASELINE); {$IFDEF MSWINDOWS} Canvas.TextOut(X-10-Canvas.TextWidth(NStr), YB, NStr); {$ELSE} //Use TextOutW in order to intercept and use SetTextAlign. NWideStr := NStr; TextOutW(Canvas.Handle, X-10-Canvas.TextWidth(NStr), YB, PWideChar(NWideStr), Length(NStr)); {$ENDIF} SetTextAlign(Canvas.Handle, TAlign); SetBkMode(Canvas.Handle, BkMode); end else if (ListStyleType in [lbCircle, lbDisc, lbSquare]) then with Canvas do begin PenColor := Pen.Color; PenStyle := Pen.Style; Pen.Color := ListFont.Color; Pen.Style := psSolid; BrushStyle := Brush.Style; BrushColor := Brush.Color; Brush.Style := bsSolid; Brush.Color := ListFont.Color; case ListStyleType of lbCircle: begin Brush.Style := bsClear; Circle(X-16, YB, 7); end; lbDisc: Circle(X-15, YB-1, 5); lbSquare: Rectangle(X-15, YB-6, X-10, YB-1); end; Brush.Color := BrushColor; Brush.Style := BrushStyle; Pen.Color := PenColor; Pen.Style := PenStyle; end; end; end; end; {----------------TBodyBlock.Create} constructor TBodyBlock.Create(Master: TSectionList; Prop: TProperties; AnOwnerCell: TCellBasic; Attributes: TAttributeList); var PRec: PtPositionRec; Image: string; Val: TColor; begin inherited; positioning := PosStatic; {7.28} Prop.GetBackgroundPos(0, 0, PRec); if Prop.GetBackgroundImage(Image) and (Image <> '') then Master.SetBackgroundBitmap(Image, PRec); Val := Prop.GetBackgroundColor; if Val <> clNone then Master.SetBackGround(Val or PalRelative); end; {----------------TBodyBlock.GetURL} function TBodyBlock.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; begin if (BlockTitle <> '') then begin ATitle := BlockTitle; Include(Result, guTitle); end; Result := MyCell.GetURL(Canvas, X, Y, UrlTarg, FormControl, ATitle); end; {----------------TBodyBlock.DrawLogic} function TBodyBlock.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; var ScrollWidth: integer; Lindex, RIndex, AutoCount: integer; SaveID: TObject; ClientContentBot: integer; begin YDraw := Y; StartCurs := Curs; ConvMargArray(MargArrayO, AWidth, AHeight, EmSize, ExSize, BorderStyle, AutoCount, MargArray); NewWidth := IMgr.Width - (MargArray[MarginLeft]+MargArray[PaddingLeft]+ MargArray[BorderLeftWidth] + MargArray[MarginRight]+ MargArray[PaddingRight]+MargArray[BorderRightWidth]); X := MargArray[MarginLeft]+MargArray[PaddingLeft]+MargArray[BorderLeftWidth]; DrawTop := MargArray[MarginTop]; MyCell.IMgr := IMgr; SaveID := IMgr.CurrentID; Imgr.CurrentID := Self; LIndex := IMgr.SetLeftIndent(X, Y); RIndex := IMgr.SetRightIndent(X+NewWidth, Y); ContentTop := Y+MargArray[MarginTop]+MargArray[PaddingTop]+MargArray[BorderTopWidth]; ContentLeft := X; MyCell.DoLogicX(Canvas, X, ContentTop, 0, 0, NewWidth, AHeight-MargArray[MarginTop]-MargArray[MarginBottom], BlHt, ScrollWidth, Curs); Len := Curs-StartCurs; ClientContentBot := IntMax(ContentTop, MyCell.tcContentBot); ContentBot := ClientContentBot + MargArray[PaddingBottom]+ MargArray[BorderBottomWidth]+MargArray[MarginBottom]; DrawBot := IntMax(ClientContentBot, MyCell.tcDrawBot) + MargArray[PaddingBottom] +MargArray[BorderBottomWidth]; MyCell.tcDrawTop := 0; MyCell.tcContentBot := 999000; Result := DrawBot+MargArray[MarginBottom]-Y; SectionHeight := Result; IMgr.FreeLeftIndentRec(LIndex); IMgr.FreeRightIndentRec(RIndex); DrawHeight := IMgr.ImageBottom - Y; {in case image overhangs} Imgr.CurrentID := SaveID; if DrawHeight < SectionHeight then DrawHeight := SectionHeight; MaxWidth := IntMax(IMgr.Width, IntMax(ScrollWidth, NewWidth)+MargArray[MarginLeft]+MargArray[MarginRight]); if DrawList.Count = 0 then DrawSort; end; {----------------TBodyBlock.Draw} function TBodyBlock.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; var SaveID: TObject; Y: integer; begin Y := YDraw; Result := Y+SectionHeight; X := IMgr.LfEdge+MargArray[MarginLeft]+MargArray[BorderLeftWidth]+MargArray[PaddingLeft]; SaveID := IMgr.CurrentID; Imgr.CurrentID := Self; DrawTheList(Canvas, ARect, NewWidth, X, IMgr.LfEdge, 0); Imgr.CurrentID := SaveID; end; {----------------TSectionList} constructor TSectionList.Create(Owner, APaintPanel: TWinControl); begin inherited Create(Self); TheOwner := Owner; PPanel := APaintPanel; IDNameList := TIDNameList.Create(Self); htmlFormList := TFreeList.Create; AGifList := TList.Create; MapList := TFreeList.Create; FormControlList := TList.Create; MissingImages := TStringList.Create; MissingImages.Sorted := False; LinkList := TList.Create; PanelList := TList.Create; Styles := TStyleList.Create(Self); DrawList := TDrawList.Create; PositionList := TList.Create; TabOrderList := TStringList.Create; TabOrderList.Sorted := True; TabOrderList.Duplicates := dupAccept; InLineList := TInlineList.Create(Self); ScaleX := 1.0; ScaleY:= 1.0; end; {----------------TSectionList.CreateCopy} constructor TSectionList.CreateCopy(T: TSectionList); begin PrintTableBackground := T.PrintTableBackground; PrintBackground := T.PrintBackground; BitmapList := T.BitmapList; {same list} InlineList := T.InlineList; {same list} IsCopy := True; inherited CreateCopy(Self, T); {$IFNDEF FPC} System.Move(T.ShowImages, ShowImages, DWord(@Background)-Dword(@ShowImages)+Sizeof(integer)); {$ELSE} System.Move(T.ShowImages, ShowImages, PtrUInt(@Background)-PtrUInt(@ShowImages)+Sizeof(integer)); {$ENDIF} BitmapName := ''; BackgroundBitmap := Nil; BackgroundMask := Nil; BackgroundAniGif := Nil; BitmapLoaded := False; htmlFormList := TFreeList.Create; {no copy of list made} AGifList := TList.Create; Timer := Nil; MapList := TFreeList.Create; MissingImages := TStringList.Create; PanelList := TList.Create; DrawList := TDrawList.Create; ScaleX := 1.0; ScaleY:= 1.0; end; destructor TSectionList.Destroy; begin Clear; IDNameList.Free; htmlFormList.Free; MapList.Free; AGifList.Free; Timer.Free; FormControlList.Free; MissingImages.Free; LinkList.Free; PanelList.Free; Styles.Free; DrawList.Free; PositionList.Free; TabOrderList.Free; if not IsCopy then TInlineList(InlineList).Free; inherited Destroy; end; function TSectionList.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; var OldLink: TFontObj; OldImage: TImageObj; begin OldLink := ActiveLink; OldImage := ActiveImage; ActiveLink := Nil; ActiveImage := Nil; Result := inherited GetUrl(Canvas, X, Y, UrlTarg, FormControl, ATitle); if LinksActive and (ActiveLink <> OldLink) then begin if OldLink <> Nil then OldLink.SetAllHovers(LinkList, False); if ActiveLink <> Nil then ActiveLink.SetAllHovers(LinkList, True); PPanel.Invalidate; end; if (ActiveImage <> OldImage) then begin if OldImage <> Nil then OldImage.Hover := hvOff; end; if ActiveImage <> Nil then if Word(GetKeyState(VK_LBUTTON)) and $8000 <> 0 then ActiveImage.Hover := hvOverDown else ActiveImage.Hover := hvOverUp; end; procedure TSectionList.LButtonDown(Down: boolean); {called from htmlview.pas when left mouse button depressed} begin if ActiveImage <> Nil then begin if Down then ActiveImage.Hover := hvOverDown else ActiveImage.Hover := hvOverUp; PPanel.Invalidate; end; end; procedure TSectionList.CancelActives; begin if Assigned(ActiveLink) or Assigned(ActiveImage) then PPanel.Invalidate; if Assigned(ActiveLink) then begin ActiveLink.SetAllHovers(LinkList, False); ActiveLink := Nil; end; if Assigned(ActiveImage) then begin ActiveImage.Hover := hvOff; ActiveImage := Nil; end; end; procedure TSectionList.CheckGIFList(Sender: TObject); var I: integer; Frame: integer; begin if IsCopy then Exit; Frame := 0; if Assigned(BackgroundAniGif) then Frame := BackgroundAniGif.CurrentFrame; for I := 0 to AGifList.Count-1 do with TGifImage(AGifList.Items[I]) do if ShowIt then begin CheckTime(PPanel); end; if Assigned(BackgroundAniGif) and (Frame <> BackgroundAniGif.CurrentFrame) then PPanel.Invalidate; Timer.Interval := 40; end; procedure TSectionList.HideControls; var I, J: integer; begin {After next Draw, hide all formcontrols that aren't to be shown} for I := 0 to htmlFormList.Count-1 do with ThtmlForm(htmlFormList.Items[I]) do for J := 0 to ControlList.Count-1 do with TFormControlObj(ControlList.Items[J]) do ShowIt := False; for I := 0 to PanelList.Count-1 do TPanelObj(PanelList[I]).ShowIt := False; {same for panels} end; procedure TSectionList.SetYOffset(Y: integer); begin YOff := Y; YOffChange := True; HideControls; end; procedure TSectionList.Clear; begin if not IsCopy then begin IDNameList.Clear; PositionList.Clear; TInlineList(InlineList).Clear; end; BackgroundBitmap := Nil; BackgroundMask := Nil; BackgroundAniGif := Nil; if BitmapLoaded and (BitmapName <> '') then BitmapList.DecUsage(BitmapName); BitmapName := ''; BitmapLoaded := False; AGifList.Clear; Timer.Free; Timer := Nil; SelB := 0; SelE := 0; MapList.Clear; MissingImages.Clear; if Assigned(LinkList) then LinkList.Clear; ActiveLink := Nil; ActiveImage := Nil; PanelList.Clear; if not IsCopy then Styles.Clear; if Assigned(TabOrderList) then TabOrderList.Clear; inherited Clear; htmlFormList.Clear; if Assigned(FormControlList) then FormControlList.Clear; end; procedure TSectionList.ClearLists; {called from DoBody to clear some things when starting over} begin PanelList.Clear; if Assigned(FormControlList) then FormControlList.Clear; end; {----------------TSectionList.GetSelLength:} function TSectionList.GetSelLength: integer; var I: integer; begin Result := 0; if SelE <= SelB then Exit; {nothing to do} CB := SelTextCount.Create; try for I := 0 to Count-1 do with TSectionBase(Items[I]) do begin if (SelB >= StartCurs + Len) then Continue; if (SelE <= StartCurs) then Break; CopyToClipboard; end; Result := CB.Terminate; finally CB.Free; end; end; {----------------TSectionList.CopyToClipboard} procedure TSectionList.CopyToClipboardA(Leng: integer); var I: integer; SB: TSectionBase; begin if SelE <= SelB then Exit; {nothing to do} try CB := ClipBuffer.Create(Leng); for I := 0 to Count-1 do begin SB := TSectionBase(Items[I]); with SB do begin if (SelB >= StartCurs + Len) then Continue; if (SelE <= StartCurs) then Break; CopyToClipboard; end; end; CB.Terminate; finally CB.Free; end; end; {----------------TSectionList.GetSelTextBuf} function TSectionList.GetSelTextBuf(Buffer: PWideChar; BufSize: integer): integer; var I: integer; begin if BufSize >= 1 then begin Buffer[0] := #0; Result := 1; end else Result := 0; if SelE <= SelB then Exit; {nothing to do} CB := SelTextBuf.Create(Buffer, BufSize); try for I := 0 to Count-1 do with TSectionBase(Items[I]) do begin if (SelB >= StartCurs + Len) then Continue; if (SelE <= StartCurs) then Break; CopyToClipboard; end; Result := CB.Terminate; finally CB.Free; end; end; {----------------TSectionList.DoLogic} function TSectionList.DoLogic(Canvas: TCanvas; Y: integer; Width, AHeight, BlHt: integer; var ScrollWidth: integer; var Curs: integer): integer; var I, J: integer; begin Inc(CycleNumber); TableNestLevel := 0; NLevel := 0; InLogic2 := False; if Assigned(Timer) then Timer.Enabled := False; for I := 0 to htmlFormList.Count-1 do ThtmlForm(htmlFormList.Items[I]).SetSizes(Canvas); SetTextJustification(Canvas.Handle, 0, 0); TInlineList(InlineList).NeedsConverting := True; {set up the tab order for form controls according to the TabIndex attributes} if Assigned(TabOrderList) and (TabOrderList.Count > 0) then with TabOrderList do begin J := 0; {tab order starts with 0} for I := 0 to Count-1 do {list is sorted into proper order} begin if Objects[I] is TFormControlObj then begin with Objects[I] as TFormControlObj do if Assigned(FControl) then begin FControl.TabOrder := J; Inc(J); end; end else if Objects[I] is ThtTabControl then begin ThtTabcontrol(Objects[I]).TabOrder := J; Inc(J); end else Assert(False, 'Unexpected item in TabOrderList'); end; TabOrderList.Clear; {only need do this once} end; Result := inherited DoLogic(Canvas, Y, Width, AHeight, BlHt, ScrollWidth, Curs); for I := 0 to AGifList.Count-1 do with TGifImage(AGifList.Items[I]) do begin Animate := False; {starts iteration count from 1} if not Self.IsCopy then Animate := True; end; if not IsCopy and not Assigned(Timer) then begin Timer := TTimer.Create(TheOwner as ThtmlViewer); Timer.Interval := 50; Timer.OnTimer := CheckGIFList; end; if Assigned(Timer) then Timer.Enabled := AGifList.Count >= 1; AdjustFormControls; if not IsCopy and (PositionList.Count = 0) then begin AddSectionsToList; end; end; procedure TSectionList.AdjustFormControls; var I: integer; Control: TControl; Showing: boolean; {$ifndef FastRadio} function ActiveInList: boolean; {see if active control is a form control} var Control: TWinControl; I: integer; begin with FormControlList do begin Result := False; Control := Screen.ActiveControl; for I := 0 to Count-1 do with TFormControlObj(Items[I]) do if FControl = Control then begin Result := True; Break; end; end; end; {$endif} begin if IsCopy or (FormControlList.Count = 0) then Exit; with FormControlList do {$ifndef FastRadio} if not ActiveInList then begin {if none of the formcontrols are active, turn off tabs for those off screen} for I := 0 to Count-1 do with TFormControlObj(Items[I]) do if not ShowIt and Assigned(FControl) then FControl.Hide; {hides and turns off tabs} end else {$endif} begin Control := TheOwner; {ThtmlViewer} repeat Showing := Control.Visible; Control := Control.Parent; until not Showing or not Assigned(Control); if Showing then for I := 0 to Count-1 do with TFormControlObj(Items[I]) do if not ShowIt and Assigned(FControl) then begin FControl.Show; {turns on tabs} FControl.Left := -4000; {but it still can't be seen} end; end; end; {----------------TSectionList.Draw} function TSectionList.Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer; Y, XRef, YRef :integer): integer; var OldPal: HPalette; I: integer; begin PageBottom := ARect.Bottom + YOff; PageShortened := False; FirstPageItem := True; TableNestLevel := 0; SkipDraw := False; if Assigned(Timer) then Timer.Enabled := False; for I := 0 to AGifList.Count-1 do with TGifImage(AGifList.Items[I]) do begin ShowIt := False; end; if Assigned(BackgroundAniGif) and not IsCopy then BackgroundAniGif.ShowIt := True; if (ColorBits <= 8) then begin OldPal := SelectPalette(Canvas.Handle, ThePalette, True); RealizePalette(Canvas.Handle); end else OldPal := 0; DrawList.Clear; try Result := inherited Draw(Canvas, ARect, ClipWidth, X, Y, XRef, YRef); DrawList.DrawImages; finally if OldPal <> 0 then SelectPalette(Canvas.Handle, OldPal, True); end; if YOffChange then begin AdjustFormControls; {Hide all TPanelObj's that aren't displayed} for I := 0 to PanelList.Count-1 do with TPanelObj(PanelList[I]) do if not ShowIt then Panel.Hide; YOffChange := False; end; if Assigned(Timer) then Timer.Enabled := AGifList.Count >= 1; end; procedure TSectionList.SetFonts(const Name, PreName: String; ASize: integer; AColor, AHotSpot, AVisitedColor, AActiveColor, ABackground: TColor; LnksActive: boolean; LinkUnderLine: boolean; ACharSet: TFontCharSet; MarginHeight, MarginWidth: integer); begin Styles.Initialize(Name, PreName, ASize, AColor, AHotspot, AVisitedColor, AActiveColor, LinkUnderLine, ACharSet, MarginHeight, MarginWidth); InitializeFontSizes(ASize); PreFontName := PreName; HotSpotColor := AHotSpot; LinkVisitedColor := AVisitedColor; LinkActiveColor := AActiveColor; LinksActive := LnksActive; SetBackground(ABackground); end; procedure TSectionList.SetBackground(ABackground: TColor); begin Background := ABackground; if Assigned(OnBackGroundChange) then OnBackgroundChange(Self); end; procedure TSectionList.SetBackgroundBitmap(Name: String; const APrec: PtPositionRec); begin BackgroundBitmap := Nil; BackgroundAniGif := Nil; BitmapName := Name; BitmapLoaded := False; BackgroundPRec := APrec; end; {----------------TSectionList.InsertImage} procedure TSectionList.InsertImage(const Src: string; Stream: TMemoryStream; var Reformat: boolean); var UName: string; I, J: integer; Pair: TBitmapItem; NonAnimated, Rformat, Error: boolean; Image: TgpObject; AMask: TBitmap; Tr, Transparent: Transparency; Obj: TObject; Tmp: TGifImage; begin Image := Nil; AMask := Nil; Error := False; Reformat := False; UName := Trim(Uppercase(Src)); I := BitmapList.IndexOf(UName); {first see if the bitmap is already loaded} J := MissingImages.IndexOf(UName); {see if it's in missing image list} if (I = -1) and (J >= 0) then begin Transparent := NotTransp; if Assigned(Stream) and (Stream.Memory <> Nil) and (Stream.Size >= 1) then begin NonAnimated := True; if KindOfImage(Stream.Memory) in [GIF, Gif89] then Image := CreateAGifFromStream(NonAnimated, Stream); if Assigned(Image) then begin if NonAnimated then begin {else already have animated GIF} Tmp := TGifImage(Image); Image := TBitmap.Create; TBitmap(Image).Assign(Tmp.MaskedBitmap); if Tmp.IsTransparent then begin AMask := TBitmap.Create; AMask.Assign(Tmp.Mask); Transparent := TGif; end; Tmp.Free; end; end else Image := GetImageAndMaskFromStream(Stream, Transparent, AMask); end; if Assigned(Image) then {put in Cache} try if Assigned(AMask) then Tr := Transparent else Tr := NotTransp; Pair := TBitmapItem.Create(Image, AMask, Tr); try BitmapList.AddObject(UName, Pair); {put new bitmap in list} BitmapList.DecUsage(UName); {this does not count as being used yet} except Pair.Mask := Nil; Pair.MImage:= Nil; Pair.Free; end; except {accept inability to create} end else Error := True; {bad stream or Nil} end; if (I >= 0) or Assigned(Image) or Error then {a valid image in the Cache or Bad stream} begin while J >= 0 do begin Obj := MissingImages.Objects[J]; if (Obj = Self) and not IsCopy and not Error then BitmapLoaded := False {the background image, set to load} else if (Obj is TImageObj) then begin TImageObj(Obj).InsertImage(UName, Error, Rformat); Reformat := Reformat or Rformat; end; MissingImages.Delete(J); J := MissingImages.IndexOf(UName); end; end; end; {----------------TSectionList.GetTheBitmap} function TSectionList.GetTheBitmap(const BMName: String; var Transparent: Transparency; var AMask: TBitmap; var FromCache, Delay: boolean): TgpObject; {Note: bitmaps and Mask returned by this routine are on "loan". Do not destroy them} {Transparent may be set to NotTransp or LLCorner on entry but may discover it's TGif here} {$ifdef ShareWare} const OneTime: boolean = False; {$endif} var UName: string; I: integer; Pair: TBitmapItem; Tr: Transparency; NonAnimated: boolean; Stream: TMemoryStream; Color: TColor; Tmp: TGifImage; function LoadImageFromFile(const FName: string; var AMask: TBitmap; var Transparent: Transparency): TgpObject; var Tmp: TGifImage; begin {look for the image file} AMask := Nil; NonAnimated := True; if KindOfImageFile(FName) in [Gif, Gif89] then begin Result := CreateAGif(FName, NonAnimated); if Assigned(Result) then begin if NonAnimated then begin {else already have animated GIF} Tmp := TGifImage(Result); Result := TBitmap.Create; TBitmap(Result).Assign(Tmp.MaskedBitmap); if Tmp.IsTransparent then begin AMask := TBitmap.Create; AMask.Assign(Tmp.Mask); Transparent := TGif; end else if Transparent = LLCorner then AMask := GetImageMask(TBitmap(Result), False, 0); Tmp.Free; end; end; end else Result := GetImageAndMaskFromFile(FName, Transparent, AMask); end; begin {$ifdef ShareWare} {$Include DemoVers.inc} {$endif} AMask := Nil; Delay := False; FromCache := False; if BMName <> '' then begin UName := Trim(Uppercase(BMName)); I := BitmapList.IndexOf(UName); {first see if the bitmap is already loaded} if I > -1 then begin {yes, handle the case where the image is already loaded} Result := BitmapList.GetImage(I); FromCache := True; if Result is TBitmap then with BitmapList.Objects[I] as TBitmapItem do begin if Transp = TGif then Transparent := TGif {it's a transparent GIF} else if Transp = Tpng then Transparent := TPng else if Transparent = LLCorner then begin if not Assigned (Mask) then {1st bitmap may not have been marked transp} Mask := GetImageMask(TBitmap(MImage), False, 0); if Assigned(Mask) then Transp := LLCorner; end; AMask := Mask; end; Exit; end; {The image is not loaded yet, need to get it} Result := Nil; if Assigned(GetBitmap) or Assigned(GetImage) then begin if Assigned(GetBitmap) then begin {the OnBitmapRequest event} Color := -1; GetBitmap(TheOwner, BMName, TBitmap(Result), Color); if Assigned(Result) then if Color <> -1 then begin AMask := GetImageMask(TBitmap(Result), True, Color); Transparent := TGif; end else if (Transparent = LLCorner) then AMask := GetImageMask(TBitmap(Result), False, 0); end; if Assigned(GetImage) then begin {the OnImageRequest} Stream := Nil; GetImage(TheOwner, BMName, Stream); if Stream = WaitStream then Delay := True else if not Assigned(Stream) then Result := LoadImageFromFile(ThtmlViewer(TheOwner).HTMLExpandFilename(BMName), AMask, Transparent) else if Assigned(Stream) and (Stream.Memory <> Nil) and (Stream.Size >= 1) then begin NonAnimated := True; if KindOfImage(Stream.Memory) in [GIF, Gif89] then Result := CreateAGifFromStream(NonAnimated, Stream); if Assigned(Result) then begin if NonAnimated then begin {else already have animated GIF} Tmp := TGifImage(Result); Result := TBitmap.Create; TBitmap(Result).Assign(Tmp.MaskedBitmap); if Tmp.IsTransparent then begin AMask := TBitmap.Create; AMask.Assign(Tmp.Mask); Transparent := TGif; end else if Transparent = LLCorner then AMask := GetImageMask(TBitmap(Result), False, 0); Tmp.Free; end; end else Result := GetImageAndMaskFromStream(Stream, Transparent, AMask); end; end; end else Result := LoadImageFromFile(BMName, AMask, Transparent); if Assigned(Result) then {put in Image List for use later also} try if Assigned(AMask) then Tr := Transparent else Tr := NotTransp; Pair := TBitmapItem.Create(Result, AMask, Tr); try BitmapList.AddObject(UName, Pair); {put new bitmap in list} except Pair.Mask := Nil; Pair.MImage:= Nil; Pair.Free; end; except {accept inability to create} end; end else Result := Nil; end; {----------------TSectionList.FindSectionAtPosition} function TSectionList.FindSectionAtPosition(Pos: integer; var TopPos: integer; var Index: integer): TSectionBase; var I: integer; begin with PositionList do for I := Count-1 downto 0 do if TSectionBase(Items[I]).YPosition <= Pos then begin Result := TSectionBase(Items[I]); TopPos := Result.YPosition; Index := I; Exit; end; Result := Nil; end; procedure TSectionList.GetBackgroundBitmap; var Mask: TBitmap; Dummy1: Transparency; TmpResult: TgpObject; FromCache, Delay: boolean; Rslt: string; begin if ShowImages and not BitmapLoaded and (BitmapName <> '') then begin if not Assigned(BackgroundBitmap) then begin Dummy1 := NotTransp; if not Assigned(GetBitmap) and not Assigned(GetImage) then BitmapName := (TheOwner as ThtmlViewer).HTMLExpandFilename(BitmapName) else if Assigned(ExpandName) then begin ExpandName(TheOwner, BitmapName, Rslt); BitmapName := Rslt; end; TmpResult := GetTheBitmap(BitmapName, Dummy1, Mask, FromCache, Delay); {might be Nil} if (TmpResult is TBitmap) or (TmpResult is TGpImage) then begin BackgroundBitmap := TmpResult; BackgroundMask := Mask; end else if TmpResult is TGifImage then begin BackgroundBitmap := TGifImage(TmpResult).MaskedBitmap; BackgroundMask := TGifImage(TmpResult).Mask; if TGifImage(TmpResult).IsAnimated and not IsCopy then begin BackgroundAniGif := TGifImage(TmpResult); AGifList.Add(BackgroundAniGif); BackgroundAniGif.Animate := True; end; end {$ifndef NoMetafile} else if TmpResult is ThtMetaFile then begin BackgroundBitmap := ThtMetaFile(TmpResult); end {$endif} else begin BackgroundBitmap := Nil; if Delay then MissingImages.AddObject(BitmapName, Self); end; BitmapLoaded := True; end; end; end; {----------------TSectionList.GetFormcontrolData} function TSectionList.GetFormcontrolData: TFreeList; var I: integer; begin if htmlFormList.Count > 0 then begin Result := TFreeList.Create; for I := 0 to htmlFormList.Count-1 do Result.Add(ThtmlForm(htmlFormList[I]).GetFormSubmission); end else Result := Nil; end; procedure TSectionList.SetFormcontrolData(T: TFreeList); var I: integer; begin try for I := 0 to T.Count-1 do if htmlFormList.Count > I then ThtmlForm(htmlFormList[I]).SetFormData(TStringList(T[I])); except end; end; {----------------TSectionList.FindDocPos} function TSectionList.FindDocPos(SourcePos: integer; Prev: boolean): integer; begin Result := inherited FindDocPos(SourcePos, Prev); if Result < 0 then {if not found return 1 past last char} Result := Len; end; {----------------TSectionList.CursorToXY} function TSectionList.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer; var Y: integer): boolean; var Beyond: boolean; begin Beyond := Cursor >= Len; if Beyond then Cursor := Len-1; Result := inherited CursorToXY(Canvas, Cursor, X, Y); if Beyond then X := X+15; end; procedure TSectionList.ProcessInlines(SIndex: integer; Prop: TProperties; Start: boolean); {called when an inline property is found to specify a border} var I, EmSize, ExSize: integer; IR: InlineRec; MargArrayO: TVMarginArray; Dummy: BorderStyleType; Dummy1: integer; begin with InlineList do begin if Start then begin {this is for border start} IR := InlineRec.Create; InlineList.Add(IR); with IR do begin StartBDoc := SIndex; {Source index for border start} IDB := Prop.ID; {property ID} EndB := 999999; {end isn't known yet} Prop.GetVMarginArray(MargArrayO); EmSize := Prop.EmSize; ExSize := Prop.ExSize; Dummy := bssNone; ConvMargArray(MargArrayO, 200, 200, EmSize, ExSize, Dummy, Dummy1, MargArray); end; end else {this call has end information} for I := Count-1 downto 0 do {the record we want is probably the last one} begin IR := InlineRec(Items[I]); if Prop.ID = IR.IDB then {check the ID to make sure} begin IR.EndBDoc := SIndex; {the source position of the border end} Break; end; end; end; end; {----------------TInlineList.Create} constructor TInlineList.Create(AnOwner: TSectionList); begin inherited Create; Owner := AnOwner; NeedsConverting := True; end; procedure TInlineList.Clear; begin inherited Clear; NeedsConverting := True; end; procedure TInlineList.AdjustValues; {convert all the list data from source char positions to display char positions} var I: integer; begin for I := 0 to Count-1 do with InlineRec(Items[I]) do begin StartB := Owner.FindDocPos(StartBDoc, False); EndB := Owner.FindDocPos(EndBDoc, False); if StartB = EndB then Dec(StartB); {this takes care of images, form controls} end; NeedsConverting := False; end; function TInlineList.GetStartB(I: integer): integer; begin if NeedsConverting then AdjustValues; if (I < Count) and (I >= 0) then Result := InlineRec(Items[I]).StartB else Result := 99999999; end; function TInlineList.GetEndB(I: integer): integer; begin if NeedsConverting then AdjustValues; if (I < Count) and (I >= 0) then Result := InlineRec(Items[I]).EndB else Result := 99999999; end; {----------------TCellObj.Create} constructor TCellObj.Create(Master: TSectionList; AVAlign: AlignmentType; Attr: TAttributeList; Prop: TProperties); {Note: on entry Attr and Prop may be Nil when dummy cells are being created} var I, AutoCount: integer; Color: TColor; BackgroundImage: string; Percent: boolean; Algn: AlignmentType; begin inherited Create; Cell := TCellObjCell.Create(Master); if Assigned(Prop) then Cell.Title := Prop.PropTitle; ColSpan := 1; RowSpan := 1; VAlign := AVAlign; if Assigned(Attr) then for I := 0 to Attr.Count-1 do with TAttribute(Attr[I]) do case Which of ColSpanSy: if Value > 1 then ColSpan := Value; RowSpanSy: if Value > 1 then RowSpan := Value; WidthSy: if Pos('%', Name) > 0 then begin if (Value > 0) and (Value <= 100) then begin WidthAttr := Value*10; AsPercent := True; end; end else if (Value > 0) then WidthAttr := Value; HeightSy: if Pos('%', Name) = 0 then SpecHt := Value else SpecHtPercent := IntMax(0, IntMin(Value, 100)); BGColorSy: Cell.BkGnd := ColorFromString(Name, False, Cell.BkColor); BackgroundSy: BackgroundImage := Name; HRefSy: Cell.Url := Name; TargetSy: Cell.Target := Name; end; if Assigned(Prop) then begin {Caption does not have Prop} if Prop.GetVertAlign(Algn) and (Algn in [Atop, AMiddle, ABottom]) then Valign := Algn; Prop.GetVMarginArray(MargArrayO); EmSize := Prop.EmSize; ExSize := Prop.ExSize; Percent := (VarType(MargArrayO[Width]) = VarString) and (Pos('%', MargArrayO[Width]) > 0); ConvMargArray(MargArrayO, 100, 0, EmSize, ExSize, bssNone, AutoCount, MargArray); if MargArray[Width] > 0 then if Percent then begin if MargArray[Width] < 100 then begin AsPercent := True; WidthAttr := MargArray[Width] * 10; end; end else begin WidthAttr := MargArray[Width]; AsPercent := False; end; if MargArray[Height] > 0 then SpecHt := MargArray[Height]; Color := Prop.GetBackgroundColor; if Color <> clNone then begin Cell.BkGnd := True; Cell.BkColor := Color; end; Prop.GetBackgroundImage(BackgroundImage); {'none' will change string to empty} if BackgroundImage <> '' then begin BGImage := TImageObj.SimpleCreate(Master, BackgroundImage); Prop.GetBackgroundPos(EmSize, ExSize, PRec); end; BorderStyle := Prop.GetBorderStyle; {In the following, Padding widths in percent aren't accepted} ConvMargArrayForCellPadding(MargArrayO, EmSize, ExSize, MargArray); PadTop := MargArray[PaddingTop]; PadRight := MargArray[PaddingRight]; PadBottom := MargArray[PaddingBottom]; PadLeft := MargArray[PaddingLeft]; if BorderStyle <> bssNone then begin BrdTop := MargArray[BorderTopWidth]; BrdRight := MargArray[BorderRightWidth]; BrdBottom := MargArray[BorderBottomWidth]; BrdLeft := MargArray[BorderLeftWidth]; end; Prop.GetPageBreaks(BreakBefore, BreakAfter, KeepIntact); end; end; constructor TCellObj.CreateCopy(AMasterList: TSectionList; T: TCellObj); begin inherited create; Cell := TCellObjCell.CreateCopy(AMasterList, T.Cell); {$IFNDEF FPC} Move(T.ColSpan, ColSpan, DWord(@Cell)-DWord(@ColSpan)); {$ELSE} Move(T.ColSpan, ColSpan, PtrUInt(@Cell)-PtrUInt(@ColSpan)); {$ENDIF} if AMasterList.PrintTableBackground then begin Cell.BkGnd := T.Cell.BkGnd; Cell.BkColor := T.Cell.BkColor; end else Cell.BkGnd := False; if Assigned(T.BGImage) and AMasterList.PrintTableBackground then BGImage := TImageObj.CreateCopy(AMasterList, T.BGImage); MargArrayO := T.MargArrayO; MargArray := T.MargArray; end; destructor TCellObj.Destroy; begin Cell.Free; BGImage.Free; TiledImage.Free; TiledMask.Free; FullBG.Free; inherited Destroy; end; {----------------TCellObj.InitializeCell} procedure TCellObj.InitializeCell(TablePadding: integer; const BkImageName: string; const APRec: PtPositionRec; Border: boolean); begin if PadTop < 0 then PadTop := TablePadding; if PadRight < 0 then PadRight := TablePadding; if PadBottom < 0 then PadBottom := TablePadding; if PadLeft < 0 then PadLeft := TablePadding; if Border and (BorderStyle = bssNone) then begin BrdLeft := IntMax(1, BrdLeft); BrdRight := IntMax(1, BrdRight); BrdTop := IntMax(1, BrdTop); BrdBottom := IntMax(1, BrdBottom); end; HzSpace := PadLeft+BrdLeft+BrdRight+PadRight; VrSpace := PadTop+BrdTop+BrdBottom+PadBottom; if (BkImageName <> '') and not Assigned(BGImage) then begin BGImage := TImageObj.SimpleCreate(Cell.MasterList, BkImageName); PRec := APrec; end; end; {----------------TCellObj.DrawLogic2} procedure TCellObj.DrawLogic2(Canvas : TCanvas; Y, CellSpacing: integer; var Curs: integer); var Dummy: integer; Tmp: integer; begin if Cell.Count > 0 then begin Tmp := Ht - VSize - (VrSpace+CellSpacing); case VAlign of ATop: YIndent := 0; AMiddle: YIndent := Tmp div 2; ABottom, ABaseline: YIndent := Tmp; end; Dummy := 0; Cell.DoLogic(Canvas, Y+PadTop+BrdTop+CellSpacing+YIndent, Wd-(HzSpace+CellSpacing), Ht-VrSpace-CellSpacing, 0, Dummy, Curs); end; if Assigned(BGImage) and Cell.MasterList.ShowImages then begin BGImage.DrawLogic(Cell.MasterList, Canvas, Nil, 100, 0); if BGImage.Image = ErrorBitmap then begin BGImage.Free; BGImage := Nil; end else begin BGImage.ImageKnown := True; {won't need reformat on InsertImage} NeedDoImageStuff := True; end; end; end; {----------------TCellObj.Draw} procedure TCellObj.Draw(Canvas: TCanvas; const ARect: TRect; X, Y, CellSpacing: integer; Border: boolean; Light, Dark: TColor); var YO: integer; BL, BT, BR, BB, PL, PT, PR, PB: integer; ImgOK: boolean; IT, IH, FT, Rslt: integer; Rgn, SaveRgn: HRgn; Point: TPoint; SizeV, SizeW: TSize; HF, VF: double; BRect: TRect; Colors: htColorArray; Styles: htBorderStyleArray; procedure InitFullBg(W, H: integer); begin if not Assigned(FullBG) then begin FullBG := TBitmap.Create; if Cell.MasterList.IsCopy then begin FullBG.HandleType := bmDIB; if ColorBits <= 8 then FullBG.Palette := CopyPalette(ThePalette); end; end; FullBG.Height := IntMax(H, 2); FullBG.Width := IntMax(W, 2); end; begin YO := Y - Cell.MasterList.YOff; BL := X + CellSpacing; {Border left and right} BR := X + Wd; PL := BL + BrdLeft; {Padding left and right} PR := BR - BrdRight; BT := Y - Cell.MasterList.YOff + Cellspacing; {Border Top and Bottom} if CellSpacing >= 0 then BB := BT + Ht - CellSpacing else BB := BT + Ht; PT := BT + BrdTop; {Padding Top and Bottom} PB := BB - BrdBottom; IT := IntMax(0, Arect.Top-2-PT); FT := IntMax(PT, ARect.Top-2); {top of area drawn, screen coordinates} IH := IntMin(PB-FT, Arect.Bottom-FT); {height of area actually drawn} Cell.MyRect := Rect(BL, BT, BR, BB); if not (BT <= ARect.Bottom) and (BB >= ARect.Top) then Exit; try if NeedDoImageStuff and (BGImage.Image <> DefBitmap) then begin if BGImage.Image = ErrorBitmap then {Skip the background image} FreeAndNil(BGImage) else try DoImageStuff(Canvas, Wd-CellSpacing, Ht-CellSpacing, BGImage, PRec, TiledImage, TiledMask, NoMask); if Cell.MasterList.IsCopy and (TiledImage is TBitmap) then TBitmap(TiledImage).HandleType := bmDIB; except {bad image, get rid of it} FreeAndNil(BGImage); FreeAndNil(TiledImage); FreeAndNil(TiledMask); end; NeedDoImageStuff := False; end; ImgOK := Not NeedDoImageStuff and Assigned(BGImage) and (BGImage.Bitmap <> DefBitmap) and Cell.MasterList.ShowImages; if Cell.BkGnd then begin Canvas.Brush.Color := Cell.BkColor or PalRelative; Canvas.Brush.Style := bsSolid; if Cell.MasterList.IsCopy and ImgOK then begin InitFullBG(PR-PL, IH); FullBG.Canvas.Brush.Color := Cell.BkColor or PalRelative; FullBG.Canvas.Brush.Style := bsSolid; FullBG.Canvas.FillRect(Rect(0, 0, PR-PL, IH)); end else if BorderStyle = bssNone then if Border then {slip under border to fill gap when printing} Canvas.FillRect(Rect(PL-1, FT-1, PR, FT+IH)) else Canvas.FillRect(Rect(PL, FT, PR, FT+IH)) else begin {slip the fill under any border} BRect := Rect(PL, FT, PR, FT+IH); if MargArray[BorderRightWidth] > 0 then Inc(BRect.Right); if MargArray[BorderBottomWidth] > 0 then Inc(BRect.Bottom); Canvas.FillRect(BRect); end; end; if ImgOK then begin if not Cell.MasterList.IsCopy then if TiledImage is TgpBitmap then DrawGpImage(Canvas.Handle, TgpImage(TiledImage), PL, FT, 0, IT, PR-PL, IH) else if NoMask then BitBlt(Canvas.Handle, PL, FT, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SrcCopy) else begin InitFullBG(PR-PL, IH); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, Canvas.Handle, PL, FT, SrcCopy); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SrcInvert); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TiledMask.Canvas.Handle, 0, IT, SRCAND); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SRCPaint); BitBlt(Canvas.Handle, PL, FT, PR-PL, IH, FullBG.Canvas.Handle, 0, 0, SRCCOPY); end else if TiledImage is TgpBitmap then {printing} begin if Cell.BkGnd then begin DrawGpImage(FullBg.Canvas.Handle, TgpImage(TiledImage), 0, 0); PrintBitmap(Canvas, PL, FT, PR-PL, IH, FullBG.Handle); end else PrintGpImageDirect(Canvas.Handle, TgpImage(TiledImage), PL, PT, Cell.MasterList.ScaleX, Cell.MasterList.ScaleY); end else if NoMask then PrintBitmap(Canvas, PL, FT, PR-PL, IH, TBitmap(TiledImage).Handle) else if Cell.BkGnd then begin InitFullBG(PR-PL, IH); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SrcInvert); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TiledMask.Canvas.Handle, 0, IT, SRCAND); BitBlt(FullBG.Canvas.Handle, 0, 0, PR-PL, IH, TBitmap(TiledImage).Canvas.Handle, 0, IT, SRCPaint); PrintBitmap(Canvas, PL, FT, PR-PL, IH, FullBG.Handle); end else PrintTransparentBitmap3(Canvas, PL, FT, PR-PL, IH, TBitmap(TiledImage), TiledMask, IT, IH); end; except end; try if (Cell.Count > 0) and (YO < ARect.Bottom+200) and (YO+Ht > -200) then begin {clip cell contents to prevent overflow. First check to see if there is already a clip region} SaveRgn := CreateRectRgn(0, 0, 1, 1); Rslt := GetClipRgn(Canvas.Handle, SaveRgn); {Rslt = 1 for existing region, 0 for none} {Form the region for this cell} GetWindowOrgEx(Canvas.Handle, Point); {when scrolling or animated Gifs, canvas may not start at X=0, Y=0} if not Cell.MasterList.Printing then if IsWin95 then Rgn := CreateRectRgn(X+CellSpacing-Point.X, IntMax(YO+CellSpacing-Point.Y, -32000), X+Wd-Point.X, IntMin(YO+Ht-Point.Y, 32000)) else Rgn := CreateRectRgn(X+CellSpacing-Point.X, YO+CellSpacing-Point.Y, X+Wd-Point.X, YO+Ht-Point.Y) else begin GetViewportExtEx(Canvas.Handle, SizeV); GetWindowExtEx(Canvas.Handle, SizeW); HF := (SizeV.cx/SizeW.cx); {Horizontal adjustment factor} VF := (SizeV.cy/SizeW.cy); {Vertical adjustment factor} if IsWin95 then Rgn := CreateRectRgn(Round(HF*(X+CellSpacing-Point.X)-1), IntMax(Round(VF*(YO+CellSpacing-Point.Y)-1), -32000), Round(HF*(X+Wd-Point.X)+1), IntMin(Round(VF*(YO+Ht-Point.Y)), 32000)) else Rgn := CreateRectRgn(Round(HF*(X+CellSpacing-Point.X)-1), Round(VF*(YO+CellSpacing-Point.Y)-1), Round(HF*(X+Wd-Point.X)+1), Round(VF*(YO+Ht-Point.Y))); end; if Rslt = 1 then {if there was a region, use the intersection with this region} CombineRgn(Rgn, Rgn, SaveRgn, Rgn_And); SelectClipRgn(Canvas.Handle, Rgn); try Cell.Draw(Canvas, ARect, Wd-HzSpace-CellSpacing, X+PadLeft+BrdLeft+CellSpacing, Y+PadTop+BrdTop+YIndent, ARect.Left, 0); {possibly should be IRgn.LfEdge} finally if Rslt = 1 then {restore any previous clip region} SelectClipRgn(Canvas.Handle, SaveRgn) else SelectClipRgn(Canvas.Handle, 0); DeleteObject(Rgn); DeleteObject(SaveRgn); end; end; Cell.DrawYY := Y; if BorderStyle <> bssNone then begin Styles := htStyles(BorderStyleType(MargArray[BorderLeftStyle]), BorderStyleType(MargArray[BorderTopStyle]), BorderStyleType(MargArray[BorderRightStyle]), BorderStyleType(MargArray[BorderBottomStyle])); Colors := htColors(MargArray[BorderLeftColor], MargArray[BorderTopColor], MargArray[BorderRightColor], MargArray[BorderBottomColor]); if (BrdTop=1) and (BrdRight=1) and (BrdBottom=1) and (BrdLeft=1) and (Styles[0]=bssSolid) and (Styles[1]=bssSolid) and (Styles[2]=bssSolid) and (Styles[3]=bssSolid) and (Colors[1]=Colors[0]) and (Colors[2]=Colors[0]) and(Colors[3]=Colors[0]) then RaisedRectColor(Cell.MasterList, Canvas, X+CellSpacing, YO+CellSpacing, X+Wd-1, YO+Ht-1, Colors[0], Colors[0], False, 1) else DrawBorder(Canvas, Rect(BL, BT, BR, BB), Rect(PL, PT, PR, PB), Colors, Styles, MargArray[BackgroundColor], Cell.MasterList.Printing); end else if Border and (Cell.Count > 0) then if (Light = clBtnHighLight) and (Dark = clBtnShadow) then RaisedRect(Cell.MasterList, Canvas, X+CellSpacing, YO+CellSpacing, X+Wd-1, YO+Ht-1, False, 1) else RaisedRectColor(Cell.MasterList, Canvas, X+CellSpacing, YO+CellSpacing, X+Wd-1, YO+Ht-1, Light, Dark, False, 1); except end; end; {----------------TSectionBase.Create} constructor TSectionBase.Create(AMasterList: TSectionList); begin inherited Create; ParentSectionList := AMasterList; ContentTop := 999999999; {large number in case it has Display: none; } end; constructor TSectionBase.CreateCopy(AMasterList: TSectionList; T: TSectionBase); begin inherited Create; ParentSectionList := AMasterList; SectionHeight := T.SectionHeight; ZIndex := T.ZIndex; end; procedure TSectionBase.CopyToClipboard; begin end; function TSectionBase.GetYPosition: integer; begin Result := ContentTop; end; {----------------TSectionBase.DrawLogic} function TSectionBase.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; begin StartCurs := Curs; Result := SectionHeight; DrawHeight := SectionHeight; MaxWidth := 0; ContentTop := Y; DrawTop := Y; YDraw := Y; ContentBot := Y+SectionHeight; DrawBot := Y+DrawHeight; end; function TSectionBase.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; var Y: integer; begin Y := YDraw; Result := Y+SectionHeight; end; function TSectionBase.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; begin Result := []; end; function TSectionBase.PtInObject(X : integer; Y: integer; var Obj: TObject; var IX, IY: integer): boolean; begin Result := False; end; function TSectionBase.FindCursor(Canvas: TCanvas; X: integer; Y: integer; var XR: integer; var YR: integer; var CaretHt: integer; var Intext: boolean): integer; begin Result := -1; end; function TSectionBase.FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; begin Result := -1; end; function TSectionBase.FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; begin Result := -1; end; function TSectionBase.FindSourcePos(DocPos: integer): integer; begin Result := -1; end; function TSectionBase.FindDocPos(SourcePos: integer; Prev: boolean): integer; begin Result := -1; end; function TSectionBase.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer; var Y: integer): boolean; begin Result := False; end; function TSectionBase.GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; begin Result := False; end; procedure TSectionBase.SetParent(List: TSectionList); begin ParentSectionList := List; end; procedure TSectionBase.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); begin Min := 0; Max := 0; end; procedure TSectionBase.AddSectionsToList; begin ParentSectionList.PositionList.Add(Self); end; {----------------TCellList.Create} constructor TCellList.Create(Attr: TAttributeList; Prop: TProperties); var I: integer; Color: TColor; begin inherited Create; if Assigned(Attr) then for I := 0 to Attr.Count-1 do with TAttribute(Attr[I]) do case Which of BGColorSy: BkGnd := ColorFromString(Name, False, BkColor); BackgroundSy: BkImage := Name; HeightSy: if Pos('%', Name) = 0 then SpecRowHeight := Value else SpecRowHeightPercent := IntMax(0, IntMin(Value, 100)); end; if Assigned(Prop) then begin Color := Prop.GetBackgroundColor; if Color <> clNone then begin BkGnd := True; BkColor := Color; end; Prop.GetBackgroundImage(BkImage); {'none' will change string to empty} if BkImage <> '' then Prop.GetBackgroundPos(Prop.EmSize, Prop.ExSize, APRec); Prop.GetPageBreaks(BreakBefore, BreakAfter, KeepIntact); end; end; {----------------TCellList.CreateCopy} constructor TCellList.CreateCopy(AMasterList: TSectionList; T: TCellList); var I: integer; begin inherited create; BreakBefore := T.BreakBefore; BreakAfter := T.BreakAfter; KeepIntact := T.KeepIntact; RowType := T.Rowtype; for I := 0 to T.Count-1 do if Assigned(T.Items[I]) then Add(TCellObj.CreateCopy(AMasterList, TCellObj(T.Items[I]))) else Add(Nil); end; procedure TCellList.Add(CellObj: TCellObj); begin inherited Add(CellObj); if Assigned(CellObj) then begin BreakBefore := BreakBefore or CellObj.BreakBefore; BreakAfter := BreakAfter or CellObj.BreakAfter; KeepIntact := KeepIntact or CellObj.KeepIntact ; if SpecRowHeight > 0 then CellObj.SpecHt := IntMax(SpecRowHeight, CellObj.SpecHt) else if SpecRowHeightPercent > 0 then CellObj.SpecHtPercent := IntMax(SpecRowHeightPercent, CellObj.SpecHt); end; end; {----------------TCellList.InitializeRow} procedure TCellList.InitializeRow; var I: integer; begin if BkGnd then for I := 0 to Count-1 do with TCellObj(Items[I]).Cell do if not BkGnd then begin BkGnd := True; BkColor := Self.BkColor; end; end; {----------------TCellList.DrawLogic1} function TCellList.DrawLogic1(Canvas : TCanvas; const Widths : array of integer; Span, CellSpacing, AHeight, Rows: integer; var Desired: integer; var Spec, More: boolean): integer; {Find vertical size of each cell, Row height of this row. But final Y position is not known at this time. Rows is number rows in table. AHeight is for calculating percentage heights} var I, J, Dummy: integer; DummyCurs, GuessHt: integer; CellObj: TCellObj; begin Result := 0; Desired := 0; Spec := False; DummyCurs := 0; More := False; for I := 0 to Count-1 do begin CellObj := TCellObj(Items[I]); if Assigned(CellObj) then with CellObj do if ColSpan > 0 then {skip the dummy cells} begin Wd := 0; for J := I to ColSpan+I-1 do Inc(Wd, Widths[J]); {accumulate column widths} if Span = RowSpan then begin Dummy := 0; if SpecHt > 0 then GuessHt := SpecHt else if SpecHtPercent > 0 then GuessHt := MulDiv(SpecHtPercent, AHeight, 100) else if Rows = 1 then GuessHt := AHeight else GuessHt := 0; VSize := Cell.DoLogic(Canvas, 0, Wd-HzSpace-CellSpacing, IntMax(0, GuessHt-VrSpace), 0, Dummy, DummyCurs); Result := IntMax(Result, VSize + VrSpace); if SpecHt > 0 then begin Result := IntMax(Result, IntMax(VSize, SpecHt)); Spec := True; end else if SpecHtPercent > 0 then begin Desired := IntMax(Desired, GuessHt); Spec := True; end; end else if RowSpan > Span then More := True; end; end; Desired := IntMax(Result, Desired); end; {----------------TCellList.DrawLogic2} procedure TCellList.DrawLogic2(Canvas : TCanvas; Y: integer; CellSpacing: integer; var Curs: integer); {Calc Y indents. Set up Y positions of all cells.} var I: integer; CellObj: TCellObj; begin for I := 0 to Count-1 do begin CellObj := TCellObj(Items[I]); if Assigned(CellObj) then CellObj.DrawLogic2(Canvas, Y, CellSpacing, Curs); end; end; {----------------TCellList.Draw} function TCellList.Draw(Canvas: TCanvas; MasterList: TSectionList; const ARect: TRect; const Widths : array of integer; X: integer; Y, YOffset: integer; CellSpacing : integer; Border: boolean; Light, Dark: TColor; MyRow: integer) : integer; var I, Spacing: integer; YO: integer; CellObj: TCellObj; begin YO := Y - YOffset; Result := RowHeight+Y; Spacing := CellSpacing div 2; with MasterList do {check CSS page break properties} if Printing then if BreakBefore then begin if YO > ARect.Top then {page-break-before} begin if Y+Spacing < PageBottom then begin PageShortened := True; PageBottom := Y+Spacing; end; Exit; end; end else if KeepIntact then begin {Try to fit this RowSpan on a page by itself} if (YO > ARect.Top) and (Y+RowSpanHeight > PageBottom) and (RowSpanHeight < ARect.Bottom - ARect.Top) then begin if Y < PageBottom then begin PageShortened := True; PageBottom := Y; end; Exit; end else if (YO > ARect.Top) and (Y+RowHeight > PageBottom) and (RowHeight < ARect.Bottom - ARect.Top) then begin if Y+Spacing < PageBottom then begin PageShortened := True; PageBottom := Y+Spacing; end; Exit; end; end else if BreakAfter then if ARect.Top + YOff < Result then {page-break-after} if Result+Spacing < PageBottom then begin PageShortened := True; PageBottom := Result+Spacing; end; with MasterList do {avoid splitting any small rows} if Printing and (RowSpanHeight <= 100) and (Y + RowSpanHeight > PageBottom) then begin if Y < PageBottom then begin PageShortened := True; PageBottom := Y; end; Exit; end; if (YO+RowSpanHeight >= ARect.Top) and (YO < ARect.Bottom) and (not MasterList.Printing or (Y < MasterList.PageBottom)) then for I := 0 to Count-1 do begin CellObj := TCellObj(Items[I]); if Assigned(CellObj) then CellObj.Draw(Canvas, ARect, X, Y, CellSpacing, Border, Light, Dark); X := X + Widths[I]; end; end; {----------------ThtmlTable.Create} constructor ThtmlTable.Create(Master: TSectionList;Attr: TAttributeList; Prop: TProperties); var I: integer; BdrColor: TColor; begin inherited Create(Master); Rows := TFreeList.Create; CellPadding := 1; CellSpacing := 2; BorderColorLight := clBtnHighLight; BorderColorDark := clBtnShadow; for I := 0 to Attr.Count-1 do with TAttribute(Attr[I]) do case Which of BorderSy: if Name = '' then Border := 1 else Border := IntMin(100, IntMax(0, Value)); {Border=0 is no border} CellSpacingSy: if Value >= -1 then CellSpacing := IntMin(Value, 40); CellPaddingSy: if Value >= 0 then CellPadding := IntMin(Value, 50); BorderColorSy: if ColorFromString(Name, False, BdrColor) then begin BorderColorLight := BdrColor; BorderColorDark := BdrColor; end; BorderColorLightSy: ColorFromString(Name, False, BorderColorLight); BorderColorDarkSy: ColorFromString(Name, False, BorderColorDark); end; if Prop.Collapse then Cellspacing := -1; end; {----------------ThtmlTable.CreateCopy} constructor ThtmlTable.CreateCopy(AMasterList: TSectionList; T: TSectionBase); var I: integer; begin inherited CreateCopy(AMasterList, T); Rows := TFreeList.Create; for I := 0 to ThtmlTable(T).Rows.Count-1 do Rows.Add(TCellList.CreateCopy(AMasterList, TCellList(ThtmlTable(T).Rows.Items[I]))); Move((T as ThtmlTable).ListsProcessed, ListsProcessed, {$IFNDEF FPC} DWord(@EndList)-DWord(@ListsProcessed)); {$ELSE} PtrUInt(@EndList)-PtrUInt(@ListsProcessed)); {$ENDIF} SetLength(Widths, NumCols); SetLength(MaxWidths, NumCols); SetLength(MinWidths, NumCols); SetLength(Percents, NumCols); if AMasterList.PrintTableBackground then begin BkGnd := ThtmlTable(T).BkGnd; BkColor := ThtmlTable(T).BkColor; end else BkGnd := False; TablePartRec := TTablePartRec.Create; TablePartRec.TablePart := Normal; end; {----------------ThtmlTable.Destroy} destructor ThtmlTable.Destroy; begin Rows.Free; TablePartRec.Free; FreeAndNil(ColInfo); inherited Destroy; end; {----------------ThtmlTable.DoColumns} procedure ThtmlTable.DoColumns(Width: integer; AsPercent: boolean; VAlign: AlignmentType; const Align: string); {add the info to the ColInfo list} var Col: TColObj; begin Col := TColObj.Create; with Col do begin ColWidth := Width; ColAsPercent := AsPercent; colVAlign := VAlign; colAlign := Align; end; if not Assigned(colInfo) then colInfo := TFreeList.Create; ColInfo.Add(Col); end; {----------------ThtmlTable.AddDummyCells} procedure ThtmlTable.AddDummyCells; var Cl, Rw, K, RowCount: integer; AnyAbsolute: boolean; Row: TCellList; CellObj: TCellObj; SpanEq0: boolean; function DummyCell(RSpan: integer): TCellObj; begin Result := TCellObj.Create(ParentSectionList, ATop, Nil, Nil); Result.ColSpan := 0; Result.RowSpan := RSpan; end; Begin RowCount := Rows.Count; if not ListsProcessed then begin {put dummy cells in rows to make up for ColSpan > 1} NumCols := 0; AnyAbsolute := False; for Rw := 0 to RowCount-1 do begin with TCellList(Rows[Rw]) do begin InitializeRow; for Cl := Count-1 downto 0 do with TCellObj(Items[Cl]) do begin InitializeCell(CellPadding, BkImage, APRec, Self.Border > 0); if WidthAttr > 0 then begin if not AsPercent then AnyAbsolute := True; end; if Self.BkGnd and not Cell.BkGnd then {transfer bgcolor to cells if no Table image} begin Cell.BkGnd := True; Cell.BkColor := Self.BkColor; end; RowSpan := IntMin(RowSpan, RowCount-Rw); {So can't extend beyond table} for K := 1 to ColSpan-1 do if RowSpan > 1 then TCellList(Rows[Rw]).Insert(Cl+K, DummyCell(RowSpan)) {these could be Nil also except they're needed for expansion in the next section} else TCellList(Rows[Rw]).Insert(Cl+K, DummyCell(1)); end; end; NumCols := IntMax(NumCols, TCellList(Rows[Rw]).Count); {temporary # cols} end; {Absolute calc only if some absolute widths entered} UseAbsolute := AnyAbsolute; {put dummy cells in cols to make up for RowSpan > 1} for Cl := 0 to NumCols-1 do for Rw := 0 to RowCount-1 do with TCellList(Rows[Rw]) do if Count > Cl then if Assigned(Items[Cl]) then with TCellObj(Items[Cl]) do begin RowSpan := IntMin(RowSpan, RowCount-Rw); {practical limit} if RowSpan > 1 then for K := Rw+1 to Rw+RowSpan-1 do begin {insert dummy cells in following rows if RowSpan > 1} while TCellList(Rows[K]).Count < Cl do {add padding if row is short} TCellList(Rows[K]).Add(DummyCell(0)); TCellList(Rows[K]).Insert(Cl, DummyCell(0)); end; end; {look for excessive Colspans on last cells in each row. These would be dummy cells added above with Colspan = 0} if (RowCount > 0) and (NumCols > 0) then repeat SpanEq0 := True; {assume there are some} for Rw := 0 to RowCount-1 do with TCellList(Rows[Rw]) do if (Count = NumCols) and (TCellObj(Items[NumCols-1]).ColSpan <> 0) then SpanEq0 := False; {at least one last cell is not a dummy} if SpanEq0 then begin {trim off the dummy cells on end and fixup the Colspan value which was to blame} for Rw := 0 to RowCount-1 do with TCellList(Rows[Rw]) do if (Count = NumCols) and (TCellObj(Items[NumCols-1]).ColSpan = 0) then begin TCellObj(Items[NumCols-1]).Free; Delete(NumCols-1); {trim cell on end} K := NumCols-2; while K >= 0 do {find the Colspan value} begin if TCellObj(Items[K]).ColSpan > 1 then begin Dec(TCellObj(Items[K]).ColSpan); {fix it} Break; end; Dec(K); end; end; Dec(NumCols); end; until not SpanEq0; NumCols := 0; {find the number of columns} for Rw := 0 to RowCount-1 do begin NumCols := IntMax(NumCols, TCellList(Rows[Rw]).Count); end; {add the width info from the tags to the cells} if Assigned(colInfo) then begin AnyAbsolute := False; for Rw := 0 to RowCount-1 do begin Row := TCellList(Rows[Rw]); for Cl := 0 to IntMin(Row.Count-1, NumCols-1) do begin CellObj := TCellObj(Row[Cl]); with CellObj do begin if Cl < colInfo.Count then with TColObj(colInfo[Cl]) do begin if colWidth > 0 then begin WidthAttr := colWidth; AsPercent := colAsPercent; end; end; if not AsPercent then AnyAbsolute := True; end; end; end; UseAbsolute := AnyAbsolute; FreeAndNil(colInfo); {no longer needed} end; SetLength(Widths, NumCols); SetLength(MaxWidths, NumCols); SetLength(MinWidths, NumCols); SetLength(Percents, NumCols); ListsProcessed := True; end; {if not ListsProcessed} end; {----------------ThtmlTable.GetMinMaxAbs} procedure ThtmlTable.GetMinMaxAbs(Canvas: TCanvas; var TotalMinWidth, TotalMaxWidth: integer); var I, J, Min, Max, N, Span, Addon, D: integer; More: boolean; CellObj: TCellObj; Label Two; Begin for I := 0 to NumCols-1 do begin MaxWidths[I] := 0; MinWidths[I] := 0; end; SetLength(Heights, 0); Span := 1; More := True; while More do begin More := False; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do begin for I := 0 to Count-1 do if Assigned(Items[I]) then begin CellObj := TCellObj(Items[I]); with CellObj do begin More := More or (CellObj.ColSpan > Span); {set if need another iteration} if ColSpan = Span then begin Cell.MinMaxWidth(Canvas, Min, Max); Addon := CellSpacing + CellObj.HzSpace; Inc(Min, Addon); Inc(Max, Addon); if Span = 1 then begin if not AsPercent and (CellObj.WidthAttr > 0) then begin Max := IntMax(Min, WidthAttr+Addon); Min := Max; end; MinWidths[I] := Intmax(MinWidths[I], Min); MaxWidths[I] := Intmax(MaxWidths[I], Max); end else begin TotalMinWidth := 0; TotalMaxWidth := 0; for N := I to I+ColSpan-1 do begin {find the current totals for the span} Inc(TotalMaxWidth, MaxWidths[N]); Inc(TotalMinWidth, MinWidths[N]); end; if not AsPercent and (WidthAttr > 0) then begin Min := IntMax(Min, WidthAttr{+Cellspacing}); Max := IntMax(Min, WidthAttr{+Cellspacing}); end; if (TotalMinWidth < Min) then if TotalMinWidth > 0 then begin D := Min - TotalMinWidth; for N := I to I+ColSpan-1 do {increase the sub widths to match the span} MinWidths[N] := MinWidths[N]+MulDiv(MinWidths[N], D, TotalMinWidth); end else MinWidths[I] := Min; {this for multiple empty cols} if (TotalMaxWidth < Max) then if TotalMaxWidth > 0 then begin {increase the sub widths to match the span} D := Max - TotalMaxWidth; for N := I to I+ColSpan-1 do {increase the sub widths to match the span} MaxWidths[N] := MaxWidths[N]+MulDiv(MaxWidths[N], D, TotalMaxWidth); end else MaxWidths[I] := Max; end; end; end; end; end; Inc(Span); end; {Find the total min and max width} Two: TotalMaxWidth := 0; TotalMinWidth := 0; for I := 0 to NumCols-1 do begin Inc(TotalMaxWidth, MaxWidths[I]); Inc(TotalMinWidth, MinWidths[I]); end; end; {----------------ThtmlTable.GetWidthsAbs} procedure ThtmlTable.GetWidthsAbs(Canvas: TCanvas; TablWidth: integer; Specified: boolean); var N, D, W, dd, TotalMinWidth, TotalMaxWidth: integer; Accum: integer; Begin GetMinMaxAbs(Canvas, TotalMinWidth, TotalMaxWidth); if TotalMinWidth > TablWidth then {use the minimum column widths, table will expand} Widths := Copy(MinWidths) else if (TotalMaxWidth <= TablWidth) and not Specified then {use the max column widths, table will be smaller} Widths := Copy(MaxWidths) else {make table fit} begin D := TotalMaxWidth - TotalMinWidth; W := TablWidth - TotalMinWidth; if D > 0 then {expand only those columns with some slop in them} begin Accum := 0; for N := 0 to NumCols-1 do begin dd := MaxWidths[N] - MinWidths[N]; {some dd's may be 0} Widths[N] := MinWidths[N] + MulDiv(dd, W, D); Inc(Accum, Widths[N]); end; dd := Accum-TablWidth; {check for Roundoff error} if dd <> 0 then begin for N := 0 to NumCols-1 do begin if dd > 0 then begin if MaxWidths[N] > MinWidths[N] then begin Dec(Widths[N]); Dec(dd); end; end else begin Inc(Widths[N]); Inc(dd); end; if dd = 0 then break; end; end; end else {no adjustable columns, will have to expand them all} for N := 0 to NumCols-1 do Widths[N] := MinWidths[N] + MulDiv(MinWidths[N], W, TotalMinWidth); end; end; {----------------ThtmlTable.GetWidths} procedure ThtmlTable.GetWidths(Canvas: TCanvas; var TotalMinWidth, TotalMaxWidth: integer; TheWidth: integer); var I, J, Min, Max, N, Span, Addon, Distributable, TotalPC, Accum, ExcessMin, ExcessMax, NonPC, PCWidth, NewTotalPC: integer; More: boolean; begin {Find the max and min widths of each column} for I := 0 to NumCols-1 do begin MaxWidths[I] := 0; MinWidths[I] := 0; Percents[I] := 0; end; SetLength(Heights, 0); Span := 1; More := True; while More do begin More := False; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do begin for I := 0 to Count-1 do if Assigned(Items[I]) then with TCellObj(Items[I]) do begin PCWidth := 0; if WidthAttr > 0 then if AsPercent then PCWidth := WidthAttr else if TheWidth > 0 then PCWidth := IntMin(1000, MulDiv(WidthAttr, 1000, TheWidth)); More := More or (ColSpan > Span); {set if need another iteration} if ColSpan = Span then begin Cell.MinMaxWidth(Canvas, Min, Max); Addon := CellSpacing + HzSpace; Inc(Min, Addon); Inc(Max, Addon); if Span = 1 then begin MaxWidths[I] := IntMax(MaxWidths[I], Max); MinWidths[I] := IntMax(MinWidths[I], Min); Percents[I] := Intmax(Percents[I], PCWidth); {collect percents} end else begin TotalMaxWidth := 0; TotalMinWidth := 0; TotalPC := 0; NonPC := 0; for N := I to I+ColSpan-1 do begin {Total up the pertinant column widths} Inc(TotalMaxWidth, MaxWidths[N]); Inc(TotalMinWidth, MinWidths[N]); if Percents[N] > 0 then Inc(TotalPC, Percents[N]) {total percents} else Inc(NonPC); {count of cell with no percent} end; if Colspan = NumCols then begin TotalMinWidth := Intmax(TotalMinWidth, TheWidth); TotalMaxWidth := Intmax(TotalMaxWidth, TheWidth); end; ExcessMin := Min - TotalMinWidth; ExcessMax := Max - TotalMaxWidth; if (PCWidth > 0) or (TotalPC > 0) then begin {manipulate for percentages} if NonPC > 0 then {find the extra percentages to divvy up} Distributable := IntMax(0, (PCWidth-TotalPC) div NonPC) else Distributable := 0; if (NonPC = 0) and (PCWidth > TotalPC+1) then begin for N := I to I+ColSpan-1 do {stretch percentages to fit} Percents[N] := MulDiv(Percents[N], PCWidth, TotalPC); end else if Distributable > 0 then {spread colspan percentage excess over the unspecified cols} for N := I to I+ColSpan-1 do if Percents[N] = 0 then Percents[N] := Distributable; NewTotalPC := IntMax(TotalPC, PCWidth); if ExcessMin > 0 then begin if (NonPC > 0) and (TotalMaxWidth > 0) then {split excess over all cells} begin {proportion the distribution so cells with large MaxWidth get more} for N := I to I+ColSpan-1 do Inc(MinWidths[N], MulDiv(ExcessMin, MaxWidths[N], TotalMaxWidth)); end else for N := I to I+ColSpan-1 do Inc(MinWidths[N], (MulDiv(ExcessMin, Percents[N], NewTotalPC))); end; if ExcessMax > 0 then for N := I to I+ColSpan-1 do Inc(MaxWidths[N], (MulDiv(ExcessMax, Percents[N], NewTotalPC))); end else begin {no width dimensions entered} if ExcessMin > 0 then begin Accum := 0; for N := I to I+ColSpan-1 do begin if TotalMinWidth = 0 then MinWidths[N] := Min div ColSpan else {split up the widths in proportion to widths already there} MinWidths[N] := MulDiv(Min, MinWidths[N], TotalMinWidth); Inc(Accum, MinWidths[N]); end; if Accum < Min then {might be a roundoff pixel or two left over} Inc(MinWidths[I], Min-Accum); end; if ExcessMax > 0 then begin Accum := 0; for N := I to I+ColSpan-1 do begin if TotalMaxWidth = 0 then MaxWidths[N] := Max div ColSpan else {split up the widths in proportion to widths already there} MaxWidths[N] := MulDiv(Max, MaxWidths[N], TotalMaxWidth); Inc(Accum, MaxWidths[N]); end; if Accum < Max then {might be a roundoff pixel or two left over} Inc(MaxWidths[I], Max-Accum); end; end; end; end; end; end; Inc(Span); end; TotalMaxWidth := 0; TotalMinWidth := 0; for I := 0 to NumCols-1 do begin Inc(TotalMaxWidth, MaxWidths[I]); Inc(TotalMinWidth, MinWidths[I]); end; end; {----------------ThtmlTable.MinMaxWidth} procedure ThtmlTable.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); begin AddDummyCells; {in case it hasn't been done} if UseAbsolute and (tblWidthAttr = 0) then GetMinMaxAbs(Canvas, Min, Max) else GetWidths(Canvas, Min, Max, tblWidthAttr); Inc(Min, CellSpacing); Inc(Max, CellSpacing); Min := IntMax(Min, tblWidthAttr); Max := IntMax(Max, tblWidthAttr); end; procedure ThtmlTable.TableSpecifiedAndWillFit(TheWidth: integer); {Divide up the table into columns. TheWidth is the specified width of the table. At this point, it is known that everything will fit into TheWidth. Percents are being used} var I, W, PCNotMinWid, TotalWid, Unsp, UnspDiff, Delta, Addon, Count, d: integer; UseMin: array of boolean; NoChange: boolean; UnspCol: Integer; begin if NumCols = 0 then Exit; SetLength(UseMin, NumCols); for I := 0 to NumCols-1 do UseMin[I] := False; PCNotMinWid := 0; TotalWid := 0; Unsp := 0; UnspDiff := 0; UnspCol := -1; {First calculate everything assuming the data entered is perfectly correct} for I := 0 to NumCols - 1 do begin if Percents[I] > 0 then begin W := MulDiv(TheWidth, Percents[I], 1000); {width based on percentage} if W > MinWidths[I] then begin Widths[I] := W; Inc(PCNotMinWid, Percents[I]); end else begin {percent is too small, use Min width} Widths[I] := MinWidths[I]; UseMin[I] := True; end; end else begin {no percent} Widths[I] := MinWidths[I]; Inc(Unsp); {an unspecified column} UnspCol := I; {save location of unspedified column} Inc(UnspDiff, IntMax(0, MaxWidths[I]-MinWidths[I])); {total max-min for unspecified cols} end; Inc(TotalWid, Widths[I]); end; Delta := TotalWid - TheWidth; {see what the error is} if Delta < 0 then {table is too small} begin if Unsp > 0 then begin if (UnspDiff > 0) and (UnspDiff >= Abs(Delta) div 4) then {increase the unspecified columns widths prop to Max, Min unless the difference is trivial} begin for I := 0 to NumCols-1 do if (Percents[I] = 0) then Inc(Widths[I], MulDiv(-Delta, IntMax(0, MaxWidths[I] - MinWidths[I]), UnspDiff)); end else begin {increase the unspecified columns widths uniformly} Addon := -Delta div Unsp; for I := 0 to NumCols - 1 do if (Percents[I] = 0) then Inc(Widths[I], Addon); end; end else begin {no unspecified widths, increase the specified columns which are not minimum} for I := 0 to NumCols - 1 do if (Percents[I] > 0) and not UseMin[I] then Inc(Widths[I], MulDiv(-Delta, Percents[I], PCNotMinWid)); end; end else if Delta > 0 then {calculated table is too large} begin Count := 0; {make one or more trial run to see what happens when shrinking the columns that can be shrunck. May hit another MinWidth situation} repeat NoChange := True; for I := 0 to NumCols - 1 do if (Percents[I] > 0) and not UseMin[I] then begin W := Widths[I] - MulDiv(Delta, Percents[I], PCNotMinWid); if W < MinWidths[I] then begin {new width is smaller than MinWidth, make adustments} UseMin[I] := True; NoChange := False; Dec(PCNotMinWid, Percents[I]); Dec(Delta, Widths[I]-MinWidths[I]); Widths[I] := MinWidths[I]; end; end; Inc(Count); until NoChange or (Count >= 4); {count guards against endless loop} for I := 0 to NumCols - 1 do {now actually change the widths} if (Percents[I] > 0) and not UseMin[I] then Dec(Widths[I], MulDiv(Delta, Percents[I], PCNotMinWid)); end; TotalWid := 0; {fix up any round off errors} for I := 0 to NumCols - 1 do Inc(TotalWid, Widths[I]); Delta := TotalWid-TheWidth; {round off error} if Delta > 0 then begin for I := 0 to NumCols-1 do if not UseMin[I] then begin Dec(Widths[I], Delta); {remove extra from first non minimum} Break; end; end else if Length(Widths) > 0 then if UnspCol >= 0 then Inc(Widths[UnspCol], -Delta) {put it into an unspecified column} else begin Delta := -Delta; {Delta is now positive} While Delta > NumCols do begin d := Delta div NumCols; if d > 0 then for I := 0 to NumCols - 1 do begin Dec(Delta, d); Inc(Widths[I], d); end end; {remainder should be less than NumCols here, so tack on 1 each column until it's gone} for I := 0 to NumCols-1 do if Delta > 0 then begin Inc(Widths[I]); Dec(Delta); end else Break; end; end; {----------------ThtmlTable.TableNotSpecifiedAndWillFit} procedure ThtmlTable.TableNotSpecifiedAndWillFit(TotalMinWidth, TotalMaxWidth, TheWidth: integer); {Find column widths. Table known to fit within allowed space and its width hasn't been specified} var D, W, DS, MaxDS, MaxI, I, Addon, Total, TotalPC, Residual, NewResidual, W1, W2, NewTotal, LastNewTotal: integer; HasPercents, UsesPercents, Done: boolean; begin if NumCols = 0 then Exit; TotalPC := 0; {see if any percentage widths entered} for I := 0 to NumCols-1 do Inc(TotalPC, Percents[I]); UsesPercents := (TotalPc > 0) and (TotalPc <= 1000) {ignore ridiculous values} or (tblWidthAttr > 0); if UsesPercents then begin {find the largest width that will accomodate the %'s} Residual := 0; W1 := 0; for I := 0 to NumCols-1 do if Percents[I] > 0 then {a percent has been entered} W1 := IntMax(W1, MulDiv(MaxWidths[I], 1000, Percents[I])) {look for maximum} else Inc(Residual, MaxWidths[I]); {accumlate the cols which have no percent} if TotalPC < 1000 then W2 := MulDiv(Residual, 1000, 1000-TotalPC) else if Residual > 0 then W2 := 30000 else W2 := 0; Total := IntMax(W1, W2); if Total <= TheWidth then begin {a fit is found using percents and maxwidths} if tblWidthAttr > 0 then Total := TheWidth; {don't try to make it smaller than TheWidth} NewResidual := MulDiv(Total, 1000-TotalPC, 1000); for I := 0 to NumCols-1 do if Percents[I] > 0 then {figure widths to fit this situation} Widths[I] := MulDiv(Total, Percents[I], 1000) else if Residual > 0 then Widths[I] := MulDiv(MaxWidths[I], NewResidual, Residual) else Widths[I] := 0; {this is an table syntax error condition} Exit; end; Done := False; LastNewTotal := $FFFFFFF; repeat {with the above possibilites taken care of, we can assume the final width will = NewWidth} HasPercents := False; Total := 0; Residual := 0; for I := 0 to NumCols-1 do begin if Percents[I] > 0 then begin W := MulDiv(TheWidth, Percents[I], 1000); {a Percent's width based on TheWidth} if W < MinWidths[I] then {but it must be > MinWidth} begin {eliminate the percentage value as not achievable} Percents[I] := 0; Inc(Residual, MinWidths[I]); {and put it in the residuals} end else begin HasPercents := True; {still valid percents} Inc(Total, W); end; end else Inc(Residual, MinWidths[I]); end; if not HasPercents then Break; {no percents are achievable} if Total+Residual <= TheWidth then begin {a solution with at least some percentages can be found} Done := True; TotalMaxWidth := 0; TotalMinWidth := 0; {recalc these} for I := 0 to NumCols-1 do begin if Percents[I] > 0 then begin MinWidths[I] := MulDiv(TheWidth, Percents[I], 1000); MaxWidths[I] := MinWidths[I]; {this fixes the width thru later calculations} end; Inc(TotalMaxWidth, MaxWidths[I]); Inc(TotalMinWidth, MinWidths[I]); end; end else {it doesn't fit screen, reduce percentages and try again} begin NewTotal := TheWidth-Residual; {percent items must fit this} while LastNewTotal <= NewTotal do Dec(NewTotal); LastNewTotal := NewTotal; for I := 0 to NumCols-1 do if Percents[I] > 0 then Percents[I] := MulDiv(Percents[I], NewTotal, Total); end; until Done; end; D := TotalMaxWidth - TotalMinWidth; MaxI := 0; Total := 0; W := TheWidth - TotalMinWidth; if (D = 0) and (NumCols > 0) then begin Addon := W div NumCols; for I := 0 to NumCols-1 do begin Widths[I] := MinWidths[I] + Addon; Inc(Total, Widths[I]); end; end else begin MaxDS := 0; for I := 0 to NumCols-1 do begin ds := MaxWidths[I] - MinWidths[I]; Widths[I] := MinWidths[I] + MulDiv(ds, W, D); Inc(Total, Widths[I]); if ds > MaxDS then begin MaxDS := ds; MaxI := I; end end; end; if Total <> TheWidth then {a round off error} Inc(Widths[MaxI], TheWidth-Total); {adjust column with largest variation} end; {----------------ThtmlTable.FindRowHeights} procedure ThtmlTable.FindRowHeights(Canvas: TCanvas; AHeight: integer); var I, J, K, H, Span, TotalMinHt, TotalDesHt, AddOn, Sum, AddedOn, Desired, UnSpec: integer; More, Mr, IsSpeced: boolean; MinHts, DesiredHts: IntArray; SpecHts: array of boolean; F: double; begin if Rows.Count = 0 then Exit; Dec(AHeight, CellSpacing); {calculated heights will include one cellspacing each, this removes that last odd cellspacing} if Length(Heights) = 0 then SetLength(Heights, Rows.Count); SetLength(DesiredHts, Rows.Count); SetLength(MinHts, Rows.Count); SetLength(SpecHts, Rows.Count); for I := 0 to Rows.Count-1 do begin Heights[I] := 0; DesiredHts[I] := 0; MinHts[I] := 0; SpecHts[I] := False; end; {Find the height of each row allowing for RowSpans} Span := 1; More := True; while More do begin More := False; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do begin if J+Span > Rows.Count then Break; {otherwise will overlap} H := DrawLogic1(Canvas, Widths, Span, CellSpacing, IntMax(0,AHeight-Rows.Count*CellSpacing), Rows.Count, Desired, IsSpeced, Mr) + CellSpacing; Inc(Desired, Cellspacing); More := More or Mr; if Span = 1 then begin MinHts[J] := H; DesiredHts[J] := Desired; SpecHts[J] := SpecHts[J] or IsSpeced; end else if H > Cellspacing then {if H=Cellspacing then no rowspan for this span} begin TotalMinHt := 0; {sum up the heights so far for the rows involved} TotalDesHt := 0; for K := J to J+Span-1 do begin Inc(TotalMinHt, MinHts[K]); Inc(TotalDesHt, DesiredHts[K]); SpecHts[K] := SpecHts[K] or IsSpeced; end; if H > TotalMinHt then {apportion the excess over the rows} begin Addon := ((H-TotalMinHt) div Span); AddedOn := 0; for K := J to J+Span-1 do begin Inc(MinHts[K], Addon); Inc(AddedOn, Addon); end; Inc(MinHts[J+Span-1], (H-TotalMinHt)-AddedOn); {make up for round off error} end; if Desired > TotalDesHt then {apportion the excess over the rows} begin Addon := ((Desired-TotalDesHt) div Span); AddedOn := 0; for K := J to J+Span-1 do begin Inc(DesiredHts[K], Addon); Inc(AddedOn, Addon); end; Inc(DesiredHts[J+Span-1], (Desired-TotalDesHt)-AddedOn); {make up for round off error} end; end; end; Inc(Span); end; TotalMinHt := 0; TotalDesHt := 0; UnSpec := 0; for I := 0 to Rows.Count-1 do begin Inc(TotalMinHt, MinHts[I]); Inc(TotalDesHt, DesiredHts[I]); if not SpecHts[I] then Inc(UnSpec); end; if TotalMinHt >= AHeight then Heights := Copy(MinHts) else if TotalDesHt < AHeight then if UnSpec > 0 then begin {expand the unspeced rows to fit} Heights := Copy(DesiredHts); Addon := (AHeight-TotalDesHt) div UnSpec; Sum := 0; for I := 0 to Rows.Count-1 do if not SpecHts[I] then begin Dec(UnSpec); if UnSpec > 0 then begin Inc(Heights[I], AddOn); Inc(Sum, Addon); end else begin {last item, complete everything} Inc(Heights[I], AHeight-TotalDesHt-Sum); Break; end; end; end else begin {expand desired hts to fit} Sum := 0; F := AHeight/TotalDesHt; for I := 0 to Rows.Count-2 do begin Heights[I] := Round(F * DesiredHts[I]); Inc(Sum, Heights[I]); end; Heights[Rows.Count-1] := AHeight - Sum; {last row is the difference} end else begin Sum := 0; F := (AHeight-TotalMinHt)/(TotalDesHt-TotalMinHt); for I := 0 to Rows.Count-2 do begin Heights[I] := MinHts[I] + Round(F*(DesiredHts[I]-MinHts[I])); Inc(Sum, Heights[I]); end; Heights[Rows.Count-1] := AHeight - Sum; end; end; {----------------ThtmlTable.DrawLogic} function ThtmlTable.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; var I, J, K, TotalMaxWidth, TotalMinWidth: integer; NewWidth: integer; OwnerWidth: integer; Specified: boolean; TopY: integer; FirstLinePtr: PInteger; CellObj: TCellObj; HasBody: Boolean; Begin Inc(ParentSectionList.TableNestLevel); Inc(NLevel); try YDraw := Y; TopY := Y; ContentTop := Y; DrawTop := Y; StartCurs := Curs; If Assigned(ParentSectionList.FirstLineHtPtr) and {used for List items} (ParentSectionList.FirstLineHtPtr^ = 0) then FirstLinePtr := ParentSectionList.FirstLineHtPtr {save for later} else FirstLinePtr := Nil; OwnerWidth := IMgr.RightSide(Y) - IMgr.LeftIndent(Y); if tblWidthAttr > 0 then begin Specified := True; NewWidth := tblWidthAttr; end else begin Specified := False; NewWidth := OwnerWidth; end; Dec(NewWidth, (CellSpacing)); AddDummyCells; {Figure the width of each column} if UseAbsolute and not Specified then begin {Table width not specified and at least one column has absolute width specified} GetWidthsAbs(Canvas, NewWidth, Specified); {fills in the Widths array} end else begin GetWidths(Canvas, TotalMinWidth, TotalMaxWidth, NewWidth); if (TotalMinWidth >= NewWidth) then begin {table won't fit, use minimun widths} if Assigned(MinWidths) then {Delphi 4 needs this check} Widths := Copy(MinWidths); end else if Specified then begin TableSpecifiedAndWillFit(NewWidth); end else TableNotSpecifiedAndWillFit(TotalMinWidth, TotalMaxWidth, NewWidth); end; {Find Table Width} TableWidth := CellSpacing; for I := 0 to NumCols-1 do Inc(TableWidth, Widths[I]); if (Length(Heights) = 0) then FindRowHeights(Canvas, AHeight) else if ParentSectionList.InLogic2 and (ParentSectionList.TableNestLevel <= 5) then FindRowHeights(Canvas, AHeight); SectionHeight := 0; HeaderHeight := 0; HeaderRowCount := 0; FootHeight := 0; FootStartRow := -1; HasBody := False; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do begin RowHeight := Heights[J]; if RowType = THead then begin Inc(HeaderRowCount); Inc(HeaderHeight, RowHeight); end else if RowType = TFoot then begin if FootStartRow = -1 then begin FootStartRow := J; FootOffset := SectionHeight; end; Inc (FootHeight, RowHeight); end else if Rowtype = TBody then HasBody := True; RowSpanHeight := 0; Inc(SectionHeight, Heights[J]); for I := 0 to Count-1 do if Assigned(Items[I]) then begin CellObj := TCellObj(Items[I]); with CellObj do begin {find the actual height, Ht, of each cell} Ht := 0; for K := J to IntMin(J+RowSpan-1, Rows.Count-1) do Inc(Ht, Heights[K]); if RowSpanHeight < Ht then RowSpanHeight := Ht; end; end; {DrawLogic2 is only called in nested tables if the outer table is calling DrawLogic2} if ParentSectionList.TableNestLevel = 1 then ParentSectionList.InLogic2 := True; try if ParentSectionList.InLogic2 then DrawLogic2(Canvas, Y, CellSpacing, Curs); finally if ParentSectionList.TableNestLevel = 1 then ParentSectionList.InLogic2 := False; end; Inc(Y, RowHeight); end; HeadOrFoot := ((HeaderHeight > 0) or (FootHeight > 0)) and HasBody; Inc(SectionHeight, CellSpacing); TableHeight := SectionHeight; Len := Curs-StartCurs; MaxWidth := TableWidth; Result := SectionHeight; DrawHeight := Result; ContentBot := TopY+SectionHeight; DrawBot := TopY+DrawHeight; try If Assigned(FirstLinePtr) then FirstLinePtr^ := YDraw+SectionHeight; except end; finally Dec(ParentSectionList.TableNestLevel); Dec(NLevel); end; end; {----------------ThtmlTable.Draw} function ThtmlTable.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; var YO, YOffset, Y: integer; begin Inc(ParentSectionList.TableNestLevel); Y := YDraw; Result := Y+SectionHeight; if Float then Y := Y + VSpace; YOffset := ParentSectionList.YOff; YO := Y - YOffset; if (YO+DrawHeight >= ARect.Top) and (YO < ARect.Bottom) or ParentSectionList.Printing then if ParentSectionList.Printing and (ParentSectionList.TableNestLevel = 1) and HeadOrFoot and (Y < ParentSectionList.PageBottom) and ((ParentSectionList.PrintingTable = Nil) or (ParentSectionList.PrintingTable = Self)) then DrawTableP(Canvas, ARect, IMgr, X, Y) else DrawTable(Canvas, ARect, IMgr, X, Y); Dec(ParentSectionList.TableNestLevel); end; procedure ThtmlTable.DrawTable(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X: integer; Y: integer); var I, XX: integer; YY, YOffset: integer; begin YOffset := ParentSectionList.YOff; XX := X+Indent; {for the table} YY := Y; DrawX := XX; DrawY := YY; for I := 0 to Rows.Count-1 do YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); end; procedure ThtmlTable.DrawTableP(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X: integer; Y: integer); {Printing table with thead and/or tfoot} var I, XX, TopBorder, BottomBorder: integer; YY, YOffset: integer; SavePageBottom: Integer; Spacing, HeightNeeded: Integer; begin YOffset := ParentSectionList.YOff; XX := X+Indent; {for the table} YY := Y; DrawX := XX; DrawY := YY; if TTableBlock(MyBlock).TableBorder then begin TopBorder := Border; BottomBorder := Border; end else begin TopBorder := MyBlock.MargArray[BorderTopWidth]; BottomBorder := MyBlock.MargArray[BorderBottomWidth]; end; case TablePartRec.TablePart of {.$Region 'Normal'} Normal: begin ParentSectionList.PrintingTable := Self; if ParentSectionList.PageBottom-Y >= TableHeight+BottomBorder then begin for I := 0 to Rows.Count-1 do {do whole table now} YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); ParentSectionList.PrintingTable := Nil; end else begin {see if enough room on this page for header, 1 row, footer} if HeadOrFoot then begin Spacing := CellSpacing div 2; HeightNeeded := HeaderHeight+FootHeight+ TCellList(Rows.Items[HeaderRowCount]).RowHeight; if (Y - YOffset > ARect.Top) and (Y+HeightNeeded > ParentSectionList.PageBottom) and (HeightNeeded < ARect.Bottom - ARect.Top) then begin {not enough room, start table on next page} if Y+Spacing < ParentSectionList.PageBottom then begin ParentSectionList.PageShortened := True; ParentSectionList.PageBottom := Y+Spacing; end; exit; end; end; {start table. it will not be complete and will go to next page} SavePageBottom := ParentSectionList.PageBottom; ParentSectionList.PageBottom := SavePageBottom - FootHeight-Cellspacing-BottomBorder-5; {a little to spare} for I := 0 to Rows.Count-1 do {do part of table} YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); BodyBreak := ParentSectionList.PageBottom; if FootStartRow >= 0 then begin TablePartRec.TablePart := DoFoot; TablePartRec.PartStart := Y + FootOffset; TablePartRec.PartHeight := FootHeight + IntMax(2*Cellspacing, Cellspacing+1) + BottomBorder; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end else if HeaderHeight > 0 then begin {will do header next} //ParentSectionList.PageBottom := SavePageBottom; TablePartRec.TablePart := DoHead; TablePartRec.PartStart := DrawY-TopBorder; TablePartRec.PartHeight := HeaderHeight+TopBorder; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; end; {.$EndRegion} {.$Region 'DoBody1'} DoBody1: begin if ParentSectionList.PageBottom > Y+TableHeight+BottomBorder then begin {can complete table now} for I := 0 to Rows.Count-1 do {do remainder of table now} YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); ThtmlViewer(ParentSectionList.TheOwner).TablePartRec.TablePart := Normal; end else begin {will do part of the table now} {Leave room for foot later} ParentSectionList.PageBottom := ParentSectionList.PageBottom -FootHeight+IntMax(Cellspacing, 1)-BottomBorder; for I := 0 to Rows.Count-1 do YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); BodyBreak := ParentSectionList.PageBottom; if FootStartRow >= 0 then begin TablePartRec.TablePart := DoFoot; TablePartRec.PartStart := Y + FootOffset; TablePartRec.PartHeight := FootHeight + IntMax(2*Cellspacing, Cellspacing+1) + BottomBorder;//FootHeight+IntMax(CellSpacing, 1); ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end else if HeaderHeight > 0 then begin TablePartRec.TablePart := DoHead; TablePartRec.PartStart := DrawY-TopBorder; TablePartRec.PartHeight := HeaderHeight+TopBorder; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; end; {.$EndRegion} {.$Region 'DoBody2'} DoBody2: begin if ParentSectionList.PageBottom > Y+TableHeight+BottomBorder then begin for I := 0 to Rows.Count-1 do {do remainder of table now} YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); ThtmlViewer(ParentSectionList.TheOwner).TablePartRec.TablePart := Normal; ParentSectionList.PrintingTable := Nil; end else begin SavePageBottom := ParentSectionList.PageBottom; for I := 0 to Rows.Count-1 do {do part of table} YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); BodyBreak := ParentSectionList.PageBottom; if FootStartRow >= 0 then begin TablePartRec.TablePart := DoFoot; TablePartRec.PartStart := Y + FootOffset; TablePartRec.PartHeight := FootHeight + IntMax(2*Cellspacing, Cellspacing+1) + BottomBorder;//FootHeight+IntMax(CellSpacing, 1); ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end else if HeaderHeight > 0 then begin ParentSectionList.PageBottom := SavePageBottom; TablePartRec.TablePart := DoHead; TablePartRec.PartStart := DrawY-TopBorder; TablePartRec.PartHeight := HeaderHeight+TopBorder; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; end; {.$EndRegion} {.$Region 'DoFoot'} DoFoot: begin YY := TablePartRec.PartStart; if FootStartRow >= 0 then for I := FootStartRow to Rows.Count-1 do YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); if HeaderHeight > 0 then begin TablePartRec.TablePart := DoHead; TablePartRec.PartStart := DrawY-TopBorder; TablePartRec.PartHeight := HeaderHeight+TopBorder; end else begin {No THead} TablePartRec.TablePart := DoBody3; TablePartRec.PartStart := BodyBreak-1; TablePartRec.FootHeight := FootHeight+IntMax(Cellspacing, 1); end; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; {.$EndRegion} {.$Region 'DoHead'} DoHead: begin for I := 0 to HeaderRowCount-1 do YY := TCellList(Rows.Items[I]).Draw(Canvas, ParentSectionList, ARect, Widths, XX, YY, YOffset, CellSpacing, Border > 0, BorderColorLight, BorderColorDark, I); TablePartRec.TablePart := DoBody1; TablePartRec.PartStart := BodyBreak-1; TablePartRec.FootHeight := FootHeight+IntMax(Cellspacing, 1)+BottomBorder; ThtmlViewer(ParentSectionList.TheOwner).TablePartRec := TablePartRec; end; {.$$EndRegion} end; end; {----------------ThtmlTable.GetURL} function ThtmlTable.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; var TableOK: boolean; function GetTableURL(X: integer; Y: integer): guResultType; var I, J, XX: integer; CellObj: TCellObj; begin for J := 0 to Rows.Count-1 do begin XX := DrawX; with TCellList(Rows[J]) do begin for I := 0 to Count-1 do begin CellObj := TCellObj(Items[I]); if Assigned(CellObj) then with CellObj do begin if (X >=XX) and (X < XX+Wd) and (Y >= Cell.DrawYY) and (Y < Cell.DrawYY+Ht) then begin Result := Cell.GetUrl(Canvas, X, Y, UrlTarg, FormControl, ATitle); Exit; end; end; Inc(XX, Widths[I]); end; end; end; Result := []; end; begin Result := []; if (Y >= ContentTop) and (Y < ContentBot) then begin TableOK := (X >= DrawX) and (X <= TableWidth+DrawX); if TableOK then Result := GetTableURL(X, Y); end; end; {----------------ThtmlTable.PtInObject} function ThtmlTable.PtInObject(X : integer; Y: integer; var Obj: TObject; var IX, IY: integer): boolean; var TableOK: boolean; function GetTableObj(X: integer; Y: integer): boolean; var I, J, XX: integer; begin for J := 0 to Rows.Count-1 do begin XX := DrawX; with TCellList(Rows[J]) do begin for I := 0 to Count-1 do begin if Assigned(Items[I]) then with TCellObj(Items[I]) do begin if (X >=XX) and (X < XX+Wd) and (Y >= Cell.DrawYY) and (Y < Cell.DrawYY+Ht) then begin Result := Cell.PtInObject(X, Y, Obj, IX, IY); Exit; end; end; Inc(XX, Widths[I]); end; end; end; Result := False; end; begin Result := False; if (Y >= ContentTop) and (Y < ContentBot) then begin TableOK := (X >= DrawX) and (X <= TableWidth+DrawX); if TableOK then Result := GetTableObj(X, Y); end; end; {----------------ThtmlTable.FindCursor} function ThtmlTable.FindCursor(Canvas: TCanvas; X: integer; Y: integer; var XR: integer; var YR: integer; var CaretHt: integer; var Intext: boolean): integer; var TableOK: boolean; function GetTableCursor(X: integer; Y: integer; var XR: integer; var YR: integer; var CaretHt: integer; var Intext: boolean): integer; var I, J, XX: integer; begin for J := 0 to Rows.Count-1 do begin XX := DrawX; with TCellList(Rows[J]) do begin for I := 0 to Count-1 do begin if Assigned(Items[I]) then with TCellObj(Items[I]) do begin if (X >=XX) and (X < XX+Wd) and (Y >= Cell.DrawYY) and (Y < Cell.DrawYY+Ht) then begin Result := Cell.FindCursor(Canvas, X, Y, XR, YR, CaretHt, InText); if Result >= 0 then Exit; end; end; Inc(XX, Widths[I]); end; end; end; Result := -1; end; begin Result := -1; if ( Y >= ContentTop) and (Y < ContentBot) then begin TableOK := (X >= DrawX) and (X <= TableWidth+DrawX); if TableOK then Result := GetTableCursor(X, Y, XR, YR, CaretHt, InText); end; end; {----------------ThtmlTable.CursorToXY} function ThtmlTable.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer; var Y: integer): boolean; {note: returned X value is not correct here but it isn't used} var I, J: integer; begin Result := False; if (Len = 0) or (Cursor > StartCurs + Len) then Exit; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do for I := 0 to Count-1 do if Assigned(Items[I]) then with TCellObj(Items[I]) do begin Result := Cell.CursorToXy(Canvas, Cursor, X, Y); if Result then Exit; end; end; {----------------ThtmlTable.GetChAtPos} function ThtmlTable.GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; var I, J: integer; begin Result := False; if (Len = 0) or (Pos < StartCurs) or (Pos > StartCurs + Len) then Exit; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do for I := 0 to Count-1 do if Assigned(Items[I]) then with TCellObj(Items[I]) do begin Result := Cell.GetChAtPos(Pos, Ch, Obj); if Result then Exit; end; end; {----------------ThtmlTable.FindString} function ThtmlTable.FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; var I, J: integer; begin Result := -1; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do for I := 0 to Count-1 do if Assigned(Items[I]) then with TCellObj(Items[I]) do begin Result := Cell.FindString(From, ToFind, MatchCase); if Result >= 0 then Exit; end; end; {----------------ThtmlTable.FindStringR} function ThtmlTable.FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; var I, J: integer; begin Result := -1; for J := Rows.Count-1 downto 0 do with TCellList(Rows[J]) do for I := Count-1 downto 0 do if Assigned(Items[I]) then with TCellObj(Items[I]) do begin Result := Cell.FindStringR(From, ToFind, MatchCase); if Result >= 0 then Exit; end; end; {----------------ThtmlTable.FindSourcePos} function ThtmlTable.FindSourcePos(DocPos: integer): integer; var I, J: integer; begin Result := -1; for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do for I := 0 to Count-1 do if Assigned(Items[I]) then with TCellObj(Items[I]) do begin Result := Cell.FindSourcePos(DocPos); if Result >= 0 then Exit; end; end; {----------------ThtmlTable.FindDocPos} function ThtmlTable.FindDocPos(SourcePos: integer; Prev: boolean): integer; var I, J: integer; TC: TCellObj; begin Result := -1; if not Prev then begin for J := 0 to Rows.Count-1 do if Assigned(Rows.Items[J]) then with TCellList(Rows[J]) do for I := 0 to Count-1 do begin TC := TCellObj(Items[I]); if Assigned(TC) then begin Result := TC.Cell.FindDocPos(SourcePos, Prev); if Result >= 0 then Exit; end; end; end else {Prev , iterate in reverse} begin for J := Rows.Count-1 downto 0 do with TCellList(Rows[J]) do for I := Count-1 downto 0 do if Assigned(Items[I]) then begin TC := TCellObj(Items[I]); if Assigned(TC) then begin Result := TC.Cell.FindDocPos(SourcePos, Prev); if Result >= 0 then Exit; end; end; end; end; {----------------ThtmlTable.CopyToClipboard} procedure ThtmlTable.CopyToClipboard; var I, J: integer; begin for J := 0 to Rows.Count-1 do with TCellList(Rows[J]) do for I := 0 to Count-1 do if Assigned(Items[I]) then with TCellObj(Items[I]) do Cell.CopyToClipboard; end; {----------------TSection.Create} constructor TSection.Create(AMasterList: TSectionList; L: TAttributeList; Prop: TProperties; AnURL: TUrlTarget; ACell: TCellBasic; FirstItem: boolean); var FO : TFontObj; T: TAttribute; S: string; Clr: ClearAttrType; Percent: boolean; begin inherited Create(AMasterList); Buff := PWideChar(BuffS); Len := 0; BuffSize := 0; Fonts := TFontList.Create; FO := TFontObj.Create(Self, Prop.GetFont, 0); FO.Title := Prop.PropTitle; if Assigned(AnURL) and (Length(AnURL.Url) > 0) then begin FO.CreateFIArray; Prop.GetFontInfo(FO.FIArray); FO.ConvertFont(FO.FIArray.Ar[LFont]); FO.UrlTarget.Copy(AnUrl); ParentSectionList.LinkList.Add(FO); {$ifndef NoTabLink} if not AMasterList.StopTab then FO.CreateTabControl(AnUrl.TabIndex); {$endif} end; Fonts.Add(FO); LineHeight := Prop.GetLineHeight(Abs(FO.TheFont.Height)); if FirstItem then begin FirstLineIndent := Prop.GetTextIndent(Percent); if Percent then FLPercent := IntMin(FirstLineIndent, 90); end; Images := TImageObjList.Create; FormControls := TFormControlList.Create; if Assigned(L) then begin if L.Find(ClearSy, T) then begin S := LowerCase(T.Name); if (S = 'left') then ClearAttr := clLeft else if (S = 'right') then ClearAttr := clRight else ClearAttr := clAll; end; if L.TheID <> '' then ParentSectionList.IDNameList.AddObject(L.TheID, Self); end; if Prop.GetClear(Clr) then ClearAttr := Clr; Lines := TFreeList.Create; if Prop.Props[TextAlign] = 'right' then Justify := Right else if Prop.Props[TextAlign] = 'center' then Justify := Centered else if Prop.Props[TextAlign] = 'justify' then Justify := FullJustify else Justify := Left; BreakWord := Prop.Props[WordWrap] = 'break-word'; end; {----------------TSection.CreateCopy} constructor TSection.CreateCopy(AMasterList: TSectionList; T: TSectionBase); var TT: TSection; I: integer; begin inherited CreateCopy(AMasterList, T); TT := T as TSection; Len := TT.Len; BuffSize := TT.BuffSize; BuffS := TT.BuffS; SetLength(BuffS, Length(BuffS)); Buff := PWideChar(BuffS); Brk := TT.Brk; Fonts := TFontList.CreateCopy(Self, TT.Fonts); Images := TImageObjList.CreateCopy(AMasterList, TT.Images); FormControls := TFormControlList.Create; for I := 0 to TT.FormControls.Count-1 do FormControls.Add(TT.FormControls[I]); Lines := TFreeList.Create; Justify := TT.Justify; ClearAttr := TT.ClearAttr; LineHeight := TT.LineHeight; FirstLineIndent := TT.FirstLineIndent; FLPercent := TT.FLPercent; BreakWord := TT.BreakWord; end; {----------------TSection.Destroy} destructor TSection.Destroy; begin if Assigned(XP) then Freemem(XP); Fonts.Free; Images.Free; FormControls.Free; SIndexList.Free; Lines.Free; inherited Destroy; end; procedure TSection.CheckFree; var I, J: integer; begin if not Assigned(Self) then Exit; if Assigned(ParentSectionList) then begin {Check to see that there isn't a TFontObj in LinkList} if Assigned(ParentSectionList.LinkList) then for I := 0 to Fonts.Count-1 do begin J := ParentSectionList.LinkList.IndexOf(Fonts[I]); if J >=0 then ParentSectionList.LinkList.Delete(J); end; {Remove Self from IDNameList if there} if Assigned(ParentSectionList.IDNameList) then with ParentSectionList.IDNameList do begin I := IndexOfObject(Self); if I > -1 then Delete(I); end; end; end; {----------------TSection.AddChar} procedure TSection.AddChar(C: WideChar; Index: integer); var Tok: TokenObj; begin Tok := TokenObj.Create; Tok.AddUnicodeChar(C, Index); AddTokenObj(Tok); Tok.Free; end; function TSection.GetIndexObj(I: integer): IndexObj; begin Result := SIndexList[I]; end; procedure TSection.AddOpBrk; begin if Brk <> '' then Brk[Length(Brk)] := 'a'; end; {----------------TSection.AddTokenObj} procedure TSection.AddTokenObj(T : TokenObj); var L, I : integer; C: char; St, StU: WideString; Small: boolean; begin if T.Leng = 0 then Exit; L := Len+T.Leng; if BuffSize < L+3 then Allocate(L + 500); {L+3 to permit additions later} case PropStack.Last.GetTextTransform of txUpper: St := WideUpperCase1(T.S); txLower: St := WideLowerCase1(T.S); else St := T.S; end; Move(T.I[1], XP^[Len], T.Leng*Sizeof(integer)); if NoBreak or (Self is TPreformated) then C := 'n' else C := 'y'; for I := 1 to T.Leng do Brk := Brk+C; if PropStack.Last.GetFontVariant = 'small-caps' then begin StU := WideUpperCase1(St); BuffS := BuffS+StU; Small := False; for I := 1 to Length(St) do begin if not (St[I] in [WideChar(' '), WideChar('0')..WideChar('9')]) then {no font changes for these chars} begin if not Small then begin if StU[I] <> St[I] then begin {St[I] was lower case} PushNewProp('small', '', '', '', '', Nil); {change to smaller font} ChangeFont(PropStack.Last); Small := True; end; end else if StU[I] = St[I] then begin {St[I] was uppercase and Small is set} PopAProp('small'); ChangeFont(PropStack.Last); Small := False; end; end; Inc(Len); end; if Small then {change back to regular font} begin PopAProp('small'); ChangeFont(PropStack.Last); end; end else begin BuffS := BuffS+St; Len := L; end; Buff := PWideChar(BuffS); end; {----------------TSection.ProcessText} Procedure TSection.ProcessText(TagIndex: integer); const Shy = #173; {soft hyphen} var I: integer; FO: TFontObj; Procedure Remove(I: integer); begin Move(XP^[I], XP^[I-1], ((Length(BuffS))-I)*Sizeof(integer)); System.Delete(BuffS, I, 1); System.Delete(Brk, I, 1); TFormControlList(FormControls).Decrement(I-1); TFontList(Fonts).Decrement(I-1, ParentSectionList); TImageObjList(Images).Decrement(I-1); end; begin while (Length(BuffS) > 0) and (BuffS[1] = ' ') do Remove(1); I := WidePos(Shy, BuffS); while I > 0 do begin Remove(I); if (I > 1) and (Brk[I-1] <> 'n') then Brk[I-1] := 's'; I := WidePos(Shy, BuffS); end; I := WidePos(' ', BuffS); while I > 0 do begin if Brk[I] = 'n' then Remove(I) else Remove(I + 1); I := WidePos(' ', BuffS); end; {After floating images at start, delete an annoying space} for I := Length(BuffS)-1 downto 1 do if (BuffS[I] = ImgPan) and (Images.FindImage(I-1).ObjAlign in [ALeft, ARight]) and (BuffS[I+1] = ' ') then Remove(I+1); I := WidePos(WideString(' '+#8), BuffS); {#8 is break char} while I > 0 do begin Remove(I); I := WidePos(WideString(' '+#8), BuffS); end; I := WidePos(WideString(#8+' '), BuffS); while I > 0 do begin Remove(I+1); I := WidePos(WideString(#8+' '), BuffS); end; if (Length(BuffS) > 1) and (BuffS[Length(BuffS)] = #8) then Remove(Length(BuffS)); if (Length(BuffS) > 1) and (BuffS[Length(BuffS)] = ' ') then Remove(Length(BuffS)); if (BuffS <> #8) and (Length(BuffS) > 0) and (BuffS[Length(BuffS)] <> ' ') then Begin FO := TFontObj(Fonts.Items[Fonts.Count-1]); {keep font the same for inserted space} if FO.Pos = Length(BuffS) then Inc(FO.Pos); BuffS := BuffS+' '; XP^[Length(BuffS)-1] := TagIndex; end; Finish; end; {----------------TSection.Finish} procedure TSection.Finish; {complete some things after all information added} var Last, I: integer; IO: IndexObj; begin Buff := PWideChar(BuffS); Len := Length(BuffS); if Len > 0 then begin Brk := Brk+'y'; if Assigned(XP) then {XP = Nil when printing} begin Last := 0; {to prevent warning msg} SIndexList := TFreeList.Create; for I := 0 to Len-1 do begin if (I = 0) or (XP^[I] <> Last+1) then begin IO := IndexObj.Create; IO.Pos := I; IO.Index := XP^[I]; SIndexList.Add(IO); end; Last := XP^[I]; end; FreeMem(XP); XP := Nil; end; end; if Len > 0 then begin Inc(ParentSectionList.SectionCount); SectionNumber := ParentSectionList.SectionCount; end; end; {----------------TSection.Allocate} procedure TSection.Allocate(N : integer); begin if BuffSize < N then begin ReAllocMem(XP, N*Sizeof(integer)); BuffSize := N; end; end; {----------------TSection.ChangeFont} procedure TSection.ChangeFont(Prop: TProperties); var FO: TFontObj; LastUrl: TUrlTarget; NewFont: TMyFont; Align: AlignmentType; begin FO := TFontObj(Fonts[Fonts.Count-1]); LastUrl := FO.UrlTarget; NewFont := Prop.GetFont; If FO.Pos = Len then FO.ReplaceFont(NewFont) {fontobj already at this position, modify it} else begin FO := TFontObj.Create(Self, NewFont, Len); FO.URLTarget.Copy(LastUrl); Fonts.Add(FO); end; FO.Title := Prop.PropTitle; if LastUrl.Url <> '' then begin FO.CreateFIArray; Prop.GetFontInfo(FO.FIArray); FO.ConvertFont(FO.FIArray.Ar[LFont]); if ParentSectionList.LinkList.IndexOf(FO) = -1 then ParentSectionList.LinkList.Add(FO); end; if Prop.GetVertAlign(Align) and (Align in [ASub, ASuper]) then FO.SScript := Align else FO.SScript := ANone; end; {----------------------TSection.HRef} procedure TSection.HRef(Sy: Symb; List: TSectionList; AnURL: TUrlTarget; Attributes: TAttributeList; Prop: TProperties); var FO: TFontObj; NewFont: TMyFont; Align: AlignmentType; begin FO := TFontObj(Fonts[Fonts.Count-1]); NewFont := Prop.GetFont; If FO.Pos = Len then FO.ReplaceFont(NewFont) {fontobj already at this position, modify it} else begin FO := TFontObj.Create(Self, NewFont, Len); Fonts.Add(FO); end; if Sy = HRefSy then begin FO.CreateFIArray; Prop.GetFontInfo(FO.FIArray); FO.ConvertFont(FO.FIArray.Ar[LFont]); if ParentSectionList.LinkList.IndexOf(FO) = -1 then ParentSectionList.LinkList.Add(FO); {$ifndef NoTabLink} if not ParentSectionList.StopTab then FO.CreateTabControl(AnUrl.TabIndex); {$endif} end else if Assigned(FO.FIArray) then begin FO.FIArray.Free; FO.FIArray := Nil; end; FO.UrlTarget.Copy(AnUrl); if Prop.GetVertAlign(Align) and (Align in [ASub, ASuper]) then FO.SScript := Align else FO.SScript := ANone; end; function TSection.AddImage(L: TAttributeList; ACell: TCellBasic; Index: integer): TImageObj; begin Result := TImageObj.Create(ParentSectionList, Len, L); Result.MyCell := ACell; Images.Add(Result); AddChar(ImgPan, Index); {marker for image} end; function TSection.AddPanel(L: TAttributeList; ACell: TCellBasic; Index: integer): TPanelObj; begin Result := TPanelObj.Create(ParentSectionList, Len, L, ACell, False); Images.Add(Result); AddChar(ImgPan, Index); {marker for panel} end; function TSection.CreatePanel(L: TAttributeList; ACell: TCellBasic): TPanelObj; {Used by object tag} begin Result := TPanelObj.Create(ParentSectionList, Len, L, ACell, True); end; procedure TSection.AddPanel1(PO: TPanelObj; Index: integer); {Used for Object Tag} begin Images.Add(PO); AddChar(ImgPan, Index); {marker for panel} end; {----------------TSection.AddFormControl} function TSection.AddFormControl(Which: Symb; AMasterList: TSectionList; L: TAttributeList; ACell: TCellBasic; Index: integer; Prop: TProperties): TFormControlObj; var T: TAttribute; FCO: TFormControlObj; S: string[20]; IO: TImageObj; ButtonControl: TButtonFormControlObj; procedure GetEditFCO; begin FCO := TEditFormControlObj.Create(AMasterList, Len, L, S, Prop); end; begin S := ''; if Which = InputSy then begin if L.Find(TypeSy, T) then begin S := LowerCase(T.Name); if (S = 'text') or (S = 'password') or (S = 'file') then GetEditFCO else if (S = 'submit') or (S = 'reset') or (S = 'button') then FCO := TButtonFormControlObj.Create(AMasterList, Len, L, S, Prop) else if S = 'radio' then FCO := TRadioButtonFormControlObj.Create(AMasterList, Len, L, ACell) else if S = 'checkbox' then FCO := TCheckBoxFormControlObj.Create(AMasterList, Len, L, Prop) else if S = 'hidden' then FCO := THiddenFormControlObj.Create(AMasterList, Len, L) else if S = 'image' then FCO := TImageFormControlObj.Create(AMasterList, Len, L) else GetEditFCO; end else GetEditFCO; end else if Which = SelectSy then begin if L.Find(MultipleSy, T) or L.Find(SizeSy, T) and (T.Value > 1) then FCO := TListBoxFormControlObj.Create(AMasterList, Len, L, Prop) else FCO := TComboFormControlObj.Create(AMasterList, Len, L, Prop); end else FCO := TTextAreaFormControlObj.Create(AMasterList, Len, L, Prop); if S = 'image' then begin IO := AddImage(L, ACell, Index); {leave out of FormControlList} IO.MyFormControl := TImageFormControlObj(FCO); TImageFormControlObj(FCO).MyImage := IO; end else if S = 'file' then begin FormControls.Add(FCO); AddChar(FmCtl, Index); {marker for FormControl} Brk[Len] := 'n'; {don't allow break between these two controls} ButtonControl := TButtonFormControlObj.Create(AMasterList, Len, L, S, Prop); ButtonControl.MyEdit := TEditFormControlObj(FCO); FormControls.Add(ButtonControl); {the following fixup puts the ID on the TEdit and deletes it from the Button} if L.TheID <> '' then ParentSectionList.IDNameList.AddObject(L.TheID, FCO); FCO.Value := ''; {value attribute should not show in TEdit} ThtEdit(FCO.TheControl).Text := ''; AddChar(FmCtl, Index); Brk[Len] := 'n'; end else if S <> 'hidden' then begin FormControls.Add(FCO); AddChar(FmCtl, Index); {marker for FormControl} end; if Prop.GetBorderStyle <> bssNone then {start of inline border} ParentSectionList.ProcessInlines(Index, Prop, True); Result := FCO; end; {----------------TSection.FindCountThatFits} function TSection.FindCountThatFits(Canvas: TCanvas; Width: integer; Start: PWideChar; Max: integer): integer; {Given a width, find the count of chars (<= Max) which will fit allowing for font changes. Line wrapping will be done later} var Cnt, XX, I, J, J1, J2, J3, OHang, Tmp : integer; Picture: boolean; Align: AlignmentType; HSpcL, HSpcR: integer; FLObj: TFloatingObj; Extent: integer; const OldStart: PWideChar = nil; OldResult: integer = 0; OldWidth: integer = 0; begin if (Width = OldWidth) and (Start = OldStart) then begin Result := OldResult; Exit; end; OldStart := Start; OldWidth := Width; Cnt := 0; XX := 0; while True do begin Fonts.GetFontAt(Start-Buff, OHang).AssignToCanvas(Canvas); J1 := Fonts.GetFontCountAt(Start-Buff, Len); J2 := Images.GetImageCountAt(Start-Buff); J3 := TFormControlList(FormControls).GetControlCountAt(Start-Buff); if J2 = 0 then begin Tmp:= Images.GetWidthAt(Start-Buff, Align, HSpcL, HSpcR, FlObj); if not (Align in [ALeft, ARight]) then XX := XX + Tmp + HSpcL + HSpcR; I := 1; J := 1; Picture := True; if XX > Width then break; end else if J3 = 0 then begin XX := XX + TFormControlList(FormControls).GetWidthAt(Start-Buff, HSpcL, HSpcR); XX := XX + HSpcL + HSpcR; I := 1; J := 1; Picture := True; if XX > Width then break; end else begin Picture := False; J := IntMin(J1, J2); J := IntMin(J, J3); I := FitText(Canvas.Handle, Start, J, Width-XX, Extent); end; if Cnt+I >= Max then {I has been initialized} begin Cnt := Max; Break; end else Inc(Cnt, I); if not Picture then begin if (I < J) or (I = 0) then Break; XX := XX + Extent; end; Inc(Start, I); end; Result := Cnt; OldResult := Result; end; {----------------TSection.FindCountThatFits1} function TSection.FindCountThatFits1(Canvas: TCanvas; Start: PWideChar; Max: integer; X, Y: integer; IMgr: IndentManager; var ImgHt: integer; NxImages: TList) : integer; {Given a width, find the count of chars (<= Max) which will fit allowing for font changes. Line wrapping will be done later} var Cnt, XX, I, J, J1, J2, J3, X1, X2, OHang, ImgWidth, Width : integer; Picture: boolean; Align: AlignmentType; ImageAtStart: boolean; FlObj: TFloatingObj; HSpcL, HSpcR: integer; BrChr, TheStart: PWideChar; Font, LastFont: TMyFont; SaveX: integer; FoundBreak: boolean; HyphenWidth: Integer; begin LastFont := Nil; TheStart := Start; ImageAtStart := True; ImgHt := 0; BrChr := StrScanW(TheStart, BrkCh); {see if a break char} if Assigned(BrChr) and (BrChr-TheStart < Max) then begin Max := BrChr-TheStart; if Max = 0 then begin Result := 1; Exit; {single character fits} end; FoundBreak := True; end else FoundBreak := False; Cnt := 0; X1 := Imgr.LeftIndent(Y); if Start = Buff then Inc(X1, FirstLineIndent); X2 := IMgr.RightSide(Y); Width := X2-X1; if (Start = Buff) and (Images.Count = 0) and (FormControls.Count = 0) then if Max * TFontObj(Fonts[0]).tmMaxCharWidth <= Width then {try a shortcut} begin {it will all fit} Result := Max; if FoundBreak then Inc(Result); Exit; end; XX := 0; while True do begin Font := Fonts.GetFontAt(Start-Buff, OHang); if Font <> LastFont then {may not have to load font} begin Font.AssignToCanvas(Canvas); end; LastFont := Font; J1 := IntMin(Fonts.GetFontCountAt(Start-Buff, Len), Max-Cnt); J2 := Images.GetImageCountAt(Start-Buff); J3 := TFormControlList(FormControls).GetControlCountAt(Start-Buff); if J2 = 0 then begin {next is an image} I := 1; J := 1; Picture := True; ImgWidth := Images.GetWidthAt(Start-Buff, Align, HSpcL, HSpcR, FlObj); if Align in [ALeft, ARight] then begin FlObj.DrawYY := Y; {approx y position} if ImageAtStart then begin Inc(XX, ImgWidth + FlObj.HSpaceL + FlObj.HSpaceR); if XX <= Width then {it fits} begin IMgr.Update(Y, FlObj); ImgHt := IntMax(ImgHt, FlObj.ImageHeight + FlObj.VSpaceT + FlObj.VSpaceB); end else if Cnt > 0 then Break {One or more do fit, this one doesn't} else begin {first image doesn't fit} if IMgr.GetNextWiderY(Y) > Y then Break; {wider area below, it might fit there} {Can't move it down, might as well put it here} IMgr.Update(Y, FlObj); ImgHt := IntMax(ImgHt, FlObj.ImageHeight + FlObj.VSpaceT + FlObj.VSpaceB); Cnt := 1; Break; end; end else NxImages.Add(FlObj); {save it for the next line} end else begin Inc(XX, ImgWidth+HSpcL+HSpcR); ImageAtStart := False; end; if XX > Width then break; end else if J3 = 0 then begin XX := XX + TFormControlList(FormControls).GetWidthAt(Start-Buff, HSpcL, HSpcR); XX := XX + HSpcL + HSpcR; I := 1; J := 1; Picture := True; ImageAtStart := False; if XX > Width then break; end else begin Picture := False; J := IntMin(J1, J2); J := IntMin(J, J3); I := FitText(Canvas.Handle, Start, J, Width-XX, SaveX); if (I > 0) and (Brk[TheStart-Buff+Cnt+I] = 's') then begin {a hyphen could go here} HyphenWidth := Canvas.TextWidth('-'); if XX + SaveX + HyphenWidth > Width then Dec(I); end; end; if Cnt+I >= Max then begin Cnt := Max; Break; end else Inc(Cnt, I); if not Picture then {it's a text block} begin if I < J then Break; XX := XX + SaveX; ImageAtStart := False; end; Inc(Start, I); end; Result := Cnt; if FoundBreak and (Cnt = Max) then Inc(Result); end; function WrapChar(C: WideChar): boolean; begin Result := Ord(C) >= $3000; end; {----------------TSection.MinMaxWidth} procedure TSection.MinMaxWidth(Canvas: TCanvas; var Min, Max: integer); {Min is the width the section would occupy when wrapped as tightly as possible. Max, the width if no wrapping were used.} var I, Indx, FloatMin: integer; P, P1: PWideChar; Obj: TObject; SoftHyphen: Boolean; function FindTextWidthB(Canvas: TCanvas; Start: PWideChar; N: integer; RemoveSpaces: boolean): integer; begin Result := FindTextWidth(Canvas, Start, N, RemoveSpaces); if (Start = Buff) then if (FLPercent = 0) then {not a percent} Inc(Result, FirstLineIndent) else Result := (100 * Result) div (100 - FLPercent); if SoftHyphen then Result := Result + Canvas.TextWidth('-'); end; begin if (StoredMin > 0) and (Images.Count = 0) then begin Min := StoredMin; Max := StoredMax; Exit; end; Min := 0; Max := 0; if Len = 0 then Exit; for I := 0 to Images.Count-1 do {call drawlogic for all the images} begin Obj := Images[I]; with TFloatingObj(Obj) do begin DrawLogic(Self.ParentSectionList, Canvas, Fonts.GetFontObjAt(Pos, Indx), 0, 0); if not PercentWidth then if ObjAlign in [ALeft, ARight] then begin Max := Max + ImageWidth + HSpaceL + HSpaceR; Brk[Pos+1] := 'y'; {allow break after floating image} end else Min := IntMax(Min, ImageWidth); end; end; FloatMin := Max; for I := 0 to FormControls.Count-1 do {get Min for form controls} begin Obj := FormControls[I]; if Obj is TFormControlObj then with TFormControlObj(FormControls[I]) do if not PercentWidth then Min := IntMax(Min, FControl.Width + HSpaceL + HSpaceR); end; Max := 0; P := Buff; P1 := StrScanW(P, BrkCh); {look for break char} while Assigned(P1) do begin Max := IntMax(Max, FindTextWidthB(Canvas, P, P1-P, False)); P:= P1+1; P1 := StrScanW(P, BrkCh); end; P1 := StrScanW(P, #0); {look for the end} Max := IntMax(Max, FindTextWidthB(Canvas, P, P1-P, True)) + FloatMin; P := Buff; if not BreakWord then begin while P^ = ' ' do Inc(P); P1 := P; I := P1-Buff+1; while P^ <> #0 do {find the next string of chars that can't be wrapped} begin if WrapChar(P1^) and (Brk[I]='y') then begin Inc(P1); Inc(I); end else begin repeat begin Inc(P1); Inc(I); end; until (P1^=#0) or ((((P1^ in [WideChar(' '), WideChar('-'), WideChar('?'), ImgPan, FmCtl, BrkCh]) or WrapChar(P1^)) and (Brk[I]='y')) or (Brk[I-1] in ['a', 's'])); SoftHyphen := Brk[I-1] = 's'; if P1^ in [WideChar('-'), WideChar('?')] then begin Inc(P1); Inc(I); end; end; Min := IntMax(Min, FindTextWidthB(Canvas, P, P1-P, True)); while (P1^ in [WideChar(' '), ImgPan, FmCtl, BrkCh]) do begin Inc(P1); Inc(I); end; P := P1; end; end else while P^ <> #0 do begin Min := IntMax(Min, FindTextWidthB(Canvas, P, 1, True)); Inc(P); end; Min := IntMax(FloatMin, Min); StoredMin := Min; StoredMax := Max; end; {----------------TSection.FindTextWidth} function TSection.FindTextWidth(Canvas: TCanvas; Start: PWideChar; N: integer; RemoveSpaces: boolean): integer; {find actual line width of N chars starting at Start. If RemoveSpaces set, don't count spaces on right end} var I, J, J1, OHang, Wid, HSpcL, HSpcR: integer; Align: AlignmentType; FlObj: TFloatingObj; begin Result := 0; if RemoveSpaces then while ((Start + N - 1)^ in [WideChar(' '), BrkCh]) do Dec(N); {remove spaces on end} while N > 0 do begin J := Images.GetImageCountAt(Start-Buff); J1 := TFormControlList(FormControls).GetControlCountAt(Start-Buff); if J = 0 then {it's and image} begin Wid := Images.GetWidthAt(Start-Buff, Align, HSpcL, HSpcR, FlObj); {Here we count floating images as 1 char but do not include their width, This is required for the call in FindCursor} if not (Align in [ALeft, ARight]) then begin Result := Result + Wid + HSpcL + HSpcR; end; Dec(N); {image counts as one char} Inc(Start); end else if J1 = 0 then begin Result := Result + TFormControlList(FormControls).GetWidthAt(Start-Buff, HSpcL, HSpcR); Result := Result + HSpcL + HSpcR; Dec(N); {control counts as one char} Inc(Start); end else begin Fonts.GetFontAt(Start-Buff, OHang).AssignToCanvas(Canvas); I := IntMin(J, J1); I := IntMin(I, IntMin(Fonts.GetFontCountAt(Start-Buff, Len), N)); Assert(I > 0, 'I less than or = 0 in FindTextWidth'); Inc(Result, GetXExtent(Canvas.Handle, Start, I) + OHang); if I = 0 then Break; Dec(N, I); Inc(Start, I); end; end; end; {----------------TSection.FindTextWidthA} function TSection.FindTextWidthA(Canvas: TCanvas; Start: PWideChar; N: integer): integer; {find actual line width of N chars starting at Start.} var I, J, J1, OHang, Wid, HSpcL, HSpcR: integer; Align: AlignmentType; FlObj: TFloatingObj; Font: TMyFont; begin Result := 0; while N > 0 do begin J := Images.GetImageCountAt(Start-Buff); J1 := TFormControlList(FormControls).GetControlCountAt(Start-Buff); if J = 0 then {it's an image} begin Wid := Images.GetWidthAt(Start-Buff, Align, HSpcL, HSpcR, FlObj); {Here we count floating images as 1 char but do not include their width, This is required for the call in FindCursor} if not (Align in [ALeft, ARight]) then begin Result := Result + Wid + HSpcL + HSpcR; end; Dec(N); {image counts as one char} Inc(Start); end else if J1 = 0 then begin Result := Result + TFormControlList(FormControls).GetWidthAt(Start-Buff, HSpcL, HSpcR); Result := Result + HSpcL + HSpcR; Dec(N); {control counts as one char} Inc(Start); end else begin Font := Fonts.GetFontAt(Start-Buff, OHang); Font.AssignToCanvas(Canvas); I := IntMin(J, J1); I := IntMin(I, IntMin(Fonts.GetFontCountAt(Start-Buff, Len), N)); Inc(Result, GetXExtent(Canvas.Handle, Start, I) - OHang); if I = 0 then Break; Dec(N, I); Inc(Start, I); end; end; end; {----------------TSection.DrawLogic} function TSection.DrawLogic(Canvas : TCanvas; X, Y, XRef, YRef, AWidth, AHeight, BlHt: integer; IMgr: IndentManager; var MaxWidth: integer; var Curs: integer): integer; {returns height of the section} var PStart, P, Last: PWideChar; Max, N, NN, Width, I, Indx, ImgHt: integer; Finished: boolean; LR : LineRec; NxImages: TList; Tmp, Tmp1: integer; Obj: TFloatingObj; TopY, AccumImgBot, HtRef: integer; function GetClearSpace(ClearAttr: ClearAttrType): integer; var CL, CR: integer; begin Result := 0; if (ClearAttr <> clrNone) then begin {may need to move down past floating image} IMgr.GetClearY(CL, CR); case ClearAttr of clLeft: Result := IntMax(0, CL-Y-1); clRight: Result := IntMax(0, CR-Y-1); clAll: Result := IntMax(CL-Y-1, IntMax(0, CR-Y-1)); end; end; end; procedure LineComplete(NN : integer); var I, J, DHt, Desc, Tmp, TmpRt, Cnt, Index, H, SB, SA : integer; FO : TFontObj; Align: AlignmentType; FormAlign: AlignmentType; NoChar: boolean; P: PWideChar; FCO: TFormControlObj; FlObj: TFloatingObj; TextWidth: Integer; OHang: Integer; function FindSpaces: integer; var I: integer; begin Result := 0; for I := 0 to NN-2 do {-2 so as not to count end spaces} if ((PStart+I)^ = ' ') or ((PStart+I)^ = #160) then Inc(Result); end; begin DHt := 0; {for the fonts on this line get the maximum height} Cnt := 0; Desc := 0; P := PStart; if (NN = 1) and (P^ = BrkCh) then NoChar := False else begin NoChar := True; for I := 0 to NN-1 do begin if (not (P^ in [FmCtl, ImgPan, BrkCh])) {ignore images and space on end} and (not ((P = Last) and (Last^ = ' '))) then begin {check for the no character case} NoChar := False; Break; end; Inc(P); end; end; if not NoChar then repeat FO := Fonts.GetFontObjAt(PStart-Buff+Cnt, Index); Tmp := FO.GetHeight(Desc); DHt := IntMax(DHt, Tmp); LR.Descent := IntMax(LR.Descent, Desc); J := Fonts.GetFontCountAt(PStart-Buff+Cnt, Len); Inc(Cnt, J); until Cnt >= NN; SB := 0; {if there are images, then maybe they add extra space} SA := 0; {space before and after} if LineHeight >= 0 then begin SB := (LineHeight-DHt) div 2; SA := (LineHeight-DHt) - SB; end; Cnt := 0; repeat Cnt := Cnt + Images.GetImageCountAt(PStart-Buff+Cnt); if Cnt < NN then begin H := Images.GetHeightAt(PStart-Buff+Cnt, Align, FlObj); FlObj.DrawYY := Y; {approx y dimension} if (FLObj is TImageObj) and Assigned(TImageObj(FLObj).MyFormControl) then TImageObj(FLObj).MyFormControl.FYValue := Y; case Align of ATop: SA := IntMax(SA, H - DHt); AMiddle: begin if DHt = 0 then begin DHt := Fonts.GetFontObjAt(PStart-Buff, Index).GetHeight(Desc); LR.Descent := Desc; end; Tmp := (H - DHt) div 2; SA := IntMax(SA, Tmp); SB := IntMax(SB, (H - DHt - Tmp)); end; ABottom, ABaseline: SB := IntMax(SB, H - (DHt - LR.Descent)); end; end; Inc(Cnt); {to skip by the image} until Cnt >= NN; Cnt := 0; {now check on form controls} repeat Cnt := Cnt + TFormControlList(FormControls).GetControlCountAt(PStart-Buff+Cnt); if Cnt < NN then begin FCO := TFormControlList(FormControls).FindControl(PStart-Buff+Cnt); H := TFormControlList(FormControls).GetHeightAt(PStart-Buff+Cnt, FormAlign); case FormAlign of ATop: SA := IntMax(SA, H+FCO.VSpaceB+FCO.VSpaceT-Dht); AMiddle: begin Tmp := (H - DHt) div 2; SA := IntMax(SA, Tmp+FCO.VSpaceB); SB := IntMax(SB, (H - DHt - Tmp+FCO.VSpaceT)); end; ABaseline: SB := IntMax(SB, H+FCO.VSpaceT+FCO.VSpaceB-(DHt-LR.Descent)); ABottom: SB := IntMax(SB, H+FCO.VSpaceT+FCO.VSpaceB-DHt); end; if Assigned(FCO) and not ParentSectionList.IsCopy then FCO.FYValue := Y; end; Inc(Cnt); {to skip by the control} until Cnt >= NN; {$ifndef NoTabLink} if not ParentSectionList.IsCopy then begin Cnt := 0; {now check URLs} repeat FO := Fonts.GetFontObjAt(PStart-Buff+Cnt, Index); FO.AssignY(Y); Cnt := Cnt + Fonts.GetFontCountAt(PStart-Buff+Cnt, Len); until Cnt >= NN; end; {$endif} LR.Start := PStart; LR.LineHt := DHt; LR.Ln := NN; if Brk[PStart-Buff+NN] = 's' then {see if there is a soft hyphen on the end} LR.Shy := True; TmpRt := IMgr.RightSide(Y); Tmp := IMgr.LeftIndent(Y); if PStart = Buff then Tmp := Tmp + FirstLineIndent; if Justify = Left then LR.LineIndent := Tmp-X else begin TextWidth:= FindTextWidth(Canvas, PStart, NN, True); if LR.Shy then begin {take into account the width of the hyphen} Fonts.GetFontAt(PStart-Buff+NN-1, OHang).AssignToCanvas(Canvas); Inc(TextWidth, Canvas.TextWidth('-')); end; if Justify = Centered then LR.LineIndent := (TmpRt + Tmp - TextWidth) div 2 -X else if Justify = Right then LR.LineIndent := TmpRt - X - TextWidth else begin {Justify = FullJustify} LR.LineIndent := Tmp-X; if not Finished then begin LR.Extra := TmpRt - Tmp - TextWidth; LR.Spaces := FindSpaces; end; end; end; LR.DrawWidth := TmpRt-Tmp; LR.SpaceBefore := LR.SpaceBefore + SB; LR.SpaceAfter := SA; Lines.Add(LR); Inc(PStart, NN); SectionHeight := SectionHeight +DHt + SA + LR.SpaceBefore; Tmp := DHt +SA + SB; Inc(Y, Tmp); LR.LineImgHt := IntMax(Tmp, ImgHt); for I := 0 to NxImages.Count-1 do begin IMgr.Update(Y, TFloatingObj(NxImages[I])); {update Image manager and Image} {include images in Line height} with TFloatingObj(NxImages[I]) do Tmp1 := ImageHeight + VSpaceT + VSpaceB; LR.LineImgHt := IntMax(LR.LineImgHt, Tmp+Tmp1); AccumImgBot := IntMax(AccumImgBot, Y + Tmp1); end; NxImages.Clear; end; begin {TSection.DrawLogic} YDraw := Y; AccumImgBot := 0; TopY := Y; ContentTop := Y; DrawTop := Y; StartCurs := Curs; PStart := Buff; Last := Buff + Len - 1; SectionHeight := 0; Lines.Clear; if (Len = 0) then begin Result := GetClearSpace(ClearAttr); DrawHeight := Result; SectionHeight := Result; ContentBot := Y+Result; DrawBot := ContentBot; MaxWidth := 0; DrawWidth := 0; Exit; end; if FLPercent <> 0 then FirstLineIndent := (FLPercent * AWidth) div 100; {percentage calculated} Finished := False; DrawWidth := IMgr.RightSide(Y) - X; Width := IntMin(IMgr.RightSide(Y)-IMgr.LeftIndent(Y), AWidth); MaxWidth := Width; if AHeight = 0 then HtRef := BlHt else HtRef := AHeight; for I := 0 to Images.Count-1 do {call drawlogic for all the images} begin Obj := TFloatingObj(Images[I]); Obj.DrawLogic(Self.ParentSectionList, Canvas, Fonts.GetFontObjAt(Obj.Pos, Indx), Width, HtRef); MaxWidth := IntMax(MaxWidth, Obj.ImageWidth); {HScrollBar for wide images} end; for I := 0 to FormControls.Count-1 do with TFormControlObj(FormControls[I]) do if Assigned(FControl) then begin if PercentWidth then FControl.Width := IntMax(10, IntMin(MulDiv(FWidth, Width, 100), Width-HSpaceL-HSpaceR)); MaxWidth := IntMax(MaxWidth, FControl.Width); end; NxImages := TList.Create; while not Finished do begin Max := Last - PStart + 1; if Max <= 0 then Break; LR := LineRec.Create(ParentSectionList); {a new line} if (Lines.Count = 0) then begin {may need to move down past floating image} Tmp := GetClearSpace(ClearAttr); if Tmp > 0 then begin LR.LineHt := Tmp; Inc(SectionHeight, Tmp); LR.Ln := 0; LR.Start := PStart; Inc(Y, Tmp); Lines.Add(LR); LR := LineRec.Create(ParentSectionList); end; end; ImgHt := 0; NN := 0; if (Self is TPreformated) and not BreakWord then N := Max else begin NN := FindCountThatFits1(Canvas, PStart, Max, X, Y, IMgr, ImgHt, NxImages); N := IntMax(NN, 1); {N = at least 1} end; AccumImgBot := IntMax(AccumImgBot, Y+ImgHt); if NN = 0 then {if nothing fits, see if we can move down} Tmp := IMgr.GetNextWiderY(Y) - Y else Tmp := 0; if Tmp > 0 then begin {move down where it's wider} LR.LineHt := Tmp; Inc(SectionHeight, Tmp); LR.Ln := 0; LR.Start := PStart; Inc(Y, Tmp); Lines.Add(LR); end {else can't move down or don't have to} else if N = Max then begin {Do the remainder} Finished := True; LineComplete(N); end else begin P := PStart + N -1; {the last char that fits} if ((P^ in [WideChar(' '), FmCtl, ImgPan]) or WrapChar(P^)) and (Brk[P - Buff + 1] <> 'n') or (P^ = BrkCh) then begin {move past spaces so as not to print any on next line} while (N < Max) and ((P+1)^ = ' ') do begin Inc(P); Inc(N); end; Finished := N >= Max; LineComplete(N); end else if (N < Max) and ((P+1)^ = ' ') and (Brk[P - Buff + 2] <> 'n') then begin repeat Inc(N); {pass the space} Inc(p); until (N >= Max) or ((P+1)^ <> ' '); Finished := N >= Max; LineComplete(N); end else if (N < Max) and ((P+1)^ in [FmCtl, ImgPan]) and (Brk[PStart-Buff+N] <> 'n') then {an image or control} begin Finished := False; LineComplete(N); end else begin {non space, wrap it by backing off to previous space or image} while ((not ((P^ in [WideChar(' '), WideChar('-'), WideChar('?'), FmCtl, ImgPan]) or WrapChar(P^) or WrapChar((P+1)^)) and not (Brk[P-Buff+1] in ['a', 's'])) or ((Brk[P-Buff+1] = 'n'))) and (P > PStart) do Dec(P); if (P = PStart) and ((not (P^ in [FmCtl, ImgPan])) or (Brk[PStart-Buff+1] = 'n')) then begin {no space found, forget the wrap, write the whole word and any spaces found after it} if BreakWord then LineComplete(N) else begin P := PStart+N-1; while (P <> Last) and not (P^ in [WideChar('-'), WideChar('?')]) and not (Brk[P-Buff+1] in ['a', 's']) and not (((P + 1)^ in [WideChar(' '), FmCtl, ImgPan, BrkCh]) or WrapChar((P+1)^)) or (Brk[P - Buff + 2] = 'n') do begin Inc(P); end; while (P <> Last) and ((P+1)^ = ' ') do begin Inc(P); end; if (P <> Last) and ((P+1)^ = BrkCh) then Inc(P); {Line is too long, add spacer line to where it's clear} Tmp := IMgr.GetNextWiderY(Y) - Y; if Tmp > 0 then begin LR.LineHt := Tmp; Inc(SectionHeight, Tmp); LR.Ln := 0; LR.Start := PStart; Inc(Y, Tmp); Lines.Add(LR); end else begin {line is too long but do it anyway} MaxWidth := IntMax(MaxWidth, FindTextWidth(Canvas, PStart, P-PStart+1, True)); Finished := P = Last; LineComplete(P-PStart+1); end; end end else begin {found space} while (P+1)^ = ' ' do begin if P = Last then begin Inc(P); Dec(P); end; Inc(P); end; LineComplete(P-PStart+1); end; end; end; end; NxImages.Free; Curs := StartCurs + Len; If Assigned(ParentSectionList.FirstLineHtPtr) and (Lines.Count > 0) then {used for List items} with LineRec(Lines[0]) do if (ParentSectionList.FirstLineHtPtr^ = 0) then ParentSectionList.FirstLineHtPtr^ := YDraw + LineHt - Descent + SpaceBefore; DrawHeight := AccumImgBot - TopY; {in case image overhangs} if DrawHeight < SectionHeight then DrawHeight := SectionHeight; Result := SectionHeight; ContentBot := TopY+SectionHeight; DrawBot := TopY+DrawHeight; with ParentSectionList do begin if not IsCopy and (SectionNumber mod 50 = 0) and (ThisCycle <> CycleNumber) and (SectionCount > 0) then ThtmlViewer(TheOwner).htProgress(ProgressStart + ((100-ProgressStart)*SectionNumber) div SectionCount); ThisCycle := CycleNumber; {only once per cycle} end; end; {----------------TSection.CheckForInlines} procedure TSection.CheckForInlines(LR: Linerec); {called before each line is drawn the first time to check if there are any inline borders in the line} var I: integer; BR: BorderRec; StartBI, EndBI, LineStart: integer; begin with LR do begin FirstDraw := False; {this will turn it off if there is no inline border action in this line} with TInlineList(ParentSectionList.InlineList) do for I := 0 to Count-1 do {look thru the inlinelist} begin StartBI := StartB[I]; EndBI := EndB[I]; {$IFNDEF FPC} LineStart := StartCurs + Start-Buff; {offset from Section start to Line start} {$ELSE} LineStart := StartCurs + PtrUInt(Start)-PtrUInt(Buff); {offset from Section start to Line start} {$ENDIF} if (EndBI > LineStart) and (StartBI < LineStart +Ln) then begin {it's in this line} if not Assigned(BorderList) then begin BorderList := TFreeList.Create; FirstDraw := True; {there will be more processing needed} end; BR := BorderRec.Create; BorderList.Add(BR); with BR do begin BR.MargArray := InlineRec(ParentSectionList.InlineList.Items[I]).MargArray; {get border data} if StartBI < LineStart then begin OpenStart := True; {continuation of border on line above, end is open} BStart := Start-Buff; {start of this line} end else begin OpenStart := False; BStart := StartBI - StartCurs; {start is in this line} end; if EndBI > LineStart + Ln then begin OpenEnd := True; {will continue on next line, end is open} BEnd := Start-Buff +Ln; end else begin OpenEnd := False; BEnd := EndBI - StartCurs; {end is in this line} end; end; end; end; end; end; {----------------TSection.Draw} function TSection.Draw1(Canvas: TCanvas; const ARect: TRect; IMgr: IndentManager; X, XRef, YRef : integer) : integer; var I: integer; MySelB, MySelE: integer; DC: HDC; Ctrl: TFormControlObj; YOffset, Y, Desc: integer; procedure DrawTheText(LineNo: integer); var I, J, J1, J2, J3, J4, Index, Addon, TopP, BottomP, LeftT, Tmp, K : integer; Obj: TFloatingObj; FO: TFontObj; ARect: TRect; Inverted, ImageAtStart, NewCP: boolean; Color: TColor; CP1: TPoint; CPx, CPy, CP1x: integer; SaveColor: TColor; BR: BorderRec; LR:LineRec; Start: PWideChar; Cnt, Descent: integer; St: WideString; function AddHyphen(P: PWideChar; N: integer): WideString; var I: integer; begin SetLength(Result, N+1); for I := 1 to N do Result[I] := P[I-1]; Result[N+1] := WideChar('-'); end; function ChkInversion(Start: PWideChar; var Count: Integer): boolean; var LongCount, C: integer; begin Result := False; C := Start-Buff; Count := 32000; if ParentSectionList.IsCopy then Exit; if (MySelE < MySelB) or ((MySelE = MySelB) and not ParentSectionList.ShowDummyCaret) then Exit; if (MySelB <= C) and (MySelE > C) then begin Result := True; LongCount := MySelE - C; end else if MySelB > C then LongCount := MySelB - C else LongCount := 32000; if LongCount > 32000 then Count := 32000 else Count := LongCount; end; begin {Y is at bottom of line here} LR := LineRec(Lines[LineNo]); Start := LR.Start; Cnt := LR.Ln; Descent := LR.Descent; NewCP := True; ImageAtStart := True; CPx := X + LR.LineIndent; CP1x := CPx; LR.DrawY := Y-LR.LineHt; LR.DrawXX := CPx; while Cnt > 0 do begin I := 1; J1 := Fonts.GetFontCountAt(Start-Buff, Len)-1; J2 := Images.GetImageCountAt(Start-Buff)-1; J4 := TFormControlList(FormControls).GetControlCountAt(Start-Buff)-1; FO := Fonts.GetFontObjAt(Start-Buff, Index); {if an inline border, find it's boundaries} if LR.FirstDraw and Assigned(LR.BorderList) then for K := 0 to LR.BorderList.Count-1 do {may be several inline borders} begin BR := BorderRec(LR.BorderList.Items[K]); if (Start-Buff = BR.BStart) then begin {this is it's start} BR.bRect.Top := Y-FO.GetHeight(Desc)-Descent+Desc+1; BR.bRect.Left := CPx; BR.bRect.Bottom := Y-Descent+Desc; end else if (Start-Buff = BR.BEnd) and (BR.bRect.Right = 0) then BR.bRect.Right := CPx {this is it's end} else if (Start-Buff > BR.BStart) and (Start-Buff < BR.BEnd) then begin {this is position within boundary, it's top or bottom may enlarge} BR.bRect.Top := IntMin(BR.bRect.Top, Y-FO.GetHeight(Desc)-Descent+Desc+1); BR.bRect.Bottom := IntMax(BR.bRect.Bottom, Y-Descent+Desc); end; end; FO.TheFont.AssignToCanvas(Canvas); if J2 = -1 then begin {it's an image or panel} Obj := Images.FindImage(Start-Buff); if Obj is TImageObj then begin if Obj.ObjAlign in [ALeft, ARight] then begin if ImageAtStart then begin ParentSectionList.DrawList.AddImage(TImageObj(Obj), Canvas, IMgr.LfEdge+Obj.Indent, Y-LR.LineHt-LR.SpaceBefore, Y-Descent, FO); end else begin {if not at start, draw on next line} ParentSectionList.DrawList.AddImage(TImageObj(Obj), Canvas, IMgr.LfEdge+Obj.Indent, Y, Y-Descent, FO); end; {if a boundary is on a floating image, remove it} if LR.FirstDraw and Assigned(LR.BorderList) then for K := LR.BorderList.Count-1 downto 0 do begin BR := BorderRec(LR.BorderList.Items[K]); if (Start-Buff = BR.BStart) and (BR.BEnd = BR.BStart+1) then begin LR.BorderList.Delete(K); BR.Free; end; end; end else begin SetTextJustification(Canvas.Handle, 0, 0); if Assigned(MyBlock) then TImageObj(Obj).Positioning := MyBlock.Positioning else TImageObj(Obj).Positioning := posStatic; TImageObj(Obj).Draw(Canvas, CPx+Obj.HSpaceL, Y-LR.LineHt, Y-Descent, FO); {see if there's an inline border for the image} if LR.FirstDraw and Assigned(LR.BorderList) then for K := 0 to LR.BorderList.Count-1 do begin BR := BorderRec(LR.BorderList.Items[K]); if (Start-Buff >= BR.BStart) and (Start-Buff <= BR.BEnd) then begin {there is a border here, find the image dimensions} with TImageObj(Obj) do case ObjAlign of ATop: begin TopP := Y-LR.LineHt+VSpaceT; BottomP := Y-LR.LineHT+ImageHeight+VSpaceT; end; AMiddle: begin TopP := Y-Descent+FO.Descent-(FO.tmHeight div 2)-((ImageHeight-VSpaceT+VSpaceB) div 2); BottomP := Y-Descent+FO.Descent-(FO.tmHeight div 2)-((ImageHeight-VSpaceT+VSpaceB) div 2)+ImageHeight; end; ABottom, ABaseline: begin TopP := Y-Descent-Obj.ImageHeight-VSpaceB; BottomP := Y-Descent-VSpaceB; end; else begin TopP := 0; {to eliminate warning msg} BottomP := 0; end; end; if (Start-Buff = BR.BStart) then begin {border starts at image} BR.bRect.Top := ToPP; BR.bRect.Left := CPx + TImageObj(Obj).HSpaceL; if BR.BEnd = BR.BStart+1 then {border ends with image also, rt side set by image width} BR.bRect.Right := BR.bRect.Left+TImageObj(Obj).ImageWidth; BR.bRect.Bottom := BottomP; end else if Start-Buff = BR.BEnd then else begin {image is included in border and may effect the border top and bottom} BR.bRect.Top := IntMin(BR.bRect.Top, ToPP); BR.bRect.Bottom := IntMax(BR.bRect.Bottom, BottomP); end; end; end; CPx := CPx + Obj.ImageWidth + Obj.HSpaceL + Obj.HSpaceR; NewCP := True; ImageAtStart := False; end; end else begin {it's a Panel} with TPanelObj(Obj) do begin ShowIt := True; if (Obj.ObjAlign in [ALeft, ARight]) then begin LeftT := IMgr.LfEdge+Obj.Indent; if ImageAtStart then TopP := Y-LR.LineHt-LR.SpaceBefore-YOffset+VSpaceT else TopP := Y-YOffset+VSpaceT; {check for border. For floating panel, remove it} if LR.FirstDraw and Assigned(LR.BorderList) then for K := LR.BorderList.Count-1 downto 0 do begin BR := BorderRec(LR.BorderList.Items[K]); if (Start-Buff = BR.BStart) and (BR.BEnd = BR.BStart+1) then begin LR.BorderList.Delete(K); BR.Free; end; end; end else begin LeftT := CPx+Obj.HSpaceL; case Obj.ObjAlign of ATop: TopP := Y-YOffset-LR.LineHt+Obj.VSpaceT; AMiddle: TopP := Y-YOffset - FO.tmHeight div 2 - (ImageHeight-Obj.VSpaceT+Obj.VSpaceB) div 2; ABottom, ABaseline: TopP := Y-YOffset-ImageHeight-Descent-Obj.VSpaceB; else TopP := 0; {to eliminate warning msg} end; {Check for border on inline panel} if LR.FirstDraw and Assigned(LR.BorderList) then for K := 0 to LR.BorderList.Count-1 do begin BR := BorderRec(LR.BorderList.Items[K]); if (Start-Buff >= BR.BStart) and (Start-Buff <= BR.BEnd) then begin if (Start-Buff = BR.BStart) then begin {border starts on panel} BR.bRect.Top := ToPP+YOffSet; BR.bRect.Left := CPx + HSpaceL; if BR.BEnd = BR.BStart+1 then {border also ends with panel} BR.bRect.Right := BR.bRect.Left+ImageWidth; BR.bRect.Bottom := TopP+YOffSet+ImageHeight; end else if Start-Buff = BR.BEnd then else begin {Panel is included in border, may effect top and bottom} BR.bRect.Top := IntMin(BR.bRect.Top, ToPP+YOffSet); BR.bRect.Bottom := IntMax(BR.bRect.Bottom, TopP+YOffSet+ImageHeight); end; end; end; Inc(CPx, ImageWidth+Obj.HSpaceL+Obj.HSpaceR); NewCP := True; ImageAtStart := False; end; if ParentSectionList.IsCopy then TPanelObj(Obj).Draw(Canvas, LeftT, TopP) else begin Panel.Top := TopP; Panel.Left := LeftT; if ThvPanel(Panel).FVisible then Panel.Show else Panel.Hide; end; DrawXX := LeftT; end; end; end else if J4 = -1 then begin {it's a form control} Ctrl := TFormControlList(FormControls).FindControl(Start-Buff); if Assigned(Ctrl.FControl) then with Ctrl, FControl do begin ShowIt := True; case FormAlign of ATop: TopP := LR.DrawY+VSpaceT - YOffset; AMiddle: TopP := Y - ((LR.LineHt+Height) div 2) - YOffset; ABaseline: TopP := Y - Height-VSpaceB - Descent -YOffset; {sits on baseline} ABottom: TopP := Y-Height-VSpaceB-YOffset; else TopP := Y; {never get here} end; if FControl is TRadioButton then Inc(Topp, 2) else if FControl is TCheckbox then Inc(Topp, 1); {Check for border} if LR.FirstDraw and Assigned(LR.BorderList) then for K := 0 to LR.BorderList.Count-1 do begin BR := BorderRec(LR.BorderList.Items[K]); if (Start-Buff >= BR.BStart) and (Start-Buff <= BR.BEnd) then begin if (Start-Buff = BR.BStart) then begin {border starts with Form control} BR.bRect.Top := ToPP+YOffSet; BR.bRect.Left := CPx + HSpaceL; if BR.BEnd = BR.BStart+1 then {border is confined to form control} BR.bRect.Right := BR.bRect.Left+Width; BR.bRect.Bottom := TopP+YOffSet+Height; end else if Start-Buff = BR.BEnd then else begin {form control is included in border} BR.bRect.Top := IntMin(BR.bRect.Top, ToPP+YOffSet); BR.bRect.Bottom := IntMax(BR.bRect.Bottom, TopP+YOffSet+Height); end; end; end; if ParentSectionList.IsCopy then Ctrl.Draw(Canvas, CPx+Ctrl.HSpaceL, TopP) else begin Show; Top := TopP; Left := CPx+Ctrl.HSpaceL; if Ctrl is TRadioButtonFormControlObj then with TRadioButtonFormControlObj(Ctrl) do begin TRadioButtonFormControlObj(Ctrl).TheControl.Show; if MyCell.BkGnd then (TheControl as TFormRadioButton).Color := MyCell.BkColor else (TheControl as TFormRadioButton).Color := ParentSectionList.Background; end; if Ctrl.Active and ((Ctrl is TRadioButtonFormControlObj) or (Ctrl is TCheckBoxFormControlObj)) then begin Canvas.Brush.Color := clWhite; SaveColor := SetTextColor(Handle, clBlack); if (Ctrl is TRadioButtonFormControlObj) then begin if Screen.PixelsPerInch > 100 then Canvas.DrawFocusRect(Rect(Left-2, Top-2, Left+18, Top+18)) else Canvas.DrawFocusRect(Rect(Left-3, Top-2, Left+16, Top+16)); end else Canvas.DrawFocusRect(Rect(Left-3, Top-3, Left+16, Top+16)); SetTextColor(Handle, SaveColor); end; end; Inc(CPx, Width+Ctrl.HSpaceL+Ctrl.HSpaceR); NewCP := True; end; ImageAtStart := False; end else begin J := IntMin(J1, J2); J := IntMin(J, J4); Inverted := ChkInversion(Start, J3); J := IntMin(J, J3-1); I := IntMin(Cnt, J+1); if Inverted then begin SetBkMode(Canvas.Handle, Opaque); Canvas.Brush.Color := Canvas.Font.Color; if FO.TheFont.bgColor = clNone then begin Color := Canvas.Font.Color; if Color and $80000000 = $80000000 then Color := GetSysColor(Color and $FFFFFF) else Color := Color and $FFFFFF; Canvas.Font.Color := Color xor $FFFFFF; end else Canvas.Font.Color := FO.TheFont.bgColor; end else if FO.TheFont.BGColor = clNone then begin SetBkMode(Canvas.Handle, Transparent); Canvas.Brush.Style := bsClear; end else begin SetBkMode(Canvas.Handle, Opaque); Canvas.Brush.Style := bsClear; Canvas.Brush.Color := FO.TheFont.BGColor; end; if ParentSectionList.Printing then begin if ParentSectionList.PrintMonoBlack and (GetDeviceCaps(Canvas.Handle, NumColors) in [0..2]) then begin Color := Canvas.Font.Color; if Color and $80000000 = $80000000 then Color := GetSysColor(Color); if Color and $ffffff <> $ffffff then Canvas.Font.Color := clBlack; {Print black} end; if not ParentSectionlist.PrintTableBackground then begin Color := Canvas.Font.Color; if Color and $80000000 = $80000000 then Color := GetSysColor(Color); if (Color and $E0E0 = $E0E0) then Canvas.Font.Color := $2A0A0A0; {too near white or yellow, make it gray} end; end; SetTextAlign(Canvas.Handle, TA_BaseLine); {figure any offset for subscript or superscript} with FO do if SScript = ANone then Addon := 0 else if SScript = ASuper then Addon := -(FontHeight div 3) else Addon := Descent div 2 +1; NewCP := NewCP or (Addon <> 0); {calc a new CP if required} if NewCP then begin CPy := Y - Descent + Addon - YOffset; NewCP := Addon <> 0; end; if not ParentSectionList.NoOutput then begin if (Cnt - I <= 0) and ((Start + I - 1)^ in [WideChar(' '), WideChar(BrkCh)]) then Tmp := I-1 {at end of line, don't show space or break} else Tmp := I; if (Self is TPreformated) and not MyBlock.HideOverflow then begin {so will clip in Table cells} ARect := Rect(IMgr.LfEdge, Y-LR.LineHt-LR.SpaceBefore-YOffset, X+IMgr.ClipWidth, Y-YOffset+1); ExtTextOutW(Canvas.Handle, CPx, CPy, ETO_CLIPPED, @ARect, Start, Tmp, nil); CP1x := CPx+GetXExtent(Canvas.Handle, Start, Tmp); end else begin if LR.Spaces = 0 then SetTextJustification(Canvas.Handle, 0, 0) else SetTextJustification(Canvas.Handle, LR.Extra, LR.Spaces); if not IsWin95 then {use TextOutW} begin if (Cnt - I <= 0) and LR.Shy then begin St := AddHyphen(Start, Tmp); TextOutW(Canvas.Handle, CPx, CPy, PWideChar(St), Length(St)); CP1x := CPx+GetXExtent(Canvas.Handle, PWideChar(St), Length(St)); end else begin TextOutW(Canvas.Handle, CPx, CPy, Start, Tmp); CP1x := CPx+GetXExtent(Canvas.Handle, Start, Tmp); end end else begin {Win95} {Win95 has bug which extends text underline for proportional font in TextOutW. Use clipping to clip the extra underline.} CP1x := CPx+GetXExtent(Canvas.Handle, Start, Tmp); ARect := Rect(CPx, Y-LR.LineHt-LR.SpaceBefore-YOffset, CP1x, Y-YOffset+1); ExtTextOutW(Canvas.Handle, CPx, CPy, ETO_CLIPPED, @ARect, Start, Tmp, nil) end; end; {Put in a dummy caret to show character position} if ParentSectionList.ShowDummyCaret and not Inverted and (MySelB = Start-Buff) then begin Canvas.Pen.Color := Canvas.Font.Color; Tmp := Y - Descent+ FO.Descent + Addon - YOffset; Canvas.Brush.Color := clWhite; Canvas.Rectangle(CPx, Tmp, CPx+1, Tmp-FO.FontHeight); end; end; if FO.Active or ParentSectionList.IsCopy and Assigned(ParentSectionList.LinkDrawnEvent) and (FO.UrlTarget.Url <> '') then begin Tmp := Y - Descent+ FO.Descent + Addon - YOffset; ARect := Rect(CPx, Tmp-FO.FontHeight, CP1x+1, Tmp); if FO.Active then begin Canvas.Font.Color := clBlack; {black font needed for DrawFocusRect} DC := Canvas.Handle; {Dummy call needed to make Delphi add font color change to handle} Canvas.DrawFocusRect(ARect); end; if Assigned(ParentSectionList.LinkDrawnEvent) then ParentSectionList.LinkDrawnEvent(ParentSectionList.TheOwner, ParentSectionList.LinkPage, FO.UrlTarget.Url, FO.UrlTarget.Target, ARect); end; CPx := CP1x; {the following puts a dummy caret at the very end of text if it should be there} if ParentSectionList.ShowDummyCaret and not Inverted and ((MySelB = Len) and (ParentSectionList.Selb = ParentSectionList.Len)) and (Cnt = I) and (LineNo = Lines.Count-1) then begin Canvas.Pen.Color := Canvas.Font.Color; Tmp := Y - Descent+ FO.Descent + Addon - YOffset; Canvas.Brush.Color := clWhite; Canvas.Rectangle(CPx, Tmp, CPx+1, Tmp-FO.FontHeight); end; ImageAtStart := False; end; Dec(Cnt, I); Inc(Start, I); end; SetTextJustification(Canvas.Handle, 0, 0); {at the end of this line. see if there are open borders which need right side set} if LR.FirstDraw and Assigned(LR.BorderList) then for K := 0 to LR.BorderList.Count-1 do begin BR := BorderRec(LR.BorderList.Items[K]); if BR.OpenEnd or (BR.BRect.Right = 0) then BR.BRect.Right := CPx; end; end; procedure DoDraw(I: integer); {draw the Ith line in this section} var BR: BorderRec; K: integer; XOffset: integer; begin with LineRec(Lines[I]) do begin Inc(Y, LineHt+SpaceBefore); if FirstDraw then begin {see if any inline borders in this line} CheckForInlines(LineRec(Lines[I])); if FirstDraw then {if there are, need a first pass to get boundaries} begin FirstX := X; DrawTheText(I); end; end; XOffset := X-FirstX; FirstDraw := False; if Assigned(BorderList) then {draw any borders found in this line} for K := 0 to BorderList.Count-1 do begin BR := BorderRec(BorderList.Items[K]); BR.DrawTheBorder(Canvas, XOffset, YOffSet, ParentSectionList.Printing); end; DrawTheText(I); {draw the text, etc., in this line} Inc(Y, SpaceAfter); end; ParentSectionList.FirstPageItem := False; end; begin {TSection.Draw} Y := YDraw; Result := Y + SectionHeight; YOffset := ParentSectionList.YOff; {Only draw if will be in display rectangle} if (Len > 0) and (Y-YOffset+DrawHeight+40 >= ARect.Top) and (Y-YOffset-40 < ARect.Bottom) then begin DC := Canvas.Handle; SetTextAlign(DC, TA_BaseLine); MySelB := ParentSectionList.SelB-StartCurs; MySelE := ParentSectionList.SelE-StartCurs; for I := 0 to Lines.Count-1 do with ParentSectionList do if Printing then with LineRec(Lines[I]) do begin if (Y + LineImgHt <= PageBottom) then begin if(Y + LineImgHt - 1> ARect.Top+YOffSet) then DoDraw(I) else Inc(Y, SpaceBefore + LineHt + SpaceAfter); end else if (LineImgHt >= ARect.Bottom - ARect.Top) or PageShortened then DoDraw(I) else begin if Assigned(MyBlock) and (MyBlock.Positioning = PosAbsolute) then DoDraw(I) else if Y < PageBottom then PageBottom := Y; {Dont' print, don't want partial line} end; end else with LineRec(Lines[I]) do if ((Y-YOffset+LineImgHt+40 >= ARect.Top) and (Y-YOffset-40 < ARect.Bottom)) then DoDraw(I) else {do not completely draw extremely long paragraphs} Inc(Y, SpaceBefore + LineHt + SpaceAfter); end; end; {----------------TSection.CopyToClipboard} procedure TSection.CopyToClipboard; var I, Strt, X1, X2: integer; MySelB, MySelE: integer; begin MySelB := ParentSectionList.SelB - StartCurs; MySelE := ParentSectionList.SelE - StartCurs; for I := 0 to Lines.Count-1 do with LineRec(Lines.Items[I]) do begin Strt := Start-Buff; if (MySelE <= Strt) or (MySelB > Strt + Ln) then Continue; if MySelB-Strt > 0 then X1 := MySelB-Strt else X1 := 0; if MySelE-Strt < Ln then X2 := MySelE - Strt else X2 := Ln; if (I = Lines.Count-1) and (X2 = Ln) then Dec(X2); ParentSectionList.CB.AddText(Start+X1, X2-X1); end; if MySelE > Len then ParentSectionList.CB.AddTextCR('', 0); end; {----------------TSection.PtInObject} function TSection.PtInObject(X : integer; Y: integer; var Obj: TObject; var IX, IY: integer): boolean; {Y is distance from start of section} begin Result := (Images.Count > 0) and Images.PtInObject(X, Y, Obj, IX, IY); end; {----------------TSection.GetURL} function TSection.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; {Y is absolute} var I, L, Index, Width, IX, IY, Posn: integer; FO : TFontObj; LR: LineRec; IMap, UMap: boolean; MapItem: TMapItem; ImageObj: TImageObj; Tmp: string; function MakeCopy(UrlTarget: TUrlTarget): TUrlTarget; begin Result := TUrlTarget.Create; Result.Copy(UrlTarget); end; begin Result := []; {First, check to see if in an image} if (Images.Count > 0) and Images.PtInImage(X, Y, IX, IY, Posn, IMap, UMap, MapItem, ImageObj) then begin if ImageObj.ImageTitle <> '' then begin ATitle := ImageObj.ImageTitle; Include(Result, guTitle); end else if ImageObj.FAlt <> '' then begin ATitle := ImageObj.FAlt; Include(Result, guTitle); end; ParentSectionList.ActiveImage := ImageObj; if Assigned(ImageObj.MyFormControl) then begin FormControl := ImageObj.MyFormControl; Include(Result, guControl); FormControl.XTmp := IX; FormControl.YTmp := IY; end else if UMap then begin if MapItem.GetURL(IX, IY, UrlTarg, Tmp) then begin Include(Result, guUrl); if Tmp <> '' then begin ATitle := Tmp; Include(Result, guTitle); end; end; end else begin FO := Fonts.GetFontObjAt(Posn, Index); if (FO.UrlTarget.Url <> '') then begin {found an URL} Include(Result, guUrl); UrlTarg := MakeCopy(FO.UrlTarget); ParentSectionList.ActiveLink := FO; if IMap then UrlTarg.Url := UrlTarg.Url + '?'+IntToStr(IX)+','+IntToStr(IY); end; end; end else begin I := 0; LR := Nil; with Lines do begin while I < Count do begin LR := LineRec(Lines[I]); if (Y > LR.DrawY) and (Y <= LR.DrawY+LR.LineHt) then Break; Inc(I); end; if I >= Count then Exit; end; with LR do begin if X < DrawXX then Exit; Width := X - DrawXX; if Spaces > 0 then SetTextJustification(Canvas.Handle, Extra, Spaces); L := FindCountThatFits(Canvas, Width, Start, Ln); if Spaces > 0 then SetTextJustification(Canvas.Handle, 0, 0); if L >= Ln then Exit; FO := Fonts.GetFontObjAt(L+(Start-Buff), Index); if (FO.UrlTarget.Url <> '') then {found an URL} if not ((Start+L)^ in [ImgPan]) then {an image here would be in HSpace area} begin Include(Result, guUrl); UrlTarg := MakeCopy(FO.UrlTarget); ParentSectionList.ActiveLink := FO; end; if (FO.Title <> '') then {found a Title} if not ((Start+L)^ in [ImgPan]) then {an image here would be in HSpace area} begin ATitle := FO.Title; Include(Result, guTitle); end; end; end; end; {----------------TSection.FindCursor} function TSection.FindCursor(Canvas: TCanvas; X: integer; Y: integer; var XR: integer; var YR: integer; var CaretHt: integer; var Intext: boolean): integer; {Given an X, Y, find the character position and the resulting XR, YR position for a caret along with its height, CaretHt. Coordinates are relative to this section} var I, H, L, Width, TotalHt, L1, W, Delta, OHang: integer; LR: LineRec; begin Result := -1; I := 0; H := ContentTop; L1 := 0; LR := Nil; with Lines do begin while I < Count do begin LR := LineRec(Lines[I]); with LR do TotalHt := LineHt+SpaceBefore+SpaceAfter; if H+TotalHt > Y then Break; Inc(H, TotalHt); Inc(I); Inc(L1, LR.Ln); {L1 accumulates char count of previous lines} end; if (I >= Count) then Exit; end; with LR do begin if X > LR.DrawXX + LR.DrawWidth then Exit; if X < LR.DrawXX-10 then Exit; InText := True; CaretHt := LineHt; YR := H + SpaceBefore; if X < DrawXX then begin Result := L1+StartCurs; InText := False; Exit; end; Width := X-DrawXX; if (Justify = FullJustify) and (Spaces > 0) then SetTextJustification(Canvas.Handle, Extra, Spaces); L := FindCountThatFits(Canvas, Width, Start, Ln); W := FindTextWidth(Canvas, Start, L, False); XR := DrawXX + W; if L < Ln then begin {check to see if passed 1/2 character mark} Fonts.GetFontAt(L1+L, OHang).AssignToCanvas(Canvas); Delta := FindTextWidthA(Canvas, Start+L, 1); if Width > W+(Delta div 2) then begin Inc(L); Inc(XR, Delta); end; end else InText := False; Result := L+L1+StartCurs; if Justify = FullJustify then SetTextJustification(Canvas.Handle, 0, 0); end; end; {----------------TSection.FindString} function TSection.FindString(From: integer; const ToFind: WideString; MatchCase: boolean): integer; {find the first occurance of the string, ToFind, with a cursor value >= to From. ToFind is in lower case if MatchCase is False. ToFind is known to have a length of at least one. } var P: PWideChar; I: integer; ToSearch: WideString; begin Result := -1; if (Len = 0) or (From >= StartCurs + Len) then Exit; if From < StartCurs then I := 0 else I := From-StartCurs; if MatchCase then ToSearch := BuffS else ToSearch := WideLowerCase1(BuffS); {ToFind already lower case} P := StrPosW(PWideChar(ToSearch) + I, PWideChar(ToFind)); if Assigned(P) then Result := StartCurs+(P-PWideChar(ToSearch)); end; {----------------TSection.FindStringR} function TSection.FindStringR(From: integer; const ToFind: WideString; MatchCase: boolean): integer; {find the first occurance of the string, ToFind, with a cursor value <= to From. ToFind is in lower case if MatchCase is False. ToFind is known to have a length of at least one. } var P: PWideChar; ToFindLen: word; ToMatch, ToSearch: WideString; begin Result := -1; if (Len = 0) or (From < StartCurs) then Exit; ToFindLen := Length(ToFind); if (Len < ToFindLen) or (From-StartCurs+1 < ToFindLen) then Exit; if From >= StartCurs + Len then ToSearch := BuffS {search all of BuffS} else ToSearch := Copy(BuffS, 1, From-StartCurs); {Search smaller part} if not MatchCase then ToSearch := WideLowerCase1(ToSearch); {ToFind already lower case} {search backwards for the end char of ToFind} P := StrRScanW(PWideChar(ToSearch), ToFind[ToFindLen]); while Assigned(P) and (P-PWideChar(ToSearch)+1 >= ToFindLen) do begin {pick out a string of proper length from end char to see if it matches} SetString(ToMatch, P-ToFindLen+1, ToFindLen); if WideSameStr1(ToFind, ToMatch) then begin {matches, return the cursor position} Result := StartCurs + (P - ToFindLen+1 - PWideChar(ToSearch)); Exit; end; {doesn't match, shorten string to search for next search} ToSearch := Copy(ToSearch, 1, P-PWideChar(ToSearch)); {and search backwards for end char again} P := StrRScanW(PWideChar(ToSearch), ToFind[ToFindLen]); end; end; {----------------TSection.FindSourcePos} function TSection.FindSourcePos(DocPos: integer): integer; var I: integer; IO: IndexObj; begin Result := -1; if (Len = 0) or (DocPos >= StartCurs + Len) then Exit; for I := SIndexList.Count-1 downto 0 do begin IO := PosIndex[I]; if IO.Pos <= DocPos-StartCurs then begin Result := IO.Index + DocPos-StartCurs - IO.Pos; break; end; end; end; {----------------TSection.FindDocPos} function TSection.FindDocPos(SourcePos: integer; Prev: boolean): integer; {for a given Source position, find the nearest document position either Next or previous} var I: integer; IO, IOPrev: IndexObj; begin Result := -1; if Len = 0 then Exit; if not Prev then begin I:= SIndexList.Count-1; IO := PosIndex[I]; if SourcePos > IO.Index + (Len-1) - IO.Pos then Exit; {beyond this section} IOPrev := PosIndex[0]; if SourcePos <= IOPrev.Index then begin {in this section but before the start of Document text} Result := StartCurs; Exit; end; for I := 1 to SIndexList.Count-1 do begin IO := PosIndex[I]; if (SourcePos >= IOPrev.Index) and (SourcePos < IO.Index) then begin {between IOprev and IO} if SourcePos-IOPrev.Index+IOPrev.Pos < IO.Pos then Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index) else Result := StartCurs+IO.Pos; Exit; end; IOPrev := IO; end; {after the last IndexObj in list} Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index); end else {prev -- we're iterating from the end of TSectionList} begin IOPrev := PosIndex[0]; if SourcePos < IOPrev.Index then Exit; {before this section} I:= SIndexList.Count-1; IO := PosIndex[I]; if SourcePos > IO.Index + (Len-1) - IO.Pos then begin {SourcePos is after the end of this section} Result := StartCurs + (Len-1); Exit; end; for I := 1 to SIndexList.Count-1 do begin IO := PosIndex[I]; if (SourcePos >= IOPrev.Index) and (SourcePos < IO.Index) then begin {between IOprev and IO} if SourcePos-IOPrev.Index+IOPrev.Pos < IO.Pos then Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index) else Result := StartCurs+IO.Pos-1; Exit; end; IOPrev := IO; end; {after the last IndexObj in list} Result := StartCurs+IOPrev.Pos+(SourcePos-IOPrev.Index); end; end; {----------------TSection.CursorToXY} function TSection.CursorToXY(Canvas: TCanvas; Cursor: integer; var X: integer; var Y: integer): boolean; var I, Curs: integer; LR: LineRec; begin Result := False; if (Len = 0) or (Cursor > StartCurs + Len) then Exit; I := 0; LR := Nil; Curs := Cursor - StartCurs; Y := ContentTop; with Lines do begin while I < Count do begin LR := LineRec(Lines[I]); with LR do begin if Curs < Ln then Break; Inc(Y, LineHt+SpaceBefore+SpaceAfter); Dec(Curs, Ln); end; Inc(I); end; if I >= Count then Exit; end; if Assigned(Canvas) then begin if LR.Spaces > 0 then SetTextJustification(Canvas.Handle, LR.Extra, LR.Spaces); X := LR.DrawXX + FindTextWidth(Canvas, LR.Start, Curs, False); if LR.Spaces > 0 then SetTextJustification(Canvas.Handle, 0, 0); end else X := LR.DrawXX; Result := True; end; {----------------TSection.GetChAtPos} function TSection.GetChAtPos(Pos: integer; var Ch: WideChar; var Obj: TObject): boolean; begin Result := False; if (Len = 0) or (Pos < StartCurs) or (Pos >= StartCurs + Len) then Exit; Ch := Buff[Pos-StartCurs]; Obj := Self; Result := True; end; {----------------TPanelObj.Create} constructor TPanelObj.Create(AMasterList: TSectionList; Position: integer; L: TAttributeList; ACell: TCellBasic; ObjectTag: boolean); var PntPanel: TPaintPanel; I: integer; NewSpace: integer; S, Source, AName, AType: string; begin inherited Create; fMasterList := AMasterList; Pos := Position; PntPanel := TPaintPanel(AMasterList.PPanel); Panel := ThvPanel.Create(PntPanel); Panel.Left := -4000; Panel.Parent := PntPanel; with ThvPanel(Panel) do begin FMyPanelObj := Self; Top := -4000; Height := 20; Width := 30; BevelOuter := bvNone; BorderStyle := bsSingle; Color := clWhite; FVisible := True; {$IFNDEF LCL} Ctl3D := False; ParentCtl3D := False; {$ENDIF} ParentFont := False; ObjAlign := ABottom; {default} NewSpace := -1; for I := 0 to L.Count-1 do with TAttribute(L[I]) do case Which of HeightSy: if System.Pos('%', Name) = 0 then begin SpecHeight := Intmax(1, Value); {spec ht of 0 becomes 1} Height := SpecHeight; {so panels ht will be set for OnPanelCreate} end else if (Value > 0) and (Value <=100) then begin SpecHeight := Value; PercentHeight := True; end; WidthSy: if System.Pos('%', Name) = 0 then begin SpecWidth := Value; Width := Value; end else begin Value := IntMax(1, IntMin(Value, 100)); SpecWidth := Value; PercentWidth := True; end; HSpaceSy: NewSpace := IntMin(40, Abs(Value)); VSpaceSy: VSpaceT := IntMin(40, Abs(Value)); SrcSy: Source := Name; NameSy: begin AName := Name; try Panel.Name := Name; except {duplicate name will be ignored} end; end; AlignSy: begin S := UpperCase(Name); if S = 'TOP' then ObjAlign := ATop else if (S = 'MIDDLE') or (S = 'ABSMIDDLE') then ObjAlign := AMiddle else if S = 'LEFT' then ObjAlign := ALeft else if S = 'RIGHT' then ObjAlign := ARight; end; AltSy: begin FAlt := Name; while (Length(FAlt) > 0) and (FAlt[Length(FAlt)] in [#$D, #$A]) do Delete(FAlt, Length(FAlt), 1); ImageTitle := FAlt; {use Alt as default Title} FAltW := MultibyteToWideString(CodePage, FAlt); end; TypeSy: AType := Name; end; if NewSpace >= 0 then HSpaceL := NewSpace else if ObjAlign in [ALeft, ARight] then HSpaceL := ImageSpace {default} else HSpaceL := 0; HSpaceR := HSpaceL; VSpaceB := VSpaceT; Caption := ''; if not ObjectTag and Assigned(AMasterList.PanelCreateEvent) then AMasterList.PanelCreateEvent(AMasterList.TheOwner, AName, AType, Source, ThvPanel(Panel)); SetWidth := Width; SetHeight := Height; end; AMasterList.PanelList.Add(Self); end; constructor TPanelObj.CreateCopy(AMasterList: TSectionList; T: TPanelObj); begin inherited CreateCopy(T); Panel := ThvPanel.Create(Nil); with T.Panel do Panel.SetBounds(Left, Top, Width, Height); Panel.FVisible := T.Panel.FVisible; Panel.Color := T.Panel.Color; Panel.Parent := AMasterList.PPanel; SpecWidth := T.SpecWidth; PercentWidth := T.PercentWidth; SpecHeight := T.SpecHeight; PercentHeight := T.PercentHeight; SetHeight := T.SetHeight; SetWidth := T.SetWidth; OPanel := T.Panel; {save these for printing} OSender := T.fMasterList.TheOwner; PanelPrintEvent := T.fMasterList.PanelPrintEvent; IsCopy := True; end; destructor TPanelObj.Destroy; begin if Assigned(fMasterList) and Assigned(fMasterList.PanelDestroyEvent) then fMasterList.PanelDestroyEvent(fMasterList.TheOwner, ThvPanel(Panel)); Panel.Free; inherited Destroy; end; procedure TPanelObj.DrawLogic(SectionList: TSectionList; Canvas: TCanvas; FO: TFontObj; AvailableWidth, AvailableHeight: integer); begin if not ImageKnown or PercentWidth or PercentHeight then begin if PercentWidth then begin ImageWidth := MulDiv(AvailableWidth, SpecWidth, 100); if SpecHeight <> 0 then if PercentHeight then ImageHeight := MulDiv(AvailableHeight, SpecHeight, 100) else ImageHeight := SpecHeight else ImageHeight := MulDiv(ImageWidth, SetHeight, SetWidth); end else if PercentHeight then begin ImageHeight := MulDiv(AvailableHeight, SpecHeight, 100); if SpecWidth <> 0 then ImageWidth := SpecWidth else ImageWidth := MulDiv(ImageHeight, SetWidth, SetHeight); end else if (SpecWidth <> 0) and (SpecHeight <> 0) then begin {Both width and height specified} ImageHeight := SpecHeight; ImageWidth := SpecWidth; ImageKnown := True; end else if SpecHeight <> 0 then begin ImageHeight := SpecHeight; ImageWidth := MulDiv(SpecHeight, SetWidth, SetHeight); ImageKnown := True; end else if SpecWidth <> 0 then begin ImageWidth := SpecWidth; ImageHeight := MulDiv(SpecWidth, SetHeight, SetWidth); ImageKnown := True; end else begin {neither height and width specified} ImageHeight := SetHeight; ImageWidth := SetWidth; ImageKnown := True; end; if not IsCopy then with Panel do if (ImageWidth > 0) and (ImageHeight > 0) then SetBounds(Left, Top, ImageWidth, ImageHeight); end; end; procedure TPanelObj.Draw(ACanvas: TCanvas; X1, Y1: integer); var OldBrushStyle: TBrushStyle; OldBrushColor: TColor; OldPenColor: TColor; Bitmap: TBitmap; OldHeight, OldWidth: integer; SaveFont :TFont; begin if Panel.FVisible then with ACanvas do if Assigned(PanelPrintEvent) then begin Bitmap := TBitmap.Create; OldHeight := Opanel.Height; OldWidth := Opanel.Width; try Bitmap.Height := ImageHeight; Bitmap.Width := ImageWidth; with Opanel do SetBounds(Left, Top, ImageWidth, ImageHeight); PanelPrintEvent(OSender, OPanel, Bitmap); PrintBitmap(ACanvas, X1, Y1, ImageWidth, ImageHeight, Bitmap.Handle); finally with Opanel do SetBounds(Left, Top, OldWidth, OldHeight); Bitmap.Free; end; end else begin OldBrushStyle := Brush.Style; {save style first} OldBrushColor := Brush.Color; OldPenColor := Pen.Color; Pen.Color := clBlack; Brush.Color := Panel.Color; Brush.Style := bsSolid; ACanvas.Rectangle(X1, Y1, X1+ImageWidth, Y1+ImageHeight); SaveFont := TFont.Create; try SaveFont.Assign(ACanvas.Font); with ACanvas.Font do begin Size := 8; Name := 'Arial'; end; WrapTextW(ACanvas, X1+5, Y1+5, X1+ImageWidth-5, Y1+ImageHeight-5, FAltW); finally ACanvas.Font := SaveFont; SaveFont.Free; Brush.Color := OldBrushColor; Brush.Style := OldBrushStyle; {style after color as color changes style} Pen.Color := OldPenColor; end; end; end; {----------------TFloatingObj.CreateCopy} constructor TFloatingObj.CreateCopy(T: TFloatingObj); begin inherited Create; FAlt := T.FAlt; FAltW := T.FAltW; ImageWidth := T.ImageWidth; ImageHeight := T.ImageHeight; NoBorder := T.NoBorder; BorderSize := T.BorderSize; Indent := T.Indent; ObjAlign := T.ObjAlign; HSpaceL := T.HSpaceL; HSpaceR := T.HSpaceR; VSpaceT := T.VSpaceT; VSpaceB := T.VSpaceB; Pos := T.Pos; end; function TFloatingObj.GetYPosition: integer; begin Result := DrawYY; end; procedure ThvPanel.SetVisible(Value: boolean); begin if Value <> FVisible then begin FVisible := Value; if FVisible then Show else Hide; end; end; {----------------TCell.Create} constructor TCell.Create(Master: TSectionList); begin inherited Create(Master); IMgr := IndentManager.Create; end; {----------------TCell.CreateCopy} constructor TCell.CreateCopy(AMasterList: TSectionList; T: TCellBasic); begin inherited CreateCopy(AMasterList, T); IMgr := IndentManager.Create; end; destructor TCell.Destroy; begin IMgr.Free; inherited Destroy; end; {----------------TCell.DoLogic} function TCell.DoLogic(Canvas: TCanvas; Y: integer; Width, AHeight, BlHt: integer; var ScrollWidth: integer; var Curs: integer): integer; {Do the entire layout of the cell or document. Return the total document pixel height} var IB: integer; LIndex, RIndex: integer; SaveID: TObject; begin IMgr.Clear; IMgr.Reset(0, Width); IMgr.Width := Width; SaveID := IMgr.CurrentID; IMgr.CurrentID := Self; LIndex := IMgr.SetLeftIndent(0, Y); RIndex := IMgr.SetRightIndent(0+Width, Y); Result := inherited DoLogic(Canvas, Y, Width, AHeight, BlHt, ScrollWidth, Curs); IMgr.FreeLeftIndentRec(LIndex); IMgr.FreeRightIndentRec(RIndex); IB := IMgr.ImageBottom - YValue; {check for image overhang} IMgr.CurrentID := SaveID; if IB > Result then Result := IB; end; {----------------TCell.Draw} function TCell.Draw(Canvas: TCanvas; ARect: TRect; ClipWidth, X: integer; Y, XRef, YRef : integer): integer; {draw the document or cell. Note: individual sections not in ARect don't bother drawing} begin IMgr.Reset(X, X+IMgr.Width); IMgr.ClipWidth := ClipWidth; DrawYY := Y; {This is overridden in TCellObj.Draw} Result := inherited Draw(Canvas, ARect, ClipWidth, X, Y, XRef, YRef); end; {----------------TCellObjCell.CreateCopy} constructor TCellObjCell.CreateCopy(AMasterList: TSectionList; T: TCellObjCell); begin inherited CreateCopy(AMasterList, T); MyRect := T.MyRect;; end; {----------------TCellObjCell.GetUrl} function TCellObjCell.GetURL(Canvas: TCanvas; X: integer; Y: integer; var UrlTarg: TUrlTarget; var FormControl: TImageFormControlObj; var ATitle: string): guResultType; {Y is absolute} begin Result := inherited GetUrl(Canvas, X, Y, UrlTarg, FormControl, ATitle); if PtInRect(MyRect, Point(X, Y-MasterList.YOFF)) then begin if (not (guTitle in Result)) and (Title <> '') then begin ATitle := Title; Include(Result, guTitle); end; if (not (guUrl in Result)) and (Url <> '') then begin UrlTarg := TUrlTarget.Create; UrlTarg.URL := Url; UrlTarg.Target := Target; Include(Result, guUrl); end; end; end; { TBlockCell } function TBlockCell.DoLogicX(Canvas: TCanvas; X, Y, XRef, YRef, Width, AHeight, BlHt: integer; var ScrollWidth, Curs: Integer): integer; {Do the entire layout of the this cell. Return the total pixel height} var I, Sw, TheCount: integer; H, Tmp: integer; SB: TSectionBase; begin YValue := Y; StartCurs := Curs; H := 0; ScrollWidth := 0; tcContentBot := 0; tcDrawTop := 990000; tcDrawBot := 0; TheCount := Count; I := 0; while I < TheCount do begin SB := TSectionBase(Items[I]); Tmp := SB.DrawLogic(Canvas, X, Y+H, XRef, YRef, Width, AHeight, BlHt, IMgr, Sw, Curs); H := H+Tmp; if Owner.HideOverflow then ScrollWidth := Width else ScrollWidth := IntMax(ScrollWidth, Sw); if (SB is TBlock) and (TBlock(SB).Positioning = posAbsolute) then else tcContentBot := IntMax(tcContentBot, SB.ContentBot); tcDrawTop := IntMin(tcDrawTop, SB.DrawTop); tcDrawBot := IntMax(tcDrawBot, SB.DrawBot); Inc(I); end; Len := Curs - StartCurs; Result := H; CellHeight := Result; end; { TDrawList } Type TImageRec = class(TObject) AObj: TImageObj; ACanvas: TCanvas; AX, AY: integer; AYBaseline: integer; AFO: TFontObj; end; procedure TDrawList.AddImage(Obj: TImageObj; Canvas: TCanvas; X, TopY, YBaseline: Integer; FO: TFontObj); var IR: TImageRec; begin IR := TImageRec.Create; IR.AObj := Obj; IR.ACanvas := Canvas; IR.AX := X; IR.AY := TopY; IR.AYBaseline := YBaseline; IR.AFO := FO; Add(IR); end; procedure TDrawList.DrawImages; var I: integer; Item: TObject; begin I := 0; while I < Count do {note: Count may increase during this operation} begin Item := Items[I]; if (Item is TImageRec) then with TImageRec(Item) do AObj.Draw(ACanvas, AX, AY, AYBaseline, AFO); Inc(I); end; end; {----------------TFormRadioButton.GetChecked:} function TFormRadioButton.GetChecked: Boolean; begin Result := FChecked; end; procedure TFormRadioButton.CreateWnd; begin inherited CreateWnd; SendMessage(Handle, BM_SETCHECK, Integer(FChecked), 0); end; procedure TFormRadioButton.SetChecked(Value: Boolean); begin if GetKeyState(vk_Tab) < 0 then {ignore if tab key down} Exit; if FChecked <> Value then begin FChecked := Value; TabStop := Value; if HandleAllocated then SendMessage(Handle, BM_SETCHECK, Integer(Checked), 0); if Value then begin inherited Changed; if not ClicksDisabled then Click; end; end; end; procedure TFormRadioButton.WMGetDlgCode(var Message: TMessage); begin Message.Result := DLGC_WantArrows; {else don't get the arrow keys} end; {----------------TFormCheckBox.WMGetDlgCode} procedure TFormCheckBox.WMGetDlgCode(var Message: TMessage); begin Message.Result := DLGC_WantArrows; {this to eat the arrow keys} end; {----------------ThtTabcontrol.Destroy} destructor ThtTabcontrol.Destroy; begin inherited; end; procedure ThtTabcontrol.WMGetDlgCode(var Message: TMessage); begin Message.Result := DLGC_WantArrows; {this to eat the arrow keys} end; {----------------LineRec.Create} constructor LineRec.Create(SL: TSectionList); begin inherited Create; if SL.InlineList.Count > 0 then FirstDraw := True; end; procedure LineRec.Clear; begin FreeAndNil(BorderList); end; destructor LineRec.Destroy; begin BorderList.Free; inherited; end; {----------------BorderRec.DrawTheBorder} procedure BorderRec.DrawTheBorder(Canvas: TCanvas; XOffset, YOffSet: integer; Printing: boolean); var IRect, ORect: TRect; begin IRect := BRect; Dec(IRect.Top, YOffSet); Dec(IRect.Bottom, YOffSet); Inc(IRect.Left, XOffset); Inc(IRect.Right, XOffset); if OpenStart then MargArray[BorderLeftStyle] := ord(bssNone); if OpenEnd then MargArray[BorderRightStyle] := ord(bssNone); if MargArray[BackgroundColor] <> clNone then begin Canvas.Brush.Color := MargArray[BackgroundColor] or PalRelative; Canvas.Brush.Style := bsSolid; Canvas.FillRect(IRect); end; ORect.Left := IRect.Left - MargArray[BorderLeftWidth]; ORect.Top := IRect.Top - MargArray[BorderTopWidth]; ORect.Right := IRect.Right + MargArray[BorderRightWidth]; ORect.Bottom := IRect.Bottom + MargArray[BorderBottomWidth]; DrawBorder(Canvas, ORect, IRect, htColors(MargArray[BorderLeftColor], MargArray[BorderTopColor], MargArray[BorderRightColor], MargArray[BorderBottomColor]), htStyles(BorderStyleType(MargArray[BorderLeftStyle]), BorderStyleType(MargArray[BorderTopStyle]), BorderStyleType(MargArray[BorderRightStyle]), BorderStyleType(MargArray[BorderBottomStyle])), MargArray[BackgroundColor], Printing) end; end.