frxexportmatrix.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{        Intermediate Export Matrix        }
{                                          }
{         Copyright (c) 1998-2008          }
{          by Alexander Fediachov,         }
{             Fast Reports Inc.            }
{                                          }
{******************************************}

unit frxExportMatrix;

{$I frx.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, graphics, frxClass, frxPreviewPages,
  frxProgress, Printers, frxUtils, frxUnicodeUtils
{$IFDEF Delphi10}
  , WideStrings
{$ENDIF};

type
  TfrxIEMObject = class;
  TfrxIEMObjectList = class;
  TfrxIEMStyle = class;
  TfrxIEMatrix = class;

  TfrxIEMatrix = class(TObject)
  private
    FIEMObjectList: TList;
    FIEMStyleList:  TList;
    FXPos: TList;
    FYPos: TList;
    FPages: TList;
    FWidth:     Integer;
    FHeight:    Integer;
    FMaxWidth:  Extended;
    FMaxHeight: Extended;
    FMinLeft:  Extended;
    FMinTop: Extended;
    FMatrix:    array of integer;
    FDeltaY: Extended;
    FShowProgress: Boolean;
    FMaxCellHeight: Extended;
    FMaxCellWidth: Extended;
    FInaccuracy: Extended;
    FProgress: TfrxProgress;
    FRotatedImage: Boolean;
    FPlainRich: Boolean;
    FRichText: Boolean;
    FCropFillArea: Boolean;
    FFillArea: Boolean;
    FOptFrames: Boolean;
    FLeft: Extended;
    FTop: Extended;
    FDeleteHTMLTags: Boolean;
    FBackImage: Boolean;
    FBackground: Boolean;
    FReport: TfrxReport;
    FPrintable: Boolean;
    FImages: Boolean;
    FWrap: Boolean;
    FEmptyLines: Boolean;
    FHeader: TfrxBand;
    FFooter: TfrxBand;
    FBrushAsBitmap: Boolean;
    FFontList: TStringList;
    FEMFPictures: Boolean;
    FDotMatrix: Boolean;
    function AddStyleInternal(Style: TfrxIEMStyle): integer;
    function AddStyle(Obj: TfrxView): integer;
    function AddInternalObject(Obj: TfrxIEMObject; x, y, dx, dy: integer): integer;
    function IsMemo(Obj: TfrxView): boolean;
    function IsLine(Obj: TfrxView): boolean;
    function IsRect(Obj: TfrxView): boolean;
    function QuickFind(aList: TList; aPosition: Extended; var Index: Integer): Boolean;
    procedure SetCell(x, y: integer; Value: integer);
    procedure FillArea(x, y, dx, dy: integer; Value: integer);
    procedure ReplaceArea(ObjIndex:integer; x, y, dx, dy: integer; Value: integer);
    procedure FindRectArea(x, y: integer; var dx, dy: integer);
    procedure CutObject(ObjIndex: Integer; x, y, dx, dy: integer);
    procedure CloneFrames(Obj1, Obj2: Integer);
    procedure AddPos(List: TList; Value: Extended);
    procedure OrderPosArray(List: TList; Vert: boolean);
    procedure OrderByCells;
    procedure Render;
    procedure Analyse;
    procedure OptimizeFrames;
  public
    constructor Create(const UseFileCache: Boolean; const TempDir: String);
    destructor Destroy; override;
    function GetFontCharset(Font: TFont): Integer;
    function GetCell(x, y: integer): integer;
    function GetObjectById(ObjIndex: integer): TfrxIEMObject;
    function GetStyleById(StyleIndex: integer): TfrxIEMStyle;
    function GetXPosById(PosIndex: integer): Extended;
    function GetYPosById(PosIndex: integer): Extended;
    function GetObject(x, y: integer): TfrxIEMObject;
    function GetStyle(x, y: integer): TfrxIEMStyle;
    function GetCellXPos(x: integer): Extended;
    function GetCellYPos(y: integer): Extended;
    procedure DeleteMatrixLine(y: Integer);
    function GetStylesCount: Integer;
    function GetPagesCount: Integer;
    function GetObjectsCount: Integer;
    procedure Clear;
    procedure AddObject(Obj: TfrxView);
    procedure AddDialogObject(Obj: TfrxReportComponent);
    procedure AddPage(Orientation: TPrinterOrientation; Width: Extended;
              Height: Extended; LeftMargin: Extended; TopMargin: Extended;
              RightMargin: Extended; BottomMargin: Extended);
    procedure Prepare;
    procedure GetObjectPos(ObjIndex: integer; var x, y, dx, dy: integer);
    function GetPageBreak(Page: integer): Extended;
    function GetPageWidth(Page: integer): Extended;
    function GetPageHeight(Page: integer): Extended;
    function GetPageLMargin(Page: integer): Extended;
    function GetPageTMargin(Page: integer): Extended;
    function GetPageRMargin(Page: integer): Extended;
    function GetPageBMargin(Page: integer): Extended;
    function GetPageOrientation(Page: integer): TPrinterOrientation;
    procedure SetPageHeader(Band: TfrxBand);
    procedure SetPageFooter(Band: TfrxBand);

    property Width: Integer read FWidth;
    property Height: Integer read FHeight;
    property MaxWidth: Extended read FMaxWidth;
    property MaxHeight: Extended read FMaxHeight;
    property MinLeft: Extended read FMinLeft;
    property MinTop: Extended read FMinTop;
    property ShowProgress: Boolean read FShowProgress write FShowProgress;
    property MaxCellHeight: Extended read FMaxCellHeight write FMaxCellHeight;
    property MaxCellWidth: Extended read FMaxCellWidth write FMaxCellWidth;
    property PagesCount: Integer read GetPagesCount;
    property StylesCount: Integer read GetStylesCount;
    property ObjectsCount: Integer read GetObjectsCount;
    property Inaccuracy: Extended read FInaccuracy write FInaccuracy;
    property RotatedAsImage: boolean read FRotatedImage write FRotatedImage;
    property RichText: boolean read FRichText write FRichText;
    property PlainRich: boolean read FPlainRich write FPlainRich;
    property AreaFill: boolean read FFillArea write FFillArea;
    property CropAreaFill: boolean read FCropFillArea write FCropFillArea;
    property FramesOptimization: boolean read FOptFrames write FOptFrames;
    property DeleteHTMLTags: Boolean read FDeleteHTMLTags write FDeleteHTMLTags;
    property Left: Extended read FLeft;
    property Top: Extended read FTop;
    property BackgroundImage: Boolean read FBackImage write FBackImage;
    property Background: Boolean read FBackground write FBackground;
    property Report: TfrxReport read FReport write FReport;
    property Printable: Boolean read FPrintable write FPrintable;
    property Images: Boolean read FImages write FImages;
    property WrapText: Boolean read FWrap write FWrap;
    property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
    property BrushAsBitmap: Boolean read FBrushAsBitmap write FBrushAsBitmap;
    property EMFPictures: Boolean read FEMFPictures write FEMFPictures;
    property DotMatrix: Boolean read FDotMatrix write FDotMatrix;
  end;

  TfrxIEMObject = class(TObject)
  private
    FMemo: TWideStrings;
    FURL: String;
    FStyleIndex: Integer;
    FStyle: TfrxIEMStyle;
    FIsText: Boolean;
    FIsRichText: Boolean;
    FIsDialogObject: Boolean;
    FLeft: Extended;
    FTop: Extended;
    FWidth: Extended;
    FHeight: Extended;
    FImage: TBitmap;
    FParent: TfrxIEMObject;
    FCounter: Integer;
    FLink: TObject;
    FRTL: Boolean;
    FAnchor: String;
    FCached: Boolean;
    FFooter: Boolean;
    FHeader: Boolean;
    FName: String;
    FHTMLTags: Boolean;
    FMetafile: TMetafile;
    FMetafileCanvas: TMetafileCanvas;
    procedure SetMemo(const Value: TWideStrings);
    function GetImage: TBitmap;
    procedure SetImage(const Value: TBitmap);
  public
    constructor Create;
    destructor Destroy; override;
    property Memo: TWideStrings read FMemo write SetMemo;
    property URL: String read FURL write FURL;
    property StyleIndex: Integer read FStyleIndex write FStyleIndex;
    property IsText: Boolean read FIsText write FIsText;
    property IsRichText: Boolean read FIsRichText write FIsRichText;
    property IsDialogObject: Boolean read FIsDialogObject write FIsDialogObject;
    property Left: Extended read FLeft write FLeft;
    property Top: Extended read FTop write FTop;
    property Width: Extended read FWidth write FWidth;
    property Height: Extended read FHeight write FHeight;
    property Image: TBitmap read GetImage write SetImage;
    property Parent: TfrxIEMObject read FParent write FParent;
    property Style: TfrxIEMStyle read FStyle write FStyle;
    property Counter: Integer read FCounter write FCounter;
    property Link: TObject read FLink write FLink;
    property RTL: Boolean read FRTL write FRTL;
    property Anchor: String read FAnchor write FAnchor;
    property Cached: Boolean read FCached write FCached;
    property Footer: Boolean read FFooter write FFooter;
    property Header: Boolean read FHeader write FHeader;
    property Name: String read FName write FName;
    property HTMLTags: Boolean read FHTMLTags write FHTMLTags;
    property Metafile: TMetafile read FMetafile;
    property MetafileCanvas: TMetafileCanvas read FMetafileCanvas write FMetafileCanvas;
  end;

  TfrxIEMObjectList = class(TObject)
  public
    Obj: TfrxIEMObject;
    x, y, dx, dy : Integer;
    Exist: Boolean;
    constructor Create;
    destructor Destroy; override;
  end;

  TfrxIEMPos = class(TObject)
  public
    Value: Extended;
  end;

  TfrxIEMPage = class(TObject)
  public
    Value: Extended;
    Orientation: TPrinterOrientation;
    Width: Extended;
    Height: Extended;
    LeftMargin: Extended;
    TopMargin:Extended;
    BottomMargin: Extended;
    RightMargin:Extended;
  end;

  TfrxIEMStyle = class(TObject)
  public
    Font:        TFont;
    LineSpacing: Extended;
    VAlign:      TfrxVAlign;
    HAlign:      TfrxHAlign;
    FrameTyp:    TfrxFrameTypes;
    FrameWidth:  Single;
    FrameColor:  TColor;
    FrameStyle:  TfrxFrameStyle;
    Color:       TColor;
    Rotation:    Integer;
    BrushStyle:  TBrushStyle;
    ParagraphGap: Extended;
    GapX: Extended;
    GapY: Extended;
    CharSpacing: Extended;
    WordBreak: Boolean;
    Charset: Integer;
    FDisplayFormat: TfrxFormat;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Style: TfrxIEMStyle);
    procedure SetDisplayFormat(const Value: TfrxFormat);

    property DisplayFormat: TfrxFormat read FDisplayFormat write SetDisplayFormat;
  end;

implementation

uses frxres, frxrcExports;

{ TfrxIEMatrix }

const
  EMF_DIV = 0.911;
  MAX_POS_SEARCH_DEPTH = 100;
  DOT_MATRIX_FONT_SIZE = 9;

constructor TfrxIEMatrix.Create(const UseFileCache: Boolean; const TempDir: String);
begin
  FFontList := TStringList.Create;
  FIEMObjectList := TList.Create;
  FIEMStyleList := TList.Create;
  FXPos := TList.Create;
  FYPos := TList.Create;
  FPages := TList.Create;
  FMaxWidth := 0;
  FMaxHeight := 0;
  FMinLeft := 99999;
  FMinTop := 99999;
  FDeltaY := 0;
  FMaxCellHeight := 0;
  FShowProgress := true;
  FInaccuracy := 0;
  FRotatedImage := false;
  FPlainRich := true;
  FRichText := false;
  FFillArea := false;
  FCropFillArea := false;
  FOptFrames := false;
  FTop := 0;
  FLeft := 0;
  FBackImage := False;
  FBackground := False;
  FReport := nil;
  FPrintable := True;
  FImages := True;
  FWrap := False;
  FEmptyLines := True;
  FHeader := nil;
  FFooter := nil;
  FBrushAsBitmap := True;
  FEMFPictures := False;
  FDotMatrix := False;
end;

destructor TfrxIEMatrix.Destroy;
begin
  Clear;
  FXPos.Free;
  FYPos.Free;
  FFontList.Free;
  FIEMObjectList.Free;
  FIEMStyleList.Free;
  FPages.Free;
  inherited;
end;

function TfrxIEMatrix.AddInternalObject(Obj: TfrxIEMObject; x, y, dx, dy: integer): integer;
var
  FObjItem: TfrxIEMObjectList;
begin
  FObjItem := TfrxIEMObjectList.Create;
  FObjItem.x := x;
  FObjItem.y := y;
  FObjItem.dx := dx;
  FObjItem.dy := dy;
  FObjItem.Obj := Obj;
  FIEMObjectList.Add(FObjItem);
  Result := FIEMObjectList.Count - 1;
end;

procedure TfrxIEMatrix.AddObject(Obj: TfrxView);
var
  dx, dy, fdx, fdy: Extended;
  FObj: TfrxIEMObject;
  DrawPosX, DrawPosY: Extended;
  Memo: TfrxCustomMemoView;
  Line: TfrxCustomLineView;
  OldFrameWidth: Extended;
  FRealBounds: TfrxRect;
begin
  if (Obj.Name = '_pagebackground') and
     (not FBackground) and (FPrintable or Obj.Printable)
  then
    Exit;
  OldFrameWidth := 0;

  if Obj.Frame.DropShadow and (Obj is TfrxCustomMemoView) then
  begin
    Obj.Width := Obj.Width - Obj.Frame.ShadowWidth;
    Obj.Height := Obj.Height - Obj.Frame.ShadowWidth;
    Obj.Frame.DropShadow := False;
    AddObject(Obj);
    Obj.Width := Obj.Width + Obj.Frame.ShadowWidth;
    Obj.Height := Obj.Height + Obj.Frame.ShadowWidth;
    Obj.Frame.DropShadow := True;
    Memo := TfrxCustomMemoView.Create(nil);
    try
      Memo.Name := 'Shadow';
      Memo.Font.Size := 1;
      Memo.Color := Obj.Frame.ShadowColor;
      Memo.Left := Obj.AbsLeft + Obj.Width - Obj.Frame.ShadowWidth;
      Memo.Top := Obj.AbsTop + Obj.Frame.ShadowWidth;
      Memo.Width := Obj.Frame.ShadowWidth;
      Memo.Height := Obj.Height - Obj.Frame.ShadowWidth;
      AddObject(Memo);
      Memo.Left := Obj.AbsLeft + Obj.Frame.ShadowWidth;
      Memo.Top := Obj.AbsTop +  Obj.Height - Obj.Frame.ShadowWidth;
      Memo.Width := Obj.Width - Obj.Frame.ShadowWidth;
      Memo.Height := Obj.Frame.ShadowWidth;
      AddObject(Memo);
    finally
      Memo.Free;
    end;
    exit;
  end;

  if (Obj.ClassName = 'TfrxRichView') and FRichText and FPlainRich then
  begin
    Memo := TfrxCustomMemoView.Create(nil);
    try
      Obj.PlainText := True;
      Memo.Lines.Text := AnsiToUnicode(AnsiString(Obj.GetComponentText), DEFAULT_CHARSET);
      Memo.Name := Obj.Name;
      Memo.Left := Obj.AbsLeft;
      Memo.Top := Obj.AbsTop;
      Memo.Width := Obj.Width;
      Memo.Height := Obj.Height;
      AddObject(Memo);
    finally
      Obj.PlainText := False;
      Memo.Free;
    end;
    exit;
  end;

  FObj := TfrxIEMObject.Create;
  FObj.Name := Obj.Name;
  FObj.StyleIndex := AddStyle(Obj);
  if FObj.StyleIndex <> -1 then
    FObj.Style := TfrxIEMStyle(FIEMStyleList[FObj.StyleIndex]);
  FObj.URL :=Obj.URL;
  if Assigned(FReport) and (FObj.URL <> '') and (FObj.URL[1] = '#') then
    FObj.URL := '@' + IntToStr(TfrxPreviewPages(FReport.PreviewPages).GetAnchorPage(StringReplace(FObj.URL, '#', '', [])));

  if Obj.AbsLeft >= 0 then
    FObj.Left := Obj.AbsLeft