frxgraphicutils.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Graphic routines }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxGraphicUtils;

interface

{$I frx.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  frxClass
{$IFDEF Delphi6}
, Variants
{$ENDIF};

type
  TIntArray = array[1..MaxInt div 4] of Integer;
  PIntArray = ^TIntArray;

  TfrxHTMLTag = class(TObject)
  public
    Position:Integer;
    Size:Integer;
    AddY:Integer;
    Style:TFontStyles;
    Color:Integer;
    Default:Boolean;
    Small:Boolean;
    procedure Assign(Tag:TfrxHTMLTag);
  end;

  TfrxHTMLTags = class(TObject)
  private
    FItems:TList;
    procedure Add(Tag:TfrxHTMLTag);
    function GetItems(Index:Integer):TfrxHTMLTag;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    function Count:Integer;
    property Items[Index:Integer]:TfrxHTMLTag read GetItems; default;
  end;

  TfrxHTMLTagsList = class(TObject)
  private
    FAllowTags:Boolean;
    FAddY:Integer;
    FColor:LongInt;
    FDefColor:LongInt;
    FDefSize:Integer;
    FDefStyle:TFontStyles;
    FItems:TList;
    FPosition:Integer;
    FSize:Integer;
    FStyle:TFontStyles;
    FTempArray:PIntArray;
    procedure NewLine;
    procedure Wrap(TagsCount:Integer; AddBreak:Boolean);
    function Add:TfrxHTMLTag;
    function FillCharSpacingArray(var ar:PIntArray; const s:String;
      Canvas:TCanvas; LineIndex, Add:Integer; Convert:Boolean):Integer;
    function GetItems(Index:Integer):TfrxHTMLTags;
    function GetPrevTag:TfrxHTMLTag;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure SetDefaults(DefColor:TColor; DefSize:Integer;
      DefStyle:TFontStyles);
    procedure ExpandHTMLTags(var s:String);
    function Count:Integer;
    property AllowTags:Boolean read FAllowTags write FAllowTags;
    property Items[Index:Integer]:TfrxHTMLTags read GetItems; default;
    property Position:Integer read FPosition write FPosition;
  end;

  TfrxDrawText = class(TObject)
  private
// internals
    FBMP:TBitmap;
    FLocked:Boolean;
    FCanvas:TCanvas;
    FDefPPI:Integer;
    FScrPPI:Integer;
    FTempArray:PIntArray;

// data passed by SetXXX calls
    FFontSize:Integer;
    FHTMLTags:TfrxHTMLTagsList;
    FCharSpacing:Extended;
    FLineSpacing:Extended;
    FOptions:Integer;
    FOriginalRect:TRect;
    FParagraphGap:Extended;
    FPlainText:String;
    FRotation:Integer;
    FRTLReading:Boolean;
    FScaledRect:TRect;
    FScaleX:Extended;
    FScaleY:Extended;
    FText:TStrings;
    FWordBreak:Boolean;
    FWordWrap:Boolean;

    function IsPrinter(C:TCanvas):Boolean;
    procedure DrawTextLine(C:TCanvas; const s:String;
      X, Y, DX, LineIndex:Integer; Align:TfrxHAlign; var fh, oldfh:HFont);
    procedure WrapTextLine(s:String; Width, FirstLineWidth,
      CharSpacing:Integer);
  public
    constructor Create;
    destructor Destroy; override;

// Call these methods in the same order
    procedure SetFont(Font:TFont);
    procedure SetOptions(WordWrap, HTMLTags, RTLReading, WordBreak,
      Clipped:Boolean; Rotation:Integer);
    procedure SetGaps(ParagraphGap, CharSpacing, LineSpacing:Extended);
    procedure SetDimensions(ScaleX, ScaleY:Extended; OriginalRect, ScaledRect:TRect);
    procedure SetText(Text:TStrings);
    function DeleteTags(const Txt:String):String;

// call these methods only after methods listed above
    procedure DrawText(C:TCanvas; HAlign:TfrxHAlign; VAlign:TfrxVAlign);
    function CalcHeight:Extended;
    function CalcWidth:Extended;
    function LineHeight:Extended;
// returns the text that don't fit in the bounds
    function GetInBoundsText:String;
    function GetOutBoundsText:String;
    function UnusedSpace:Extended;

// call these methods before and after doing something
    procedure Lock;
    procedure Unlock;

    property Canvas:TCanvas read FCanvas;
    property DefPPI:Integer read FDefPPI;
    property ScrPPI:Integer read FScrPPI;
    property WrappedText:TStrings read FText;
  end;

var
  frxDrawText:TfrxDrawText;

implementation

uses frxPrinter;

const
  glasn:String = '琅ㄈ斡圯捱';
  soglasn:String = '谅媚魄墒颂拖醒以罩棕佘