htmlsubs.pas

查看html文件的控件

    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: TCell;

    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 <b>, <i>, 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;

  ThtTabcontrol = class(TWinControl)  
  private
    procedure WMGetDlgCode(var Message: TMessage); message WM_GETDLGCODE;  
  protected
    property OnEnter;
    property OnExit;
    property TabStop;
    property OnKeyUp;
  public
    destructor Destroy; override;
  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;
      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;
      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]), Self);
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;