1973 lines
57 KiB
ObjectPascal
1973 lines
57 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Intermediate Export Matrix }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxExportMatrix;
|
|
|
|
{$I frx.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
{$IFNDEF FPC}Windows, Messages,{$ENDIF}
|
|
SysUtils, Classes, Graphics, frxClass, frxPreviewPages, frxBaseGraphicsTypes,
|
|
frxProgress, Printers, frxUtils, frxUnicodeUtils, frxPictureCache,
|
|
frxPictureGraphics, frxExportHelpers
|
|
{$IFDEF FPC}
|
|
, LResources, LCLType, LCLProc, LazHelper
|
|
{$ENDIF}
|
|
{$IFDEF Delphi10}
|
|
, WideStrings
|
|
{$ENDIF}
|
|
{$IFDEF DELPHI16}
|
|
, System.UITypes
|
|
{$ENDIF}
|
|
;
|
|
|
|
type
|
|
TfrxIEMObject = class;
|
|
TfrxIEMObjectList = class;
|
|
TfrxIEMStyle = class;
|
|
TfrxIEMatrix = class;
|
|
TfrxIEMPage = 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;
|
|
{$IFNDEF FPC}
|
|
FEMFPictures: Boolean;
|
|
{$ENDIF}
|
|
FDotMatrix: Boolean;
|
|
FPrevObject: TfrxIEMObject;
|
|
FPictureCache: TfrxPictureCache;
|
|
FGHelper: TfrxCustomGraphicFormatClass;
|
|
FVertorGHelper: TfrxCustomGraphicFormatClass;
|
|
FOnGetURL: TOnProcessHyperLink;
|
|
FParentDetailURL: String;
|
|
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;
|
|
function GetIEPages(Index: Integer): TfrxIEMPage;
|
|
public
|
|
constructor Create(const UseFileCache: Boolean; const TempDir: String; CacheType: TfrxThumbnailBuildType = tbtNone; CalculateHash: Boolean = False);
|
|
destructor Destroy; override;
|
|
function GetObjectBounds(Obj: TfrxIEMObject): TfrxRect;
|
|
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;
|
|
function GetPicturesCount: Integer;
|
|
procedure Clear;
|
|
procedure AddObject(aObj: TfrxView);
|
|
procedure AddDialogObject(Obj: TfrxReportComponent);
|
|
procedure AddPage(Orientation: TPrinterOrientation; Width: Extended;
|
|
Height: Extended; LeftMargin: Extended; TopMargin: Extended;
|
|
RightMargin: Extended; BottomMargin: Extended; MirrorMargins: Boolean; Index: Integer);
|
|
procedure Prepare;
|
|
procedure GetObjectPos(ObjIndex: integer; var x, y, dx, dy: integer);
|
|
function IsExist(ObjIndex: integer): Boolean;
|
|
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 GetPageMirrorMargin(Page: integer): Boolean;
|
|
function GetPageOrientation(Page: integer): TPrinterOrientation;
|
|
procedure SetPageHeader(Band: TfrxBand);
|
|
procedure SetPageFooter(Band: TfrxBand);
|
|
procedure SetGraphicType(const TypeName: String);
|
|
|
|
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;
|
|
{$IFNDEF FPC}
|
|
property EMFPictures: Boolean read FEMFPictures write FEMFPictures;
|
|
{$ENDIF}
|
|
property DotMatrix: Boolean read FDotMatrix write FDotMatrix;
|
|
property IEPages[Index: Integer]: TfrxIEMPage read GetIEPages;
|
|
property OnGetURL: TOnProcessHyperLink read FOnGetURL write FOnGetURL;
|
|
property ParentDetailURL: String read FParentDetailURL write FParentDetailURL;
|
|
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: IfrxCachedGraphic;
|
|
FParent: TfrxIEMObject;
|
|
FCounter: Integer;
|
|
FLink: TObject;
|
|
FRTL: Boolean;
|
|
FAnchor: String;
|
|
FCached: Boolean;
|
|
FFooter: Boolean;
|
|
FHeader: Boolean;
|
|
FName: String;
|
|
FHTMLTags: Boolean;
|
|
FIsMetaFile: Boolean;
|
|
FImageIndex: LongInt;
|
|
FPictureCache: TfrxPictureCache;
|
|
FLineSpacing: Extended;
|
|
procedure SetMemo(const Value: TWideStrings);
|
|
function GetImage: TGraphic;
|
|
{procedure SetImage(const Value: TGraphic);}
|
|
public
|
|
constructor Create(aPictureCache: TfrxPictureCache);
|
|
destructor Destroy; override;
|
|
procedure UnloadImage;
|
|
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: TGraphic 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 LineSpacing: Extended read FLineSpacing write FLineSpacing;
|
|
property ImageIndex: Integer read FImageIndex;
|
|
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;
|
|
MirrorMargin: Boolean;
|
|
PrintOnPreviousPage: Boolean;
|
|
PageName: String;
|
|
end;
|
|
|
|
TfrxIEMStyle = class(TObject)
|
|
public
|
|
Font: TFont;
|
|
LineSpacing: Extended;
|
|
VAlign: TfrxVAlign;
|
|
HAlign: TfrxHAlign;
|
|
FrameTyp: TfrxFrameTypes;
|
|
LeftLine: TfrxFrameLine;
|
|
TopLine: TfrxFrameLine;
|
|
RightLine: TfrxFrameLine;
|
|
BottomLine: TfrxFrameLine;
|
|
Color: TColor;
|
|
Rotation: Integer;
|
|
BrushStyle: TBrushStyle;
|
|
ParagraphGap: Extended;
|
|
GapX: Extended;
|
|
GapY: Extended;
|
|
CharSpacing: Extended;
|
|
WordBreak: Boolean;
|
|
Charset: Integer;
|
|
FDisplayFormat: TfrxFormat;
|
|
WordWrap: Boolean;
|
|
|
|
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; CacheType: TfrxThumbnailBuildType = tbtNone; CalculateHash: Boolean = False);
|
|
begin
|
|
FPictureCache := TfrxPictureCache.Create;
|
|
FPictureCache.PictureCacheOptions.CalculateHash := CalculateHash;
|
|
FPictureCache.UseFileCache := UseFileCache;
|
|
FPictureCache.TempDir := TempDir;
|
|
if CacheType <> tbtNone then
|
|
FPictureCache.PictureCacheOptions.CachedImagesBuildType := tbtOriginal;
|
|
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;
|
|
{$IFNDEF FPC}
|
|
FEMFPictures := False;
|
|
{$ENDIF}
|
|
FDotMatrix := False;
|
|
FPrevObject := nil;
|
|
FGHelper := GetGraphicFormats.FindByName('PNG');
|
|
if not Assigned(FGHelper) then
|
|
FGHelper := GetGraphicFormats.FindByName('BMP');
|
|
FVertorGHelper := GetGraphicFormats.FindByName('FREMF');
|
|
FOnGetURL := nil;
|
|
end;
|
|
|
|
destructor TfrxIEMatrix.Destroy;
|
|
begin
|
|
Clear;
|
|
FXPos.Free;
|
|
FYPos.Free;
|
|
FFontList.Free;
|
|
FIEMObjectList.Free;
|
|
FIEMStyleList.Free;
|
|
FPages.Free;
|
|
FPictureCache.Free;
|
|
FGHelper := nil;
|
|
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(aObj: TfrxView);
|
|
var
|
|
dx, dy, fdx, fdy: Extended;
|
|
FObj: TfrxIEMObject;
|
|
DrawPosX, DrawPosY: Extended;
|
|
Memo: TfrxCustomMemoView;
|
|
Line: TfrxCustomLineView;
|
|
OldFrameWidth: Extended;
|
|
FRealBounds: TfrxRect;
|
|
ScaleX, ScaleY: Extended;
|
|
LGHelper: TfrxCustomGraphicFormatClass;
|
|
CanvasH: TfrxGraphicCanvasHelper;
|
|
LGraphic: TGraphic;
|
|
LtColor: TColor;
|
|
Pic: TfrxPicture;
|
|
Transparent, IsVector, IsAlpha: Boolean;
|
|
|
|
procedure AddObj(Obj: TfrxView);
|
|
begin
|
|
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(FPictureCache);
|
|
FObj.Name := Obj.Name;
|
|
FObj.StyleIndex := AddStyle(Obj);
|
|
if FObj.StyleIndex <> -1 then
|
|
FObj.Style := TfrxIEMStyle(FIEMStyleList[FObj.StyleIndex]);
|
|
|
|
if Assigned(FOnGetURL) then
|
|
FObj.FURL := FOnGetURL(Obj.Hyperlink, Self.FParentDetailURL)
|
|
else if Obj.URL <> '' then
|
|
FObj.URL := Obj.URL
|
|
else if (Obj.Hyperlink.Kind = hkURL) and (Obj.Hyperlink.Value <> '') then
|
|
FObj.URL := Obj.Hyperlink.Value;
|
|
|
|
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) or FWrap
|
|
then
|
|
FObj.Memo.Text := TfrxCustomMemoView(Obj).WrapText(true)
|
|
else
|
|
FObj.Memo := TfrxCustomMemoView(Obj).Memo;
|
|
if not FDeleteHTMLTags then
|
|
FObj.HTMLTags := TfrxCustomMemoView(Obj).AllowHTMLTags;
|
|
{ if TfrxCustomMemoView(Obj).Font.Charset <> DEFAULT_CHARSET then }
|
|
if TfrxCustomMemoView(Obj).Font.Charset = OEM_CHARSET then
|
|
FObj.Memo.Text :=
|
|
AnsiToUnicode(OemToStr(_UnicodeToAnsi(FObj.Memo.Text, OEM_CHARSET)),
|
|
DEFAULT_CHARSET);
|
|
{ FObj.Memo.Text := AnsiToUnicode(FObj.Memo.Text, TfrxCustomMemoView(Obj).Font.Charset)
|
|
else }
|
|
FObj.IsText := true;
|
|
FObj.IsRichText := false;
|
|
FObj.RTL := TfrxCustomMemoView(Obj).RTLReading;
|
|
FObj.LineSpacing := TfrxCustomMemoView(Obj).LineSpacing;
|
|
end
|
|
else if (Obj.ClassName = 'TfrxRichView') and (FRichText) then
|
|
begin
|
|
// Rich
|
|
FObj.IsText := true;
|
|
FObj.IsRichText := true;
|
|
FObj.Memo.Text := AnsiToUnicode(AnsiString(Obj.GetComponentText),
|
|
DEFAULT_CHARSET);
|
|
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
|
|
FObj.Width := 1;
|
|
if FObj.Height = 0 then
|
|
FObj.Height := 1;
|
|
end
|
|
else if IsRect(Obj) or (Obj.ClassName = 'TfrxGradientView') 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(IsPageBG(Obj) and (not FBackImage))) and
|
|
FImages and (Obj.ClassName <> 'TfrxGradientView') 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;
|
|
|
|
FRealBounds := Obj.GetRealBounds;
|
|
dx := FRealBounds.Right - FRealBounds.Left;
|
|
dy := FRealBounds.Bottom - FRealBounds.Top;
|
|
|
|
if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
|
|
fdx := 0
|
|
else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
|
|
fdx := (dx - Obj.Width)
|
|
else
|
|
fdx := (dx - Obj.Width) / 2;
|
|
|
|
if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
|
|
fdy := 0
|
|
else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
|
|
fdy := (dy - Obj.Height)
|
|
else
|
|
fdy := (dy - Obj.Height) / 2;
|
|
|
|
DrawPosX := Obj.AbsLeft - fdx;
|
|
DrawPosY := Obj.AbsTop - fdy;
|
|
FObj.Left := FObj.Left - fdx;
|
|
FObj.Top := FObj.Top - fdy;
|
|
|
|
if Round(dx) = 0 then
|
|
dx := 1;
|
|
if dx < 0 then
|
|
begin
|
|
dx := -dx;
|
|
FObj.Left := FObj.Left - dx;
|
|
DrawPosX := DrawPosX - dx;
|
|
end;
|
|
if Round(dy) = 0 then
|
|
dy := 1;
|
|
if dy < 0 then
|
|
begin
|
|
dy := -dy;
|
|
FObj.Top := FObj.Top - dy;
|
|
DrawPosY := DrawPosY - dy;
|
|
end;
|
|
FObj.Width := dx;
|
|
FObj.Height := dy;
|
|
{ part of shape frames are outbound }
|
|
if (Obj is TfrxShapeView){$IFNDEF FPC} and not FEMFPictures{$ENDIF} then
|
|
begin
|
|
dx := dx + 1;
|
|
dy := dy + 1;
|
|
end;
|
|
LGraphic := nil;
|
|
LGHelper := nil;
|
|
Pic := nil;
|
|
try
|
|
{$IFNDEF FPC}
|
|
if FEMFPictures and Assigned(FVertorGHelper) then
|
|
begin
|
|
LGraphic := FVertorGHelper.CreateNew(Round(dx), Round(dy), pf32bit, True);
|
|
|
|
if (Obj is TfrxCustomLineView) and (OldFrameWidth > 0) then
|
|
Obj.Frame.Width := OldFrameWidth;
|
|
|
|
CanvasH := FVertorGHelper.CreateCanvasHelper(LGraphic);
|
|
CanvasH.Canvas.Lock;
|
|
try
|
|
Obj.Draw(CanvasH.Canvas, 1, 1, -DrawPosX, -DrawPosY);
|
|
except
|
|
// charts may throw exceptions when number are malformed
|
|
end;
|
|
CanvasH.Canvas.Unlock;
|
|
CanvasH.Free;
|
|
|
|
if OldFrameWidth > 0 then
|
|
Obj.Frame.Width := OldFrameWidth;
|
|
end
|
|
else
|
|
{$ENDIF}
|
|
begin
|
|
{ the scale factor need to draw some objects at least 1:1 }
|
|
{ like barcodes with small Zoom to make'em readable }
|
|
ScaleX := 1;
|
|
ScaleY := 1;
|
|
TfrxView(Obj).GetScaleFactor(ScaleX, ScaleY);
|
|
if ScaleX > 1 then ScaleX := 1;
|
|
if ScaleY > 1 then ScaleY := 1;
|
|
LGHelper := nil;
|
|
|
|
LtColor := clNone;
|
|
Transparent := False;
|
|
if (Obj is TfrxPictureView) and not TfrxPictureView(Obj).IsEmpty then
|
|
begin
|
|
LGHelper := GetGraphicFormats.FindByGraphic(TGraphicClass(TfrxPictureView(Obj).GetGraphic.ClassType), [gcSaveTo, gcLoadFrom, gcDraw, gcConvert, gcConvertToBitmap]);
|
|
IsAlpha := LGHelper.HasAlphaChanel(TfrxPictureView(Obj).GetGraphic);
|
|
Transparent := IsAlpha or TfrxPictureView(Obj).Transparent;
|
|
if (Obj.Color <> clNone) then
|
|
begin
|
|
IsAlpha := False;
|
|
Transparent := False;
|
|
end;
|
|
if TfrxPictureView(Obj).Transparent then
|
|
LtColor := TfrxPictureView(Obj).TransparentColor;
|
|
if (LtColor = clNone) and LGHelper.HasMaskColor(TfrxPictureView(Obj).GetGraphic) then
|
|
begin
|
|
Transparent := True;
|
|
LtColor := LGHelper.GetTransparentColor(TfrxPictureView(Obj).GetGraphic);
|
|
end;
|
|
IsVector := LGHelper.IsVector;
|
|
if Transparent then
|
|
LGHelper := FGHelper;
|
|
if FGHelper = nil then
|
|
LGHelper := GetGraphicFormats.FindByGraphic(TGraphicClass(TfrxPictureView(Obj).GetGraphic.ClassType), [gcSaveTo, gcLoadFrom, gcGetCanvas, gcDraw, gcConvert, gcConvertToBitmap]);
|
|
end;
|
|
if LGHelper = nil then
|
|
LGHelper := FGHelper;
|
|
Pic := TfrxPicture.Create(PictureFormatFromGraphicHelper(LGHelper), Round(dx / ScaleX), Round(dy / ScaleY), Transparent, IsVector, IsAlpha);
|
|
try
|
|
if Transparent and (LtColor <> clNone) then
|
|
Pic.SetTransparentColor(LtColor)
|
|
else
|
|
Pic.FillColor(Obj.Color);
|
|
Pic.Canvas.Lock;
|
|
try
|
|
if (Obj is TfrxCustomLineView) and (OldFrameWidth > 0) then
|
|
Obj.Frame.Width := OldFrameWidth;
|
|
TfrxView(Obj).Draw(Pic.Canvas, 1 / ScaleX, 1 / ScaleY, -DrawPosX / ScaleX, -DrawPosY / ScaleY);
|
|
finally
|
|
Pic.Canvas.Unlock;
|
|
end;
|
|
finally
|
|
LGraphic := Pic.Release;;
|
|
end;
|
|
if OldFrameWidth > 0 then
|
|
Obj.Frame.Width := OldFrameWidth;
|
|
end;
|
|
finally
|
|
if (LGraphic.Width <> 0) and (LGraphic.Height <> 0) and (FObj.FImageIndex = -1) then
|
|
FObj.FImageIndex := FPictureCache.AddPicture(LGraphic);
|
|
if Assigned(Pic) then
|
|
Pic.Free
|
|
else
|
|
LGraphic.Free;
|
|
end;
|
|
// FObj.UnloadImage;
|
|
end
|
|
end;
|
|
|
|
if (Obj.Parent <> nil) and ((FHeader <> nil) or (FFooter <> nil)) then
|
|
begin
|
|
FObj.Header := Obj.Parent = FHeader;
|
|
FObj.Footer := Obj.Parent = FFooter;
|
|
end;
|
|
|
|
if FObj.Top + FObj.Height > FMaxHeight then
|
|
FMaxHeight := FObj.Top + FObj.Height;
|
|
if FObj.Left + FObj.Width > FMaxWidth then
|
|
FMaxWidth := FObj.Left + FObj.Width;
|
|
if FObj.Left < FMinLeft then
|
|
FMinLeft := FObj.Left;
|
|
if FObj.Top < FMinTop then
|
|
FMinTop := FObj.Top;
|
|
if (FObj.Left < FLeft) or (FLeft = 0) then
|
|
FLeft := FObj.Left;
|
|
if (FObj.Top < FTop) or (FTop = 0) then
|
|
FTop := FObj.Top;
|
|
|
|
AddPos(FXPos, FObj.Left);
|
|
AddPos(FXPos, FObj.Left + FObj.Width);
|
|
AddPos(FYPos, FObj.Top);
|
|
AddPos(FYPos, FObj.Top + FObj.Height);
|
|
AddInternalObject(FObj, 0, 0, 1, 1);
|
|
end;
|
|
|
|
begin
|
|
if IsPageBG(aObj) and
|
|
(not FBackground) and (FPrintable or aObj.Printable)
|
|
then
|
|
Exit;
|
|
AddObj(aObj);
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.AddDialogObject(Obj: TfrxReportComponent);
|
|
var
|
|
FObj: TfrxIEMObject;
|
|
begin
|
|
if Obj is TfrxDialogControl then
|
|
begin
|
|
FObj := TfrxIEMObject.Create(FPictureCache);
|
|
FObj.StyleIndex := 0;
|
|
FObj.Style := nil;
|
|
FObj.URL := '';
|
|
FObj.Left := Obj.AbsLeft;
|
|
FObj.Top := Obj.AbsTop;
|
|
FObj.Width := Obj.Width;
|
|
FObj.Height := Obj.Height;
|
|
FObj.IsText := False;
|
|
FObj.IsRichText := False;
|
|
FObj.Link := Obj;
|
|
if FObj.Top + FObj.Height > FMaxHeight then
|
|
FMaxHeight := FObj.Top + FObj.Height;
|
|
if FObj.Left + FObj.Width > FMaxWidth then
|
|
FMaxWidth := FObj.Left + FObj.Width;
|
|
if FObj.Left < FMinLeft then
|
|
FMinLeft := FObj.Left;
|
|
if FObj.Top < FMinTop then
|
|
FMinTop := FObj.Top;
|
|
AddPos(FXPos, FObj.Left);
|
|
AddPos(FXPos, FObj.Left + FObj.Width);
|
|
AddPos(FYPos, FObj.Top);
|
|
AddPos(FYPos, FObj.Top + FObj.Height);
|
|
AddInternalObject(FObj, 0, 0, 1, 1);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.AddPage(Orientation: TPrinterOrientation;
|
|
Width: Extended; Height: Extended; LeftMargin: Extended; TopMargin: Extended;
|
|
RightMargin: Extended; BottomMargin: Extended; MirrorMargins: Boolean; Index: Integer);
|
|
var
|
|
Page: TfrxIEMPage;
|
|
begin
|
|
FDeltaY := FMaxHeight;
|
|
Page := TfrxIEMPage.Create;
|
|
Page.Value := FMaxHeight;
|
|
Page.Orientation := Orientation;
|
|
Page.Width := Width;
|
|
Page.Height := Height;
|
|
Page.TopMargin := TopMargin;
|
|
Page.BottomMargin := BottomMargin;
|
|
if MirrorMargins and (((Index + 1) mod 2) = 0) then
|
|
begin
|
|
Page.MirrorMargin := true;
|
|
Page.LeftMargin := RightMargin;
|
|
Page.RightMargin := LeftMargin;
|
|
end else
|
|
begin
|
|
Page.MirrorMargin := false;
|
|
Page.LeftMargin := LeftMargin;
|
|
Page.RightMargin := RightMargin;
|
|
end;
|
|
FPages.Add(Page);
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.AddPos(List: TList; Value: Extended);
|
|
var
|
|
Pos: TfrxIEMPos;
|
|
i, cnt: integer;
|
|
Exist: Boolean;
|
|
begin
|
|
Exist := False;
|
|
if List.Count > MAX_POS_SEARCH_DEPTH then
|
|
cnt := List.Count - MAX_POS_SEARCH_DEPTH
|
|
else
|
|
cnt := 0;
|
|
for i := List.Count - 1 downto cnt do
|
|
if TfrxIEMPos(List[i]).Value = Value then
|
|
begin
|
|
Exist := True;
|
|
break;
|
|
end;
|
|
if not Exist then
|
|
begin
|
|
Pos := TfrxIEMPos.Create;
|
|
Pos.Value := Value;
|
|
List.Add(Pos);
|
|
end;
|
|
end;
|
|
|
|
function TfrxIEMatrix.AddStyle(Obj: TfrxView): integer;
|
|
var
|
|
Style: TfrxIEMStyle;
|
|
MObj: TfrxCustomMemoView;
|
|
begin
|
|
Style := TfrxIEMStyle.Create;
|
|
if IsMemo(Obj) then
|
|
begin
|
|
MObj := TfrxCustomMemoView(Obj);
|
|
if MObj.Highlight.Active and
|
|
Assigned(MObj.Highlight.Font) then
|
|
begin
|
|
Style.Font.Assign(MObj.Highlight.Font);
|
|
if FDotMatrix then
|
|
Style.Font.Size := DOT_MATRIX_FONT_SIZE;
|
|
Style.Color := MObj.Highlight.Color;
|
|
end else
|
|
begin
|
|
Style.Font.Assign(MObj.Font);
|
|
if FDotMatrix then
|
|
Style.Font.Size := DOT_MATRIX_FONT_SIZE;
|
|
Style.Color := MObj.Color;
|
|
end;
|
|
Style.DisplayFormat := MObj.DisplayFormat;
|
|
Style.HAlign := MObj.HAlign;
|
|
Style.VAlign := MObj.VAlign;
|
|
Style.LineSpacing := MObj.LineSpacing;
|
|
Style.GapX := MObj.GapX;
|
|
Style.GapY := MObj.GapY;
|
|
if MObj.Font.Charset = 1 then
|
|
Style.Charset := GetFontCharset(MObj.Font)
|
|
else
|
|
Style.Charset := MObj.Font.Charset;
|
|
Style.CharSpacing := MObj.CharSpacing;
|
|
Style.ParagraphGap := MObj.ParagraphGap;
|
|
Style.WordBreak := MObj.WordBreak;
|
|
Style.FrameTyp := MObj.Frame.Typ;
|
|
Style.LeftLine.Assign(MObj.Frame.LeftLine);
|
|
Style.TopLine.Assign(MObj.Frame.TopLine);
|
|
Style.RightLine.Assign(MObj.Frame.RightLine);
|
|
Style.BottomLine.Assign(MObj.Frame.BottomLine);
|
|
Style.Rotation := MObj.Rotation;
|
|
Style.BrushStyle := MObj.BrushStyle;
|
|
Style.WordWrap := MObj.WordWrap;
|
|
end
|
|
else if IsLine(Obj) then
|
|
begin
|
|
Style.Color := Obj.Color;
|
|
if Obj.Width = 0 then
|
|
Style.FrameTyp := [ftLeft]
|
|
else if Obj.Height = 0 then
|
|
Style.FrameTyp := [ftTop]
|
|
else Style.FrameTyp := [];
|
|
Style.LeftLine.Assign(Obj.Frame.LeftLine);
|
|
Style.TopLine.Assign(Obj.Frame.TopLine);
|
|
Style.RightLine.Assign(Obj.Frame.RightLine);
|
|
Style.BottomLine.Assign(Obj.Frame.BottomLine);
|
|
Style.Font.Name := 'Arial';
|
|
Style.Font.Size := 1;
|
|
end
|
|
else if IsRect(Obj) then
|
|
begin
|
|
Style.Free;
|
|
Result := -1;
|
|
Exit;
|
|
end
|
|
else begin
|
|
Style.Font.Assign(Obj.Font);
|
|
if FDotMatrix then
|
|
Style.Font.Size := DOT_MATRIX_FONT_SIZE;
|
|
Style.Color := Obj.Color;
|
|
Style.LeftLine.Assign(Obj.Frame.LeftLine);
|
|
Style.TopLine.Assign(Obj.Frame.TopLine);
|
|
Style.RightLine.Assign(Obj.Frame.RightLine);
|
|
Style.BottomLine.Assign(Obj.Frame.BottomLine);
|
|
if Obj is TfrxCustomLineView then
|
|
Style.FrameTyp := []
|
|
else
|
|
Style.FrameTyp := Obj.Frame.Typ;
|
|
end;
|
|
Result := AddStyleInternal(Style);
|
|
end;
|
|
|
|
function TfrxIEMatrix.AddStyleInternal(Style: TfrxIEMStyle): integer;
|
|
var
|
|
i: integer;
|
|
Style2: TfrxIEMStyle;
|
|
begin
|
|
Result := -1;
|
|
for i := 0 to FIEMStyleList.Count - 1 do
|
|
begin
|
|
Style2 := TfrxIEMStyle(FIEMStyleList[i]);
|
|
if (Style.Font.Size = Style2.Font.Size) and
|
|
(Style.HAlign = Style2.HAlign) and
|
|
(Style.VAlign = Style2.VAlign) and
|
|
(Style.Font.Color = Style2.Font.Color) and
|
|
(Style.Font.Name = Style2.Font.Name) and
|
|
(Style.Font.Style = Style2.Font.Style) and
|
|
(Style.FrameTyp = Style2.FrameTyp) and
|
|
(Style.LeftLine.Width = Style2.LeftLine.Width) and
|
|
(Style.LeftLine.Color = Style2.LeftLine.Color) and
|
|
(Style.LeftLine.Style = Style2.LeftLine.Style) and
|
|
(Style.TopLine.Width = Style2.TopLine.Width) and
|
|
(Style.TopLine.Color = Style2.TopLine.Color) and
|
|
(Style.TopLine.Style = Style2.TopLine.Style) and
|
|
(Style.RightLine.Width = Style2.RightLine.Width) and
|
|
(Style.RightLine.Color = Style2.RightLine.Color) and
|
|
(Style.RightLine.Style = Style2.RightLine.Style) and
|
|
(Style.BottomLine.Width = Style2.BottomLine.Width) and
|
|
(Style.BottomLine.Color = Style2.BottomLine.Color) and
|
|
(Style.BottomLine.Style = Style2.BottomLine.Style) and
|
|
(Style.Color = Style2.Color) and
|
|
(Style.DisplayFormat.Kind = Style2.DisplayFormat.Kind) and
|
|
(Style.DisplayFormat.DecimalSeparator = Style2.DisplayFormat.DecimalSeparator) and
|
|
(Style.DisplayFormat.FormatStr = Style2.DisplayFormat.FormatStr) and
|
|
(Style.LineSpacing = Style2.LineSpacing) and
|
|
(Style.GapX = Style2.GapX) and
|
|
(Style.GapY = Style2.GapY) and
|
|
(Style.ParagraphGap = Style2.ParagraphGap) and
|
|
(Style.CharSpacing = Style2.CharSpacing) and
|
|
(Style.Charset = Style2.Charset) and
|
|
(Style.WordBreak = Style2.WordBreak) and
|
|
(Style.Rotation = Style2.Rotation) and
|
|
(Style.WordWrap = Style2.WordWrap) and
|
|
(Style.BrushStyle = Style2.BrushStyle) then
|
|
begin
|
|
Result := i;
|
|
break;
|
|
end;
|
|
end;
|
|
if Result = -1 then
|
|
begin
|
|
FIEMStyleList.Add(Style);
|
|
Result := FIEMStyleList.Count - 1;
|
|
end else
|
|
Style.Free;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.Analyse;
|
|
var
|
|
i, j, k: integer;
|
|
dx, dy: integer;
|
|
obj: TfrxIEMObjectList;
|
|
begin
|
|
for i := 0 to FHeight - 1 do
|
|
for j := 0 to FWidth - 1 do
|
|
begin
|
|
k := GetCell(j, i);
|
|
if k <> -1 then
|
|
begin
|
|
obj := TfrxIEMObjectList(FIEMObjectList[k]);
|
|
if not obj.Exist then
|
|
begin
|
|
FindRectArea(j, i, dx, dy);
|
|
|
|
if (obj.dx = dx) and (obj.dy = dy) then
|
|
begin
|
|
obj.x := j;
|
|
obj.y := i;
|
|
end;
|
|
|
|
if (obj.x = j) and (obj.y = i) and (obj.dx = dx) and (obj.dy = dy) then
|
|
Obj.Exist := True
|
|
else
|
|
CutObject(k, j, i, dx, dy)
|
|
end;
|
|
end;
|
|
end;
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.Clear;
|
|
var
|
|
i : Integer;
|
|
begin
|
|
for i := 0 to FIEMObjectList.Count - 1 do
|
|
TfrxIEMObjectList(FIEMObjectList[i]).Free;
|
|
FIEMObjectList.Clear;
|
|
for i := 0 to FIEMStyleList.Count - 1 do
|
|
TfrxIEMStyle(FIEMStyleList[i]).Free;
|
|
FIEMStyleList.Clear;
|
|
for i := 0 to FXPos.Count - 1 do
|
|
TfrxIEMPos(FXPos[i]).Free;
|
|
FXPos.Clear;
|
|
for i := 0 to FYPos.Count - 1 do
|
|
TfrxIEMPos(FYPos[i]).Free;
|
|
FYPos.Clear;
|
|
for i := 0 to FPages.Count - 1 do
|
|
TfrxIEMPage(FPages[i]).Free;
|
|
FPages.Clear;
|
|
FFontList.Clear;
|
|
SetLength(FMatrix, 0);
|
|
FDeltaY := 0;
|
|
FMaxWidth := 0;
|
|
FMaxHeight := 0;
|
|
FPictureCache.Clear;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.CloneFrames(Obj1, Obj2: Integer);
|
|
var
|
|
FOld, FNew: TfrxIEMObject;
|
|
FrameTyp: TfrxFrameTypes;
|
|
NewStyle: TfrxIEMStyle;
|
|
begin
|
|
FOld := TfrxIEMObjectList(FIEMObjectList[Obj1]).Obj;
|
|
FNew := TfrxIEMObjectList(FIEMObjectList[Obj2]).Obj;
|
|
if (FOld.Style <> nil) and (FNew.Style <> nil) then
|
|
begin
|
|
FrameTyp := [];
|
|
if (ftTop in FOld.Style.FrameTyp) and (FOld.Top = FNew.Top) then
|
|
FrameTyp := FrameTyp + [ftTop];
|
|
if (ftLeft in FOld.Style.FrameTyp) and (FOld.Left = FNew.Left) then
|
|
FrameTyp := FrameTyp + [ftLeft];
|
|
if (ftBottom in FOld.Style.FrameTyp) and
|
|
((FOld.Top + FOld.Height) = (FNew.Top + FNew.Height)) then
|
|
FrameTyp := FrameTyp + [ftBottom];
|
|
if (ftRight in FOld.Style.FrameTyp) and
|
|
((FOld.Left + FOld.Width) = (FNew.Left + FNew.Width)) then
|
|
FrameTyp := FrameTyp + [ftRight];
|
|
if FrameTyp <> FNew.Style.FrameTyp then
|
|
begin
|
|
NewStyle := TfrxIEMStyle.Create;
|
|
NewStyle.FrameTyp := FrameTyp;
|
|
NewStyle.LeftLine.Assign(FOld.Style.LeftLine);
|
|
NewStyle.TopLine.Assign(FOld.Style.TopLine);
|
|
NewStyle.RightLine.Assign(FOld.Style.RightLine);
|
|
NewStyle.BottomLine.Assign(FOld.Style.BottomLine);
|
|
NewStyle.Font.Assign(FOld.Style.Font);
|
|
NewStyle.DisplayFormat.Assign(FOld.Style.DisplayFormat);
|
|
NewStyle.LineSpacing := FOld.Style.LineSpacing;
|
|
NewStyle.GapX := FOld.Style.GapX;
|
|
NewStyle.GapY := FOld.Style.GapY;
|
|
NewStyle.ParagraphGap := FOld.Style.ParagraphGap;
|
|
NewStyle.CharSpacing := FOld.Style.CharSpacing;
|
|
NewStyle.Charset := FOld.Style.Charset;
|
|
NewStyle.WordBreak := FOld.Style.WordBreak;
|
|
NewStyle.VAlign := FOld.Style.VAlign;
|
|
NewStyle.HAlign := FOld.Style.HAlign;
|
|
NewStyle.Color := FOld.Style.Color;
|
|
NewStyle.Rotation := FOld.Style.Rotation;
|
|
NewStyle.BrushStyle := FOld.Style.BrushStyle;
|
|
NewStyle.WordWrap := FOld.Style.WordWrap;
|
|
FNew.StyleIndex := AddStyleInternal(NewStyle);
|
|
FNew.Style := TfrxIEMStyle(FIEMStyleList[FNew.StyleIndex]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.CutObject(ObjIndex, x, y, dx, dy: integer);
|
|
var
|
|
Obj: TfrxIEMObject;
|
|
NewObject: TfrxIEMObject;
|
|
NewIndex: Integer;
|
|
fdx, fdy: Extended;
|
|
begin
|
|
Obj := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Obj;
|
|
NewObject := TfrxIEMObject.Create(FPictureCache);
|
|
NewObject.StyleIndex := Obj.StyleIndex;
|
|
NewObject.Style := Obj.Style;
|
|
NewObject.Left := TfrxIEMPos(FXPos[x]).Value;
|
|
NewObject.Top := TfrxIEMPos(FYPos[y]).Value;
|
|
NewObject.Width := TfrxIEMPos(FXPos[x + dx]).Value - TfrxIEMPos(FXPos[x]).Value;
|
|
NewObject.Height := TfrxIEMPos(FYPos[y + dy]).Value - TfrxIEMPos(FYPos[y]).Value;
|
|
NewObject.Parent := Obj;
|
|
NewObject.IsText := Obj.IsText;
|
|
NewObject.IsRichText := Obj.IsRichText;
|
|
NewObject.HTMLTags := Obj.HTMLTags;
|
|
fdy := Obj.Top + Obj.Height - NewObject.Top;
|
|
fdx := Obj.Left + Obj.Width - NewObject.Left;
|
|
if (fdy > Obj.Height / 3) and (fdx > Obj.Width / 3) then
|
|
begin
|
|
NewObject.FImage := Obj.FImage;
|
|
NewObject.Link := Obj.Link;
|
|
NewObject.IsText := Obj.IsText;
|
|
NewObject.Memo := Obj.Memo;
|
|
Obj.Memo.Clear;
|
|
Obj.IsText := True;
|
|
Obj.Link := nil;
|
|
Obj.FImage := nil;
|
|
end;
|
|
NewIndex := AddInternalObject(NewObject, x, y, dx, dy);
|
|
ReplaceArea(ObjIndex, x, y, dx, dy, NewIndex);
|
|
CloneFrames(ObjIndex, NewIndex);
|
|
TfrxIEMObjectList(FIEMObjectList[NewIndex]).Exist := True;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.FillArea(x, y, dx, dy, Value: integer);
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
for i := y to y + dy - 1 do
|
|
for j := x to x + dx - 1 do
|
|
SetCell(j, i, Value);
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.FindRectArea(x, y: integer; var dx, dy: integer);
|
|
var
|
|
px, py: integer;
|
|
Obj: integer;
|
|
begin
|
|
Obj := GetCell(x, y);
|
|
px := x;
|
|
py := y;
|
|
dx := 0;
|
|
while GetCell(px, py) = Obj do
|
|
begin
|
|
while GetCell(px, py) = Obj do
|
|
Inc(px);
|
|
if dx = 0 then
|
|
dx := px - x
|
|
else if px - x < dx then
|
|
break;
|
|
Inc(py);
|
|
px := x;
|
|
end;
|
|
dy := py - y;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetCell(x, y: integer): integer;
|
|
begin
|
|
if (x < FWidth) and (y < FHeight) and (x >= 0) and (y >= 0) then
|
|
Result := FMatrix[FWidth * y + x]
|
|
else Result := -1;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetCellXPos(x: integer): Extended;
|
|
begin
|
|
Result := TfrxIEMPos(FXPos[x]).Value;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetCellYPos(y: integer): Extended;
|
|
begin
|
|
Result := TfrxIEMPos(FYPos[y]).Value;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetObject(x, y: integer): TfrxIEMObject;
|
|
var
|
|
i: integer;
|
|
begin
|
|
i := GetCell(x, y);
|
|
if i = -1 then
|
|
Result := nil
|
|
else
|
|
Result := TfrxIEMObjectList(FIEMObjectList[i]).Obj;
|
|
|
|
if Assigned(FPrevObject) then
|
|
begin
|
|
FPrevObject.UnloadImage;
|
|
end;
|
|
FPrevObject := Result;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetObjectBounds(Obj: TfrxIEMObject): TfrxRect;
|
|
begin
|
|
Result := frxRect(Obj.Left, Obj.Top, Obj.Left + Obj.Width, Obj.Top + Obj.Height)
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetObjectById(ObjIndex: integer): TfrxIEMObject;
|
|
begin
|
|
if ObjIndex < FIEMObjectList.Count then
|
|
Result := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Obj
|
|
else Result := nil;
|
|
|
|
if Assigned(FPrevObject) then
|
|
begin
|
|
FPrevObject.UnloadImage;
|
|
end;
|
|
FPrevObject := Result;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.GetObjectPos(ObjIndex: integer; var x, y, dx,
|
|
dy: integer);
|
|
begin
|
|
x := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).x;
|
|
y := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).y;
|
|
dx := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).dx;
|
|
dy := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).dy;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetObjectsCount: Integer;
|
|
begin
|
|
Result := FIEMObjectList.Count;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPicturesCount: Integer;
|
|
begin
|
|
Result := FPictureCache.Count;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageBreak(Page: integer): Extended;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).Value
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageHeight(Page: integer): Extended;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).Height
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageLMargin(Page: integer): Extended;
|
|
begin
|
|
if (Page >= 0) and (Page < FPages.Count) then
|
|
Result := TfrxIEMPage(FPages[Page]).LeftMargin
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageTMargin(Page: integer): Extended;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).TopMargin
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageWidth(Page: integer): Extended;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).Width
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageBMargin(Page: integer): Extended;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).BottomMargin
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageMirrorMargin(Page: integer): Boolean;
|
|
begin
|
|
if (Page >=0) and (Page < FPages.Count) then
|
|
Result := TfrxIEMPage(FPages[Page]).MirrorMargin
|
|
else
|
|
Result := false;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageRMargin(Page: integer): Extended;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).RightMargin
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPageOrientation(Page: integer): TPrinterOrientation;
|
|
begin
|
|
if Page < FPages.Count then
|
|
Result := TfrxIEMPage(FPages[Page]).Orientation
|
|
else
|
|
Result := poPortrait;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetPagesCount: Integer;
|
|
begin
|
|
Result := FPages.Count;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetStyle(x, y: integer): TfrxIEMStyle;
|
|
var
|
|
Obj: TfrxIEMObject;
|
|
begin
|
|
Obj := GetObject(x, y);
|
|
if Obj <> nil then
|
|
Result := TfrxIEMStyle(FIEMStyleList[Obj.StyleIndex])
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetStyleById(StyleIndex: integer): TfrxIEMStyle;
|
|
begin
|
|
Result := TfrxIEMStyle(FIEMStyleList[StyleIndex]);
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetStylesCount: Integer;
|
|
begin
|
|
Result := FIEMStyleList.Count;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetXPosById(PosIndex: integer): Extended;
|
|
begin
|
|
Result := TfrxIEMPos(FXPos[PosIndex]).Value;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetYPosById(PosIndex: integer): Extended;
|
|
begin
|
|
Result := TfrxIEMPos(FYPos[PosIndex]).Value;
|
|
end;
|
|
|
|
function TfrxIEMatrix.IsMemo(Obj: TfrxView): boolean;
|
|
begin
|
|
Result := (Obj is TfrxCustomMemoView) and
|
|
((Obj.BrushStyle in [bsSolid, bsClear]) or (not FBrushAsBitmap)) and
|
|
((TfrxCustomMemoView(Obj).Rotation = 0) or (not FRotatedImage));
|
|
end;
|
|
|
|
function TfrxIEMatrix.IsExist(ObjIndex: integer): Boolean;
|
|
begin
|
|
Result := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Exist;
|
|
end;
|
|
|
|
function TfrxIEMatrix.IsLine(Obj: TfrxView): boolean;
|
|
begin
|
|
Result := (Obj is TfrxCustomLineView) and ((Obj.Width = 0) or (Obj.Height = 0));
|
|
end;
|
|
|
|
function TfrxIEMatrix.IsRect(Obj: TfrxView): boolean;
|
|
begin
|
|
Result := (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle);
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.OptimizeFrames;
|
|
var
|
|
x, y: Integer;
|
|
Obj, PrevObj: TfrxIEMObject;
|
|
FrameTyp: TfrxFrameTypes;
|
|
Style: TfrxIEMStyle;
|
|
begin
|
|
for y := 0 to Height - 1 do
|
|
for x := 0 to Width - 1 do
|
|
begin
|
|
Obj := GetObject(x, y);
|
|
if Obj = nil then continue;
|
|
FrameTyp := Obj.Style.FrameTyp;
|
|
|
|
if (ftTop in FrameTyp) and (y > 0) then
|
|
begin
|
|
PrevObj := GetObject(x, y - 1);
|
|
if (PrevObj <> nil) and (PrevObj <> Obj) then
|
|
if (ftBottom in PrevObj.Style.FrameTyp) and
|
|
(PrevObj.Style.BottomLine.Width = Obj.Style.TopLine.Width) and
|
|
(PrevObj.Style.BottomLine.Color = Obj.Style.TopLine.Color) then
|
|
FrameTyp := FrameTyp - [ftTop];
|
|
end;
|
|
if (ftLeft in FrameTyp) and (x > 0) then
|
|
begin
|
|
PrevObj := GetObject(x - 1, y);
|
|
if (PrevObj <> nil) and (PrevObj <> Obj) then
|
|
if (ftRight in PrevObj.Style.FrameTyp) and
|
|
(PrevObj.Style.RightLine.Width = Obj.Style.LeftLine.Width) and
|
|
(PrevObj.Style.RightLine.Color = Obj.Style.LeftLine.Color) then
|
|
FrameTyp := FrameTyp - [ftLeft];
|
|
end;
|
|
|
|
if FrameTyp <> Obj.Style.FrameTyp then
|
|
begin
|
|
Style := TfrxIEMStyle.Create;
|
|
Style.Assign(Obj.Style);
|
|
Style.FrameTyp := FrameTyp;
|
|
Obj.StyleIndex := AddStyleInternal(Style);
|
|
Obj.Style := TfrxIEMStyle(FIEMStyleList[Obj.StyleIndex]);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxIEMatrix.QuickFind(aList: TList; aPosition: Extended; var Index: Integer): Boolean;
|
|
var
|
|
L, H, I: Integer;
|
|
C: Extended;
|
|
begin
|
|
Result := False;
|
|
L := 0;
|
|
H := aList.Count - 1;
|
|
while L <= H do begin
|
|
I := (L + H) shr 1;
|
|
C := TfrxIEMPos(aList[I]).Value - aPosition;
|
|
if C < 0 then
|
|
L := I + 1
|
|
else begin
|
|
H := I - 1;
|
|
if C = 0 then begin
|
|
Result := True;
|
|
L := I
|
|
end
|
|
end
|
|
end;
|
|
Index := L
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.OrderByCells;
|
|
var
|
|
i, j, k, dx, dy: integer;
|
|
curx, cury: Extended;
|
|
obj: TfrxIEMObject;
|
|
begin
|
|
OrderPosArray(FXPos, false);
|
|
OrderPosArray(FYPos, true);
|
|
for i := 0 to FIEMObjectList.Count - 1 do
|
|
begin
|
|
dx := 0; dy := 0;
|
|
obj := TfrxIEMObjectList(FIEMObjectList[i]).Obj;
|
|
QuickFind(FXPos, Obj.Left, j);
|
|
if j < FXPos.Count then
|
|
begin
|
|
TfrxIEMObjectList(FIEMObjectList[i]).x := j;
|
|
curx := Obj.Left;
|
|
k := j;
|
|
while (Obj.Left + Obj.Width > curx) and (k < FXPos.Count - 1) do
|
|
begin
|
|
Inc(k);
|
|
curx := TfrxIEMPos(FXPos[k]).Value;
|
|
Inc(dx);
|
|
end;
|
|
TfrxIEMObjectList(FIEMObjectList[i]).dx := dx;
|
|
end;
|
|
QuickFind(FYPos, Obj.Top, j);
|
|
if j < FYPos.Count then
|
|
begin
|
|
TfrxIEMObjectList(FIEMObjectList[i]).y := j;
|
|
cury := Obj.Top;
|
|
k := j;
|
|
while (Obj.Top + Obj.Height > cury) and (k < FYPos.Count - 1) do
|
|
begin
|
|
Inc(k);
|
|
cury := TfrxIEMPos(FYPos[k]).Value;
|
|
Inc(dy);
|
|
end;
|
|
TfrxIEMObjectList(FIEMObjectList[i]).dy := dy;
|
|
end;
|
|
end;
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
end;
|
|
|
|
function SortPosCompare(Item1, Item2: Pointer): Integer;
|
|
begin
|
|
if TfrxIEMPos(Item1).Value < TfrxIEMPos(Item2).Value then
|
|
Result := -1
|
|
else if TfrxIEMPos(Item1).Value > TfrxIEMPos(Item2).Value then
|
|
Result := 1
|
|
else
|
|
Result := 0;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.OrderPosArray(List: TList; Vert: boolean);
|
|
var
|
|
i, j, Cnt: integer;
|
|
pos1, pos2: Extended;
|
|
Reorder: Boolean;
|
|
begin
|
|
List.Sort(SortPosCompare);
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
i := 0;
|
|
while i <= List.Count - 2 do
|
|
begin
|
|
pos1 := TfrxIEMPos(List[i]).Value;
|
|
pos2 := TfrxIEMPos(List[i + 1]).Value;
|
|
if pos2 - pos1 < FInaccuracy then
|
|
begin
|
|
TfrxIEMPos(List[i]).Free;
|
|
List.Delete(i);
|
|
end else Inc(i);
|
|
end;
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
Reorder := False;
|
|
if Vert and (FMaxCellHeight > 0) then
|
|
for i := 0 to List.Count - 2 do
|
|
begin
|
|
pos1 := TfrxIEMPos(List[i]).Value;
|
|
pos2 := TfrxIEMPos(List[i + 1]).Value;
|
|
if pos2 - pos1 > FMaxCellHeight then
|
|
begin
|
|
Cnt := Round(Int((pos2 - pos1) / FMaxCellHeight));
|
|
for j := 1 to Cnt do
|
|
AddPos(List, pos1 + FMaxCellHeight * j);
|
|
Reorder := True;
|
|
end;
|
|
end;
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
if (not Vert) and (FMaxCellWidth > 0) then
|
|
for i := 0 to List.Count - 2 do
|
|
begin
|
|
pos1 := TfrxIEMPos(List[i]).Value;
|
|
pos2 := TfrxIEMPos(List[i + 1]).Value;
|
|
if pos2 - pos1 > FMaxCellWidth then
|
|
begin
|
|
Cnt := Round(Int((pos2 - pos1) / FMaxCellWidth));
|
|
for j := 1 to Cnt do
|
|
AddPos(List, pos1 + FMaxCellWidth * j);
|
|
Reorder := True;
|
|
end;
|
|
end;
|
|
if Reorder then
|
|
List.Sort(SortPosCompare);
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.Prepare;
|
|
var
|
|
Style: TfrxIEMStyle;
|
|
FObj: TfrxIEMObject;
|
|
FObjItem: TfrxIEMObjectList;
|
|
i, j: Integer;
|
|
f: Boolean;
|
|
{$IFDEF FR_DEBUG}
|
|
FLines: TStrings;
|
|
s, s1: String;
|
|
{$ENDIF}
|
|
begin
|
|
FPrevObject := nil;
|
|
if FShowProgress then
|
|
begin
|
|
FProgress := TfrxProgress.Create(nil);
|
|
FProgress.Execute(11, frxResources.Get('ProgressWait'), false, true);
|
|
end;
|
|
if FFillArea then
|
|
begin
|
|
Style := TfrxIEMStyle.Create;
|
|
Style.FrameTyp := [];
|
|
Style.Color := clWhite;
|
|
FObj := TfrxIEMObject.Create(FPictureCache);
|
|
FObj.StyleIndex := AddStyleInternal(Style);
|
|
FObj.Style := Style;
|
|
if FCropFillArea then
|
|
begin
|
|
FObj.Left := FMinLeft;
|
|
FObj.Top := FMinTop;
|
|
end
|
|
else
|
|
begin
|
|
FObj.Left := 0;
|
|
FObj.Top := 0;
|
|
end;
|
|
FObj.Width := MaxWidth;
|
|
FObj.Height := MaxHeight;
|
|
FObj.IsText := True;
|
|
AddPos(FXPos, 0);
|
|
AddPos(FYPos, 0);
|
|
FObjItem := TfrxIEMObjectList.Create;
|
|
FObjItem.x := 0;
|
|
FObjItem.y := 0;
|
|
FObjItem.dx := 1;
|
|
FObjItem.dy := 1;
|
|
FObjItem.Obj := FObj;
|
|
FIEMObjectList.Insert(0, FObjItem);
|
|
end;
|
|
OrderByCells;
|
|
FWidth := FXPos.Count;
|
|
FHeight := FYPos.Count;
|
|
Render;
|
|
|
|
if not FEmptyLines then
|
|
begin
|
|
i := 0;
|
|
while i < Height - 1 do
|
|
begin
|
|
f := True;
|
|
for j := 0 to Width - 1 do
|
|
f := f and (GetCell(j, i) = - 1);
|
|
if f then
|
|
DeleteMatrixLine(i)
|
|
else
|
|
Inc(i);
|
|
end;
|
|
end;
|
|
|
|
Analyse;
|
|
if FOptFrames then
|
|
OptimizeFrames;
|
|
if FShowProgress then
|
|
FProgress.Free;
|
|
|
|
{$IFDEF FR_DEBUG}
|
|
FLines := TStringList.Create;
|
|
try
|
|
for i := 0 to Height - 1 do
|
|
begin
|
|
s := Format('%10f', [TfrxIEMPos(FYPos[i]).Value]) + ' |';
|
|
for j := 0 to Width - 1 do
|
|
begin
|
|
if GetCell(j, i) <> -1 then
|
|
s1 := GetObject(j, i).Memo.Text
|
|
else
|
|
s1 := '';
|
|
s := s + ' ' + Format('%6d', [GetCell(j, i)]) + '/' + Copy(s1, 1, 5);
|
|
end;
|
|
FLines.Add(s);
|
|
end;
|
|
FLines.SaveToFile('matrix_before.log');
|
|
finally
|
|
FLines.Free;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF FR_DEBUG}
|
|
FLines := TStringList.Create;
|
|
try
|
|
for i := 0 to Height - 1 do
|
|
begin
|
|
s := Format('%10f', [TfrxIEMPos(FYPos[i]).Value]) + ' |';
|
|
for j := 0 to Width - 1 do
|
|
s := s + ' ' + Format('%6d', [GetCell(j, i)]);
|
|
FLines.Add(s);
|
|
end;
|
|
FLines.SaveToFile('matrix_after.log');
|
|
finally
|
|
FLines.Free;
|
|
end;
|
|
{$ENDIF}
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.Render;
|
|
var
|
|
i, old: integer;
|
|
obj: TfrxIEMObjectList;
|
|
Style: TfrxIEMStyle;
|
|
OldColor: TColor;
|
|
begin
|
|
SetLength(FMatrix, FWidth * FHeight);
|
|
FillArea(0, 0, FWidth, FHeight, -1);
|
|
for i := 0 to FIEMObjectList.Count - 1 do
|
|
begin
|
|
obj := TfrxIEMObjectList(FIEMObjectList[i]);
|
|
if (Obj.Obj.Style <> nil) and (Obj.Obj.Style.Color = clNone) then
|
|
begin
|
|
old := GetCell(obj.x, obj.y);
|
|
if old <> -1 then
|
|
begin
|
|
OldColor := TfrxIEMObjectList(FIEMObjectList[Old]).Obj.Style.Color;
|
|
if (OldColor <> Obj.Obj.Style.Color) and (OldColor <> Obj.Obj.Style.Font.Color) then
|
|
begin
|
|
Style := TfrxIEMStyle.Create;
|
|
Style.Assign(Obj.Obj.Style);
|
|
Style.Color := OldColor;
|
|
Obj.Obj.StyleIndex := AddStyleInternal(Style);
|
|
Obj.Obj.Style := TfrxIEMStyle(FIEMStyleList[Obj.Obj.StyleIndex]);
|
|
end;
|
|
end;
|
|
end;
|
|
FillArea(obj.x, obj.y, obj.dx, obj.dy, i);
|
|
end;
|
|
if FShowProgress then
|
|
FProgress.Tick;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.ReplaceArea(ObjIndex, x, y, dx, dy, Value: integer);
|
|
var
|
|
i, j: integer;
|
|
begin
|
|
for i := y to y + dy - 1 do
|
|
for j := x to x + dx - 1 do
|
|
if GetCell(j, i) = ObjIndex then
|
|
FMatrix[FWidth * i + j] := Value;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.SetCell(x, y, Value: integer);
|
|
begin
|
|
if (x < FWidth) and (y < FHeight) and (x >= 0) and (y >= 0) then
|
|
FMatrix[FWidth * y + x] := Value;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.SetGraphicType(const TypeName: String);
|
|
var
|
|
LGHelper: TfrxCustomGraphicFormatClass;
|
|
begin
|
|
LGHelper := GetGraphicFormats.FindByName(TypeName);
|
|
if Assigned(LGHelper) then
|
|
FGHelper := LGHelper;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.DeleteMatrixLine(y: Integer);
|
|
var
|
|
i, j: Integer;
|
|
delta: Extended;
|
|
begin
|
|
if (y >= 0) and (y < FHeight) then
|
|
begin
|
|
if (y < FHeight - 1) then
|
|
delta := TfrxIEMPos(FYPos[y + 1]).Value - TfrxIEMPos(FYPos[y]).Value
|
|
else
|
|
delta := 0;
|
|
for i := 1 to FHeight - y - 1 do
|
|
TfrxIEMPos(FYPos[y + i]).Value := TfrxIEMPos(FYPos[y + i]).Value - delta;
|
|
if Assigned(TfrxIEMPos(FYPos[y])) then
|
|
TfrxIEMPos(FYPos[y]).Free;
|
|
FYPos.Delete(y);
|
|
j := FWidth * (FHeight - y - 1);
|
|
for i := 0 to j - 1 do
|
|
begin
|
|
FMatrix[FWidth * y + i] := FMatrix[FWidth * (y + 1) + i];
|
|
{ correct objects positions}
|
|
if FMatrix[FWidth * y + i] > - 1 then
|
|
TfrxIEMObjectList(FIEMObjectList[FMatrix[FWidth * y + i]]).y := (FWidth * y + i) div FWidth;
|
|
end;
|
|
Dec(FHeight);
|
|
end;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetFontCharset(Font: TFont): Integer;
|
|
var
|
|
{$IFNDEF FPC}
|
|
b: TBitmap;
|
|
pm: ^OUTLINETEXTMETRIC;
|
|
{$ENDIF}
|
|
i: Cardinal;
|
|
begin
|
|
Result := 0;
|
|
if FFontList.IndexOf(Font.Name) <> -1 then
|
|
Result := StrToInt(FFontList.Values[Font.Name])
|
|
else
|
|
begin
|
|
{$IFNDEF FPC}
|
|
b := TBitmap.Create;
|
|
try
|
|
b.Canvas.Lock;
|
|
b.Canvas.Font.Assign(Font);
|
|
i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
|
|
if i = 0 then
|
|
begin
|
|
b.Canvas.Font.Name := 'Arial';
|
|
i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
|
|
end;
|
|
if i <> 0 then
|
|
begin
|
|
pm := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, i);
|
|
try
|
|
if pm <> nil then
|
|
i := GetOutlineTextMetrics(b.Canvas.Handle, i, pm)
|
|
else
|
|
i := 0;
|
|
if i <> 0 then
|
|
begin
|
|
Result := pm.otmTextMetrics.tmCharSet;
|
|
FFontList.Add(Font.Name);
|
|
FFontList.Values[Font.Name] := IntToStr(Result);
|
|
end;
|
|
finally
|
|
GlobalFreePtr(pm);
|
|
end;
|
|
end;
|
|
finally
|
|
b.Canvas.Unlock;
|
|
b.Free;
|
|
end;
|
|
{$ELSE}
|
|
//TODO , not working
|
|
Result := Integer(Font.CharSet);
|
|
FFontList.Add(Font.Name);
|
|
FFontList.Values[Font.Name] := IntToStr(Integer(Font.CharSet));
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.SetPageFooter(Band: TfrxBand);
|
|
begin
|
|
FFooter := Band;
|
|
end;
|
|
|
|
procedure TfrxIEMatrix.SetPageHeader(Band: TfrxBand);
|
|
begin
|
|
FHeader := Band;
|
|
end;
|
|
|
|
function TfrxIEMatrix.GetIEPages(Index: Integer): TfrxIEMPage;
|
|
begin
|
|
Result := nil;
|
|
if (Index < FPages.Count) and (Index >= 0) then
|
|
Result := TfrxIEMPage(FPages[Index]);
|
|
end;
|
|
|
|
{ TfrxIEMObjectList }
|
|
|
|
constructor TfrxIEMObjectList.Create;
|
|
begin
|
|
Exist := False;
|
|
end;
|
|
|
|
destructor TfrxIEMObjectList.Destroy;
|
|
begin
|
|
Obj.Free;
|
|
inherited;
|
|
end;
|
|
|
|
{ TfrxIEMStyle }
|
|
|
|
procedure TfrxIEMStyle.Assign(Style: TfrxIEMStyle);
|
|
begin
|
|
Font.Assign(Style.Font);
|
|
FDisplayFormat.Assign(Style.DisplayFormat);
|
|
LineSpacing := Style.LineSpacing;
|
|
GapX := Style.GapX;
|
|
GapY := Style.GapY;
|
|
ParagraphGap := Style.ParagraphGap;
|
|
CharSpacing := Style.CharSpacing;
|
|
Charset := Style.Charset;
|
|
WordBreak := Style.WordBreak;
|
|
VAlign := Style.VAlign;
|
|
HAlign := Style.HAlign;
|
|
FrameTyp := Style.FrameTyp;
|
|
LeftLine.Assign(Style.LeftLine);
|
|
TopLine.Assign(Style.TopLine);
|
|
RightLine.Assign(Style.RightLine);
|
|
BottomLine.Assign(Style.BottomLine);
|
|
Color := Style.Color;
|
|
Rotation := Style.Rotation;
|
|
BrushStyle := Style.BrushStyle;
|
|
WordWrap := Style.WordWrap;
|
|
end;
|
|
|
|
constructor TfrxIEMStyle.Create;
|
|
begin
|
|
Font := TFont.Create;
|
|
FDisplayFormat := TfrxFormat.Create(nil);
|
|
FDisplayFormat.DecimalSeparator := '';
|
|
FDisplayFormat.FormatStr := '';
|
|
FDisplayFormat.Kind := fkText;
|
|
LeftLine := TfrxFrameLine.Create(nil);
|
|
RightLine := TfrxFrameLine.Create(nil);
|
|
TopLine := TfrxFrameLine.Create(nil);
|
|
BottomLine := TfrxFrameLine.Create(nil);
|
|
end;
|
|
|
|
procedure TfrxIEMStyle.SetDisplayFormat(const Value: TfrxFormat);
|
|
begin
|
|
FDisplayFormat.Assign(Value);
|
|
end;
|
|
|
|
destructor TfrxIEMStyle.Destroy;
|
|
begin
|
|
FDisplayFormat.Free;
|
|
Font.Free;
|
|
LeftLine.Free;
|
|
RightLine.Free;
|
|
TopLine.Free;
|
|
BottomLine.Free;
|
|
inherited;
|
|
end;
|
|
|
|
{ TfrxIEMObject }
|
|
|
|
constructor TfrxIEMObject.Create(aPictureCache: TfrxPictureCache);
|
|
begin
|
|
{$IFDEF Delphi10}
|
|
FMemo := TfrxWideStrings.Create;
|
|
{$ELSE}
|
|
FMemo := TWideStrings.Create;
|
|
{$ENDIF}
|
|
Left := 0;
|
|
Top := 0;
|
|
FImage := nil;
|
|
FParent := nil;
|
|
FCounter := 0;
|
|
FIsText := true;
|
|
FIsRichText := false;
|
|
FIsDialogObject := False;
|
|
FLink := nil;
|
|
FHTMLTags := False;
|
|
FPictureCache := aPictureCache;
|
|
FIsMetaFile := True;
|
|
FImageIndex := -1;
|
|
FLineSpacing := 0;
|
|
end;
|
|
|
|
destructor TfrxIEMObject.Destroy;
|
|
begin
|
|
FMemo.Free;
|
|
FImage := nil;
|
|
inherited;
|
|
end;
|
|
|
|
function TfrxIEMObject.GetImage: TGraphic;
|
|
begin
|
|
Result := nil;
|
|
if (FImage = nil) and (FImageIndex > 0) then
|
|
FImage := FPictureCache.GetCachedBitmap(cgOriginal, FImageIndex);
|
|
if Assigned(FImage) then
|
|
Result := FImage.GetGraphic(cgOriginal);
|
|
end;
|
|
|
|
procedure TfrxIEMObject.SetMemo(const Value: TWideStrings);
|
|
begin
|
|
FMemo.Assign(Value);
|
|
end;
|
|
|
|
procedure TfrxIEMObject.UnloadImage;
|
|
begin
|
|
if Assigned(FImage) then
|
|
begin
|
|
FIsMetaFile := False;
|
|
FImage := nil;
|
|
end;
|
|
end;
|
|
|
|
end.
|