frxexportmatrix.pas

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

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

unit frxExportMatrix;

{$I frx.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, graphics, frxClass, frxPreviewPages,
  frxProgress, Printers;

type
  TfrxIEMObject = class;
  TfrxIEMObjectList = class;
  TfrxIEMStyle = 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;
    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;
    destructor Destroy; override;
    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;
    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;
  published
    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;
  end;

  TfrxIEMObject = class(TObject)
  private
    FMemo: TStrings;
    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;
    FDisplayFormat: TfrxFormat;
    FRTL: Boolean;
    FAnchor: String;
    procedure SetMemo(const Value: TStrings);
    procedure SetDisplayFormat(const Value: TfrxFormat);
  public
    constructor Create;
    destructor Destroy; override;
  published
    property Memo: TStrings 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 FImage write FImage;
    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 DisplayFormat: TfrxFormat read FDisplayFormat write SetDisplayFormat;
    property RTL: Boolean read FRTL write FRTL;
    property Anchor: String read FAnchor write FAnchor;
  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;
    GapX: Extended;
    GapY: Extended;
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Style: TfrxIEMStyle);
  end;

implementation

uses frxres, frxrcExports;

{ TfrxIEMatrix }

const
  MAX_POS_SEARCH_DEPTH = 100;

constructor TfrxIEMatrix.Create;
begin
  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;
end;

destructor TfrxIEMatrix.Destroy;
begin
  Clear;
  FXPos.Free;
  FYPos.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: Extended;
  FObj: TfrxIEMObject;
  DrawPosX, DrawPosY: Extended;
  Memo: TfrxCustomMemoView;
  Line: TfrxCustomLineView;
  OldFrameWidth: Extended;
begin
  if ((Obj.Name = '_pagebackground') {or (Obj.Name = '')}) 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);
    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);
    Memo.Free;
    exit;
  end;

  FObj := TfrxIEMObject.Create;
  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
  else FObj.Left := 0;
  if Obj.AbsTop >= 0 then
    FObj.Top := FDeltaY + Obj.AbsTop
  else FObj.Top := FDeltaY;
  FObj.Width := Obj.Width;
  FObj.Height := Obj.Height;
  if IsMemo(Obj) then
  begin
    // Memo
    if FDeleteHTMLTags and TfrxCustomMemoView(Obj).AllowHTMLTags then
      FObj.Memo.Text := TfrxCustomMemoView(Obj).WrapText(False)
    else
      FObj.Memo := TfrxCustomMemoView(Obj).Memo;
    FObj.IsText := True;
    FObj.IsRichText := False;
    FObj.RTL := TfrxCustomMemoView(Obj).RTLReading;
    FObj.DisplayFormat := TfrxCustomMemoView(Obj).DisplayFormat;
  end
  else if (Obj.ClassName = 'TfrxRichView') and (FRichText) then
  begin
    // Rich
    FObj.IsText := True;
    FObj.IsRichText := True;
    FObj.Memo.Text := Obj.GetComponentText;
  end
  else if IsLine(Obj) then
  begin
    // Line
    FObj.IsText := True;
    FObj.IsRichText := False;
    if FObj.Left > (FObj.Left + FObj.Width) then
    begin
      FObj.Left := FObj.Left + FObj.Width;
      FObj.Width := -FObj.Width;
    end;
    if FObj.Top > (FObj.Top + Obj.Height) then
    begin
      FObj.Top := FObj.Top + FObj.Height;
      FObj.Height := -FObj.Height;
    end;
    if FObj.Width = 0 then
      if FInaccuracy < 1 then FObj.Width := 1
      else FObj.Width := FInaccuracy;
    if FObj.Height = 0 then
      if FInaccuracy < 1 then FObj.Height := 1
      else FObj.Height := FInaccuracy;
  end
  else if IsRect(Obj) then
  begin
    if Obj.Color = clNone then
    begin
      // Rect as lines
      Line := TfrxCustomLineView.Create(nil);
      Line.Name := 'Line';
      Line.Frame.Assign(Obj.Frame);
      Line.Left := Obj.AbsLeft;
      Line.Top := Obj.AbsTop;
      Line.Width := Obj.Width;
      Line.Height := 0;
      AddObject(Line);
      Line.Left := Obj.AbsLeft;
      Line.Top := Obj.AbsTop;
      Line.Width := 0;
      Line.Height := Obj.Height;
      AddObject(Line);
      Line.Left := Obj.AbsLeft;
      Line.Top := Obj.AbsTop + Obj.Height;
      Line.Width := Obj.Width;
      Line.Height := 0;
      AddObject(Line);
      Line.Left := Obj.AbsLeft + Obj.Width;
      Line.Top := Obj.AbsTop;
      Line.Width := 0;
      Line.Height := Obj.Height;
      AddObject(Line);
      Line.Free;
    end else
    begin
      // Rect as memo
      Memo := TfrxCustomMemoView.Create(nil);
      Memo.Frame.Assign(Obj.Frame);
      Memo.Name := 'Rect';
      Memo.Color := Obj.Color;
      Memo.Left := Obj.AbsLeft;
      Memo.Top := Obj.AbsTop;
      Memo.Width := Obj.Width;
      Memo.Height := Obj.Height;
      Memo.Frame.Typ := [ftLeft, ftTop, ftRight, ftBottom];
      Memo.Font.Size := 1;
      AddObject(Memo);
      Memo.Free;
    end;
    FObj.Free;
    Exit;
  end
  else begin
    // Bitmap
    if not ((Obj.Name = '_pagebackground') and (not FBackImage)) then
    begin
      if (Obj.Frame.Typ <> []) and (Obj.Frame.Width > 0) then
      begin
        OldFrameWidth := Obj.Frame.Width;
        Obj.Frame.Width := 0;
      end;
      FObj.IsText := False;
      FObj.IsRichText := False;
      dx := Obj.Width;
      dy := Obj.Height;
      DrawPosX := Obj.AbsLeft;
      DrawPosY := Obj.AbsTop;
      if Round(dx) = 0 then
        dx := 1;