mirror of
https://gitlab.com/freepascal.org/lazarus/lazarus.git
synced 2025-04-27 10:14:03 +02:00
11005 lines
335 KiB
ObjectPascal
11005 lines
335 KiB
ObjectPascal
{
|
||
fpvectorial.pas
|
||
|
||
Vector graphics document
|
||
|
||
License: The same modified LGPL as the Free Pascal RTL
|
||
See the file COPYING.modifiedLGPL for more details
|
||
|
||
AUTHORS: Felipe Monteiro de Carvalho
|
||
}
|
||
unit fpvectorial;
|
||
|
||
{$ifdef fpc}
|
||
{$mode objfpc}{$h+}
|
||
{$endif}
|
||
|
||
{$define USE_LCL_CANVAS}
|
||
|
||
{$ifdef USE_LCL_CANVAS}
|
||
{$define USE_CANVAS_CLIP_REGION}
|
||
{.$define DEBUG_CANVAS_CLIP_REGION}
|
||
{$endif}
|
||
|
||
{.$define FPVECTORIAL_DEBUG_DIMENSIONS}
|
||
{.$define FPVECTORIAL_TOCANVAS_DEBUG}
|
||
{.$define FPVECTORIAL_DEBUG_BLOCKS}
|
||
{.$define FPVECTORIAL_AUTOFIT_DEBUG}
|
||
{.$define FPVECTORIAL_SUPPORT_LAZARUS_1_6}
|
||
// visual debugs
|
||
{.$define FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
|
||
{.$define FPVECTORIAL_RENDERINFO_VISUALDEBUG}
|
||
|
||
interface
|
||
|
||
uses
|
||
Classes, SysUtils, Math, TypInfo, contnrs, types,
|
||
// FCL-Image
|
||
FPCanvas, FPImage, FPWriteBMP,
|
||
// lazutils
|
||
GraphType, Laz2_DOM,
|
||
// LCL
|
||
LazUTF8, LazRegions
|
||
{$ifdef USE_LCL_CANVAS}
|
||
, Graphics, LCLIntf, LCLType, IntfGraphics, InterfaceBase
|
||
{$endif}
|
||
;
|
||
|
||
type
|
||
TvVectorialFormat = (
|
||
vfUnknown,
|
||
{ Multi-purpose document formats }
|
||
vfPDF, vfSVG, vfSVGZ, vfCorelDrawCDR, vfWindowsMetafileWMF, vfODG,
|
||
{ CAD formats }
|
||
vfDXF,
|
||
{ Geospatial formats }
|
||
vfLAS, vfLAZ,
|
||
{ Printing formats }
|
||
vfPostScript, vfEncapsulatedPostScript,
|
||
{ GCode formats }
|
||
vfGCodeAvisoCNCPrototipoV5, vfGCodeAvisoCNCPrototipoV6,
|
||
{ Formula formats }
|
||
vfMathML,
|
||
{ Text Document formats }
|
||
vfODT, vfDOCX, vfHTML,
|
||
{ Raster Image formats }
|
||
vfRAW
|
||
);
|
||
|
||
TvPageFormat = (vpA4, vpA3, vpA2, vpA1, vpA0);
|
||
|
||
TvProgressEvent = procedure (APercentage: Byte) of object;
|
||
|
||
{@@ This routine is called to add an item of caption AStr to an item
|
||
AParent, which is a pointer to another item as returned by a previous call
|
||
of this same proc. If AParent = nil then it should add the item to the
|
||
top of the tree. In all cases this routine should return a pointer to the
|
||
newly created item.
|
||
}
|
||
TvDebugAddItemProc = function (AStr: string; AParent: Pointer): Pointer of object;
|
||
|
||
const
|
||
{ Default extensions }
|
||
{ Multi-purpose document formats }
|
||
STR_PDF_EXTENSION = '.pdf';
|
||
STR_POSTSCRIPT_EXTENSION = '.ps';
|
||
STR_SVG_EXTENSION = '.svg';
|
||
STR_SVGZ_EXTENSION = '.svgz';
|
||
STR_CORELDRAW_EXTENSION = '.cdr';
|
||
STR_WINMETAFILE_EXTENSION = '.wmf';
|
||
STR_AUTOCAD_EXCHANGE_EXTENSION = '.dxf';
|
||
STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION = '.eps';
|
||
STR_LAS_EXTENSION = '.las';
|
||
STR_LAZ_EXTENSION = '.laz';
|
||
STR_RAW_EXTENSION = '.raw';
|
||
STR_MATHML_EXTENSION = '.mathml';
|
||
STR_ODG_EXTENSION = '.odg';
|
||
STR_ODT_EXTENSION = '.odt';
|
||
STR_DOCX_EXTENSION = '.docx';
|
||
STR_HTML_EXTENSION = '.html';
|
||
|
||
STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE = 'Ćą';
|
||
|
||
NUM_MAX_LISTSTYLES = 8; // OpenDocument Limit is 10, MS Word Limit is 9
|
||
|
||
// Convenience constant to convert text size points to mm
|
||
FPV_TEXT_POINT_TO_MM = 0.35278;
|
||
|
||
TWO_PI = 2.0 * pi;
|
||
|
||
type
|
||
TvCustomVectorialWriter = class;
|
||
TvCustomVectorialReader = class;
|
||
TvPage = class;
|
||
TvVectorialPage = class;
|
||
TvTextPageSequence = class;
|
||
TvEntity = class;
|
||
TPath = class;
|
||
TvVectorialDocument = class;
|
||
TvEmbeddedVectorialDoc = class;
|
||
TvRenderer = class;
|
||
|
||
{ Coordinates }
|
||
|
||
T2DPoint = record
|
||
X, Y: Double;
|
||
end;
|
||
P2DPoint = ^T2DPoint;
|
||
|
||
T3DPoint = record
|
||
X, Y, Z: Double;
|
||
end;
|
||
P3DPoint = ^T3DPoint;
|
||
|
||
T2DPointsArray = array of T2DPoint;
|
||
T3DPointsArray = array of T3DPoint;
|
||
TPointsArray = array of TPoint;
|
||
|
||
{ Pen, Brush and Font }
|
||
|
||
TvPen = record
|
||
Color: TFPColor;
|
||
Style: TFPPenStyle;
|
||
Width: Integer;
|
||
Pattern: array of LongWord;
|
||
end;
|
||
PvPen = ^TvPen;
|
||
|
||
TvBrushKind = (bkSimpleBrush, bkHorizontalGradient, bkVerticalGradient,
|
||
bkOtherLinearGradient, bkRadialGradient);
|
||
TvCoordinateUnit = (vcuDocumentUnit, vcuPercentage); // Note: vcuPercentage is fraction 0..1, rather than 0..100
|
||
|
||
TvGradientFlag = (gfRelStartX, gfRelStartY, gfRelEndX, gfRelEndY, gfRelToUserSpace);
|
||
TvGradientFlags = set of TvGradientFlag;
|
||
|
||
TvGradientColor = record
|
||
Color: TFPColor;
|
||
Position: Double; // 0 ... 1
|
||
end;
|
||
|
||
TvGradientColors = array of TvGradientColor;
|
||
|
||
TvBrush = record
|
||
Color: TFPColor;
|
||
Style: TFPBrushStyle;
|
||
Kind: TvBrushKind;
|
||
Image: TFPCustomImage;
|
||
// Gradient filling support
|
||
Gradient_start: T2DPoint; // Start/end point of gradient, in pixels by default,
|
||
Gradient_end: T2DPoint; // but if gfRel* in flags relative to entity boundary or user space
|
||
Gradient_flags: TvGradientFlags;
|
||
// Radial gradients
|
||
Gradient_cx, Gradient_cy: Double; // center of outer-most circle
|
||
Gradient_r: Double; // radius of outer-most circle
|
||
Gradient_fx, Gradient_fy: Double; // focal point (center of inner-most circle)
|
||
Gradient_cx_Unit, Gradient_cy_Unit, Gradient_r_Unit, Gradient_fx_Unit, Gradient_fy_Unit: TvCoordinateUnit;
|
||
Gradient_colors: TvGradientColors;
|
||
end;
|
||
PvBrush = ^TvBrush;
|
||
|
||
TvFont = record
|
||
Color: TFPColor;
|
||
Size: Double;
|
||
Name: string;
|
||
{@@
|
||
Font orientation is measured in degrees and uses the
|
||
same direction as the LCL TFont.orientation, which is counter-clockwise.
|
||
Zero is the normal, horizontal, orientation, directed to the right.
|
||
}
|
||
Orientation: Double;
|
||
Bold: boolean;
|
||
Italic: boolean;
|
||
Underline: boolean;
|
||
StrikeThrough: boolean;
|
||
end;
|
||
PvFont = ^TvFont;
|
||
|
||
TvSetStyleElement = (
|
||
// Pen, Brush and Font
|
||
spbfPenColor, spbfPenStyle, spbfPenWidth,
|
||
spbfBrushColor, spbfBrushStyle, spbfBrushGradient, spbfBrushKind,
|
||
spbfFontColor, spbfFontSize, spbfFontName, spbfFontBold, spbfFontItalic,
|
||
spbfFontUnderline, spbfFontStrikeThrough, spbfAlignment,
|
||
// TextAnchor
|
||
spbfTextAnchor,
|
||
// Page style
|
||
sseMarginTop, sseMarginBottom, sseMarginLeft, sseMarginRight
|
||
);
|
||
|
||
TvSetStyleElements = set of TvSetStyleElement;
|
||
// for backwards compatibility, obsolete
|
||
TvSetPenBrushAndFontElement = TvSetStyleElement;
|
||
TvSetPenBrushAndFontElements = TvSetStyleElements;
|
||
|
||
TvStyleKind = (
|
||
// Paragraph kinds
|
||
vskTextBody, vskHeading,
|
||
// Text-span kind
|
||
vskTextSpan);
|
||
|
||
TvStyleAlignment = (vsaLeft, vsaRight, vsaJustifed, vsaCenter);
|
||
|
||
TvTextAnchor = (vtaStart, vtaMiddle, vtaEnd);
|
||
|
||
{ TvStyle }
|
||
|
||
TvStyle = class
|
||
protected
|
||
FExtraDebugStr: string;
|
||
public
|
||
Name: string;
|
||
Parent: TvStyle; // Can be nil
|
||
Kind: TvStyleKind;
|
||
Alignment: TvStyleAlignment;
|
||
HeadingLevel: Integer;
|
||
//
|
||
Pen: TvPen;
|
||
Brush: TvBrush;
|
||
Font: TvFont;
|
||
TextAnchor: TvTextAnchor;
|
||
// Page style
|
||
MarginTop, MarginBottom, MarginLeft, MarginRight: Double; // in mm
|
||
SuppressSpacingBetweenSameParagraphs : Boolean;
|
||
//
|
||
SetElements: TvSetStyleElements;
|
||
//
|
||
Constructor Create;
|
||
|
||
function GetKind: TvStyleKind; // takes care of parenting
|
||
procedure Clear(); virtual;
|
||
procedure CopyFrom(AFrom: TvStyle);
|
||
procedure CopyFromEntity(AEntity: TvEntity);
|
||
procedure ApplyOverFromPen(APen: PvPen; ASetElements: TvSetStyleElements);
|
||
procedure ApplyOverFromBrush(ABrush: PvBrush; ASetElements: TvSetStyleElements);
|
||
procedure ApplyOverFromFont(AFont: PvFont; ASetElements: TvSetStyleElements);
|
||
procedure ApplyOver(AFrom: TvStyle); virtual;
|
||
procedure ApplyIntoEntity(ADest: TvEntity); virtual;
|
||
function CreateStyleCombinedWithParent: TvStyle;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
|
||
end;
|
||
|
||
TvListStyleKind = (vlskBullet, vlskNumeric);
|
||
|
||
TvNumberFormat = (vnfDecimal, // 0, 1, 2, 3...
|
||
vnfLowerLetter, // a, b, c, d...
|
||
vnfLowerRoman, // i, ii, iii, iv....
|
||
vnfUpperLetter, // A, B, C, D...
|
||
vnfUpperRoman); // I, II, III, IV....
|
||
|
||
{ TvListLevelStyle }
|
||
|
||
TvListLevelStyle = Class
|
||
Kind : TvListStyleKind;
|
||
Level : Integer;
|
||
Start : Integer; // For numbered lists only
|
||
|
||
// Define the "leader", the stuff in front of each list item
|
||
Prefix : String;
|
||
Suffix : String;
|
||
Bullet : String; // Only applies to Kind=vlskBullet
|
||
NumberFormat : TvNumberFormat; // Only applies to Kind=vlskNumeric
|
||
DisplayLevels : Boolean; // Only applies to numbered lists.
|
||
// If true, style is 1.1.1.1.
|
||
// else style is 1.
|
||
LeaderFontName : String; // Not used by odt...
|
||
|
||
MarginLeft : Double; // mm
|
||
HangingIndent : Double; //mm
|
||
Alignment : TvStyleAlignment;
|
||
|
||
Constructor Create;
|
||
end;
|
||
|
||
{ TvListStyle }
|
||
|
||
TvListStyle = class
|
||
private
|
||
ListLevelStyles : TFPList;
|
||
public
|
||
Name : String;
|
||
|
||
constructor Create;
|
||
destructor Destroy; override;
|
||
|
||
procedure Clear;
|
||
function AddListLevelStyle : TvListLevelStyle;
|
||
function GetListLevelStyleCount : Integer;
|
||
function GetListLevelStyle(AIndex: Integer): TvListLevelStyle;
|
||
end;
|
||
|
||
{ Polyline segments }
|
||
|
||
TSegmentType = (
|
||
st2DLine, st2DLineWithPen, st2DBezier,
|
||
st3DLine, st3DBezier, stMoveTo,
|
||
st2DEllipticalArc);
|
||
|
||
{@@
|
||
The coordinates in fpvectorial are given in millimeters and
|
||
the starting point is in the bottom-left corner of the document.
|
||
The X grows to the right and the Y grows to the top.
|
||
}
|
||
{ TPathSegment }
|
||
|
||
TPathSegment = class
|
||
protected
|
||
FPath: TPath;
|
||
public
|
||
SegmentType: TSegmentType;
|
||
// Fields for linking the list
|
||
Previous: TPathSegment;
|
||
Next: TPathSegment;
|
||
// mathematical methods
|
||
function GetLength(): Double; virtual;
|
||
function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; virtual; // ATangentAngle in radians
|
||
function GetStartPoint(out APoint: T3DPoint): Boolean;
|
||
// edition methods
|
||
procedure Move(ADeltaX, ADeltaY: Double); virtual;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians, >0 counter-clockwise
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
|
||
// rendering
|
||
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); virtual;
|
||
// helper methods
|
||
function UseTopLeftCoordinates: Boolean;
|
||
end;
|
||
|
||
{@@
|
||
In a 2D segment, the X and Y coordinates represent usually the
|
||
final point of the segment, being that it starts where the previous
|
||
segment ends. The exception is for the first segment of all, which simply
|
||
holds the starting point for the drawing and should always be of the type
|
||
stMoveTo.
|
||
}
|
||
|
||
{ T2DSegment }
|
||
|
||
T2DSegment = class(TPathSegment)
|
||
public
|
||
X, Y: Double;
|
||
// mathematical methods
|
||
function GetLength(): Double; override;
|
||
function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; override;
|
||
// edition methods
|
||
procedure Move(ADeltaX, ADeltaY: Double); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
// rendering
|
||
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
|
||
end;
|
||
|
||
T2DSegmentWithPen = class(T2DSegment)
|
||
public
|
||
Pen: TvPen;
|
||
end;
|
||
|
||
{@@
|
||
In Bezier segments, we remain using the X and Y coordinates for the ending point.
|
||
The starting point is where the previous segment ended, so that the intermediary
|
||
bezier control points are [X2, Y2] and [X3, Y3].
|
||
|
||
Equations:
|
||
|
||
B(t) = (1-t)³ [Prev.X, Prev.Y] + 3 (1-t)² t [X2, Y2] + 3 (1-t) t² [X3, Y3] + t³ [X,Y], 0<=t<=1
|
||
|
||
B'(t) = 3 (1-t)² [X2-Prev.X, Y2-Prev.Y] + 6 (1-t) t [X3-X2, Y3-Y2] + 3 t² [X-X3,Y-Y3]
|
||
}
|
||
|
||
{ T2DBezierSegment }
|
||
|
||
T2DBezierSegment = class(T2DSegment)
|
||
public
|
||
X2, Y2: Double;
|
||
X3, Y3: Double;
|
||
// mathematical methods
|
||
function GetLength(): Double; override;
|
||
function GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean; override;
|
||
// edition methods
|
||
procedure Move(ADeltaX, ADeltaY: Double); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
// rendering
|
||
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
|
||
end;
|
||
|
||
{ T3DSegment }
|
||
|
||
T3DSegment = class(TPathSegment)
|
||
public
|
||
{@@
|
||
Coordinates of the end of the segment.
|
||
For the first segment, this is the starting point.
|
||
}
|
||
X, Y, Z: Double;
|
||
procedure Move(ADeltaX, ADeltaY: Double); override;
|
||
// rendering
|
||
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
|
||
end;
|
||
|
||
{ T3DBezierSegment }
|
||
|
||
T3DBezierSegment = class(T3DSegment)
|
||
public
|
||
X2, Y2, Z2: Double;
|
||
X3, Y3, Z3: Double;
|
||
procedure Move(ADeltaX, ADeltaY: Double); override;
|
||
end;
|
||
|
||
// Elliptical Arc
|
||
// See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
|
||
|
||
{ T2DEllipticalArcSegment }
|
||
|
||
T2DEllipticalArcSegment = class(T2DSegment)
|
||
private
|
||
E1, E2: T3DPoint;
|
||
function AlignedEllipseCenterEquationT1(AParam: Double): Double;
|
||
public
|
||
RX, RY: Double; // RX and RY are the X and Y half axis sizes
|
||
XRotation: Double; // rotation of x axis, in radians
|
||
LeftmostEllipse, ClockwiseArcFlag: Boolean;
|
||
CX, CY: Double; // Ellipse center
|
||
CenterSetByUser: Boolean; // defines if we should use LeftmostEllipse to calculate the center, or if CX, CY is set directly
|
||
procedure BezierApproximate(var Points: T3dPointsArray);
|
||
procedure PolyApproximate(var Points: T3dPointsArray);
|
||
procedure CalculateCenter;
|
||
procedure CalculateEllipseBoundingBox(out ALeft, ATop, ARight, ABottom: Double);
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
procedure AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double; var Points: TPointsArray); override;
|
||
procedure Move(ADeltaX, ADeltaY: Double); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
end;
|
||
|
||
TvFindEntityResult = (vfrNotFound, vfrFound, vfrSubpartFound);
|
||
|
||
TvRenderInfo = record
|
||
// Input to the rendering, provided by the Document or some other
|
||
// top-level entity and propagated down to all sub-entities
|
||
Page: TvPage;
|
||
Renderer: TvRenderer;
|
||
BackgroundColor: TFPColor;
|
||
AdjustPenColorToBackground: Boolean;
|
||
Selected: TvEntity;
|
||
Canvas: TFPCustomCanvas;
|
||
DestX: Integer;
|
||
DestY: Integer;
|
||
MulX: Double;
|
||
MulY: Double;
|
||
|
||
// Input to the rendering, other inputs
|
||
ForceRenderBlock: Boolean; // Blocks are usually invisible, but when rendering an insert, their drawing can be forced
|
||
|
||
// Fields which are output from the rendering process
|
||
EntityCanvasMinXY, EntityCanvasMaxXY: TPoint; // The size utilized in the canvas to draw this entity, in pixels
|
||
|
||
// errors
|
||
SelfEntity: TvEntity;
|
||
Parent: TvEntity;
|
||
Errors: TStringArray; //was: TStrings; -- avoid mem leak when copying RenderInfo
|
||
end;
|
||
|
||
TvEntityFeatures = record
|
||
DrawsUpwards: Boolean; // TvText, TvEmbeddedVectorialDoc, etc draws upwards, but in the future we might have entities drawing downwards
|
||
DrawsUpwardHeightAdjustment: Integer; // in Canvas pixels
|
||
FirstLineHeight: Integer; // in Canvas pixels
|
||
TotalHeight: Integer; // in Canvas pixels
|
||
end;
|
||
|
||
{ Now all elements }
|
||
|
||
{@@
|
||
All elements should derive from TvEntity, regardless of whatever properties
|
||
they might contain.
|
||
}
|
||
|
||
{ TvEntity }
|
||
|
||
TvEntity = class
|
||
public
|
||
//not used currently Parent: TvEntity; // Might be nil if this is placed directly in the page!!!
|
||
X, Y, Z: Double;
|
||
constructor Create(APage: TvPage); virtual;
|
||
procedure Clear; virtual;
|
||
procedure SetPage(APage: TvPage); virtual;
|
||
// in CalculateBoundingBox always remember to treat correctly the case of ADest=nil!!!
|
||
// This cased is utilized to guess the size of a document even before getting a canvas to draw at
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); virtual;
|
||
function CalculateSizeInCanvas(constref ARenderInfo: TvRenderInfo; APageHeight: Integer; AZoom: Double; out ALeft, ATop, AWidth, AHeight: Integer): Boolean;
|
||
procedure CalculateHeightInCanvas(constref ARenderInfo: TvRenderInfo; out AHeight: Integer);
|
||
// helper functions for CalculateBoundingBox & TvRenderInfo
|
||
procedure ExpandBoundingBox(constref ARenderInfo: TvRenderInfo; var ALeft, ATop, ARight, ABottom: Double);
|
||
class procedure CalcEntityCanvasMinMaxXY(var ARenderInfo: TvRenderInfo; APointX, APointY: Integer);
|
||
class procedure CalcEntityCanvasMinMaxXY_With2Points(var ARenderInfo: TvRenderInfo; AX1, AY1, AX2, AY2: Integer);
|
||
procedure MergeRenderInfo(var AFrom, ATo: TvRenderInfo);
|
||
class procedure InitializeRenderInfo(var ARenderInfo: TvRenderInfo; ASelf: TvEntity; ACreateObjs: Boolean = False);
|
||
class procedure FinalizeRenderInfo(var ARenderInfo: TvRenderInfo);
|
||
class procedure CopyAndInitDocumentRenderInfo(out ATo: TvRenderInfo; AFrom: TvRenderInfo; ACopyMinMax: Boolean = False; AAsChild: Boolean = True);
|
||
function RenderInfo_GenerateParentTree(constref ARenderInfo: TvRenderInfo): string;
|
||
function CentralizeY_InHeight(constref ARenderInfo: TvRenderInfo; AHeight: Double): Double;
|
||
function GetHeight(constref ARenderInfo: TvRenderInfo): Double;
|
||
function GetWidth(constref ARenderInfo: TvRenderInfo): Double;
|
||
{@@ ASubpart is only valid if this routine returns vfrSubpartFound }
|
||
function GetLineIntersectionPoints(ACoord: Double;
|
||
ACoordIsX: Boolean): TDoubleDynArray; virtual; // get all points where the entity inner area crosses a line
|
||
function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; virtual;
|
||
procedure Move(ADeltaX, ADeltaY: Double); virtual;
|
||
procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); virtual;
|
||
function GetSubpartCount: Integer; virtual;
|
||
procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double); virtual;
|
||
procedure Scale(ADeltaScaleX, ADeltaScaleY: Double); virtual;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); virtual; // Angle in radians, >0 counter-clockwise
|
||
// ADoDraw = False means that no drawing will actually be done, only the size info will be filled in ARenderInfo
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); virtual;
|
||
function AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
|
||
function GetNormalizedPos(APage: TvVectorialPage; ANewMin, ANewMax: Double): T3DPoint;
|
||
function GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures; virtual;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; virtual;
|
||
class function GenerateDebugStrForFPColor(AColor: TFPColor): string;
|
||
class function GenerateDebugStrForString(AValue: string): string;
|
||
end;
|
||
|
||
TvEntityClass = class of TvEntity;
|
||
|
||
{ TvNamedEntity }
|
||
|
||
TvNamedEntity = class(TvEntity)
|
||
protected
|
||
FExtraDebugStr: string;
|
||
FPage: TvPage;
|
||
public
|
||
Name: string;
|
||
constructor Create(APage: TvPage); override;
|
||
procedure SetPage(APage: TvPage); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvEntityWithPen }
|
||
|
||
TvEntityWithPen = class(TvNamedEntity)
|
||
public
|
||
{@@ The global Pen for the entire entity. In the case of paths, individual
|
||
elements might be able to override this setting. }
|
||
Pen: TvPen;
|
||
constructor Create(APage: TvPage); override;
|
||
procedure ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo); overload;
|
||
procedure ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo; APen: TvPen); overload;
|
||
procedure AssignPen(APen: TvPen);
|
||
function CreatePath: TPath; virtual;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
end;
|
||
|
||
{ TvEntityWithPenAndBrush }
|
||
|
||
TvClipMode = (vcmNonzeroWindingRule, vcmEvenOddRule);
|
||
|
||
TvEntityWithPenAndBrush = class(TvEntityWithPen)
|
||
public
|
||
procedure CalcGradientVector(out AGradientStart, AGradientEnd: T2dPoint;
|
||
const ARect: TRect; ADestX: Integer = 0; ADestY: Integer = 0;
|
||
AMulX: Double = 1.0; AMulY: Double = 1.0);
|
||
procedure DrawPolygon(var ARenderInfo: TvRenderInfo;
|
||
const APoints: TPointsArray; const APolyStarts: TIntegerDynArray; ARect: TRect);
|
||
procedure DrawPolygonBrushLinearGradient(var ARenderInfo: TvRenderInfo;
|
||
const APoints: TPointsArray;const APolyStarts: TIntegerDynArray;
|
||
ARect: TRect; AGradientStart, AGradientEnd: T2DPoint);
|
||
procedure DrawPolygonBrushRadialGradient(var ARenderInfo: TvRenderInfo;
|
||
const APoints: TPointsArray; ARect: TRect);
|
||
procedure DrawNativePolygonBrushRadialGradient(var ARenderInfo: TvRenderInfo;
|
||
const APoints: TPointsArray; ARect: TRect);
|
||
procedure DrawPolygonBorderOnly(var ARenderInfo: TvRenderInfo; const APoints: TPointsArray);
|
||
public
|
||
{@@ The global Brush for the entire entity. In the case of paths, individual
|
||
elements might be able to override this setting. }
|
||
Brush: TvBrush;
|
||
WindingRule: TvClipMode;
|
||
constructor Create(APage: TvPage); override;
|
||
procedure ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo); overload;
|
||
procedure ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo; ABrush: PvBrush); overload;
|
||
procedure AssignBrush(ABrush: PvBrush);
|
||
procedure DrawBrush(var ARenderInfo: TvRenderInfo);
|
||
procedure DrawBrushGradient(var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer); virtual;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvEntityWithPenBrushAndFont }
|
||
|
||
TvEntityWithPenBrushAndFont = class(TvEntityWithPenAndBrush)
|
||
public
|
||
Font: TvFont;
|
||
TextAnchor: TvTextAnchor;
|
||
constructor Create(APage: TvPage); override;
|
||
procedure ApplyFontToCanvas(ARenderInfo: TvRenderInfo); overload;
|
||
procedure ApplyFontToCanvas(ARenderInfo: TvRenderInfo; AFont: TvFont); overload;
|
||
procedure AssignFont(AFont: TvFont);
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians, >0 counter-clockwise
|
||
procedure Scale(ADeltaScaleX, ADeltaScaleY: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvEntityWithStyle }
|
||
|
||
TvEntityWithStyle = class(TvEntityWithPenBrushAndFont)
|
||
public
|
||
Style: TvStyle; // can be nil!
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
function GetCombinedStyle(AParent: TvEntityWithStyle): TvStyle;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
end;
|
||
|
||
TPath = class(TvEntityWithPenAndBrush)
|
||
private
|
||
// Used to speed up sequencial access in MoveSubpart
|
||
FCurMoveSubPartIndex: Integer;
|
||
FCurMoveSubPartSegment: TPathSegment;
|
||
//
|
||
public
|
||
FPolyPoints: TPointsArray;
|
||
FPolyStarts: TIntegerDynArray;
|
||
public
|
||
Len: Integer;
|
||
Points: TPathSegment; // Beginning of the double-linked list
|
||
PointsEnd: TPathSegment;// End of the double-linked list
|
||
CurPoint: TPathSegment; // Used in PrepareForSequentialReading and Next
|
||
CurWalkDistanceInCurSegment: Double;// Used in PrepareForWalking and NextWalk
|
||
ClipPath: TPath;
|
||
ClipMode: TvClipMode;
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
procedure Clear; override;
|
||
procedure Assign(ASource: TPath);
|
||
procedure PrepareForSequentialReading;
|
||
procedure PrepareForWalking;
|
||
function Next(): TPathSegment;
|
||
function NextWalk(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure AppendSegment(ASegment: TPathSegment);
|
||
procedure AppendMoveToSegment(AX, AY: Double);
|
||
procedure AppendLineToSegment(AX, AY: Double);
|
||
procedure AppendEllipticalArc(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
|
||
procedure AppendEllipticalArcWithCenter(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
|
||
function GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray; override;
|
||
procedure Move(ADeltaX, ADeltaY: Double); override;
|
||
procedure MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal); override;
|
||
function MoveToSubpart(ASubpart: Cardinal): TPathSegment;
|
||
function GetSubpartCount: Integer; override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians, >0 counter-clockwise
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
procedure RenderInternalPolygon(constref ARenderInfo: TvRenderInfo);
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{@@
|
||
TvText represents a text entity.
|
||
|
||
The text starts in X, Y and grows upwards, towards a bigger Y (fpvectorial coordinates)
|
||
or smaller Y (LCL coordinates).
|
||
It has the opposite direction of text in the LCL TCanvas.
|
||
}
|
||
|
||
|
||
{ TvText }
|
||
|
||
TvText = class(TvEntityWithStyle)
|
||
private
|
||
function GetTextMetric_Descender_px(constref ARenderInfo: TvRenderInfo): Integer;
|
||
public
|
||
Value: TStringList;
|
||
Render_NextText_X: Integer;
|
||
Render_Use_NextText_X: Boolean;
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures; override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvCurvedText }
|
||
|
||
// TvCurvedText supports only one line
|
||
TvCurvedText = class(TvText)
|
||
public
|
||
Path: TPath;
|
||
//constructor Create(APage: TvPage); override;
|
||
//destructor Destroy; override;
|
||
//function TryToSelect(APos: TPoint; var ASubpart: Cardinal): TvFindEntityResult; override;
|
||
//procedure CalculateBoundingBox(ADest: TFPCustomCanvas; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
//function GetEntityFeatures: TvEntityFeatures; override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
TvFieldKind = (vfkNumPages, vfkPage, vfkAuthor, vfkDateCreated, vfkDate);
|
||
|
||
{ TvField }
|
||
|
||
TvField = Class(TvEntityWithStyle)
|
||
public
|
||
Kind : TvFieldKind;
|
||
|
||
DateFormat : String; // Only for Kind in (vfkDateCreated, vfkDate)
|
||
// Date Format is similar to MS Specification
|
||
NumberFormat : TvNumberFormat; // Only for Kind in (vfkNumPages, vfkPage)
|
||
|
||
constructor Create(APage : TvPage); override;
|
||
end;
|
||
|
||
{@@
|
||
}
|
||
|
||
{ TvCircle }
|
||
|
||
TvCircle = class(TvEntityWithPenAndBrush)
|
||
public
|
||
Radius: Double;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
function CreatePath: TPath; override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override; // Angle in radians, >0 counter-clockwise
|
||
end;
|
||
|
||
{@@
|
||
}
|
||
|
||
{ TvCircularArc }
|
||
|
||
TvCircularArc = class(TvEntityWithPenAndBrush)
|
||
public
|
||
Radius: Double;
|
||
{@@ The Angle is measured in degrees in relation to the positive X axis, > 0 counter-clockwise }
|
||
StartAngle, EndAngle: Double;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
end;
|
||
|
||
{@@
|
||
}
|
||
|
||
{ TvEllipse }
|
||
|
||
TvEllipse = class(TvEntityWithPenAndBrush)
|
||
public
|
||
// Mandatory fields
|
||
HorzHalfAxis: Double; // This half-axis is the horizontal one when Angle=0
|
||
VertHalfAxis: Double; // This half-axis is the vertical one when Angle=0
|
||
{@@ The Angle is measured in radians in relation to the positive X axis and
|
||
counter-clockwise direction. }
|
||
Angle: Double;
|
||
function CreatePath: TPath; override;
|
||
function GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray; override;
|
||
function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
end;
|
||
|
||
{ TvRectangle }
|
||
{ The point (X,Y) refers to the left/top corner of the rectangle! }
|
||
|
||
TvRectangle = class(TvEntityWithPenBrushAndFont)
|
||
public
|
||
// A text displayed in the center of the square, usually empty
|
||
Text: string;
|
||
// Mandatory fields
|
||
CX, CY, CZ: Double; // CX = width, CY = height, CZ = depth
|
||
// Corner rounding, zero indicates no rounding
|
||
RX, RY: Double;
|
||
// The Angle is measured in radians relative to the positive X axis, >0 if counter-clockwise
|
||
// Center of rotation is (X,Y).
|
||
Angle: Double;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
function CreatePath: TPath; override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvPolygon }
|
||
|
||
TvPolygon = class(TvEntityWithPenBrushAndFont)
|
||
public
|
||
// A text displayed in the center of the square, usually empty
|
||
Text: string;
|
||
// All points of the polygon
|
||
Points: array of T3DPoint;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
end;
|
||
|
||
{@@
|
||
DimensionLeft ---text--- DimensionRight
|
||
| |
|
||
| | BaseRight
|
||
|
|
||
| BaseLeft
|
||
}
|
||
|
||
{ TvAlignedDimension }
|
||
|
||
TvAlignedDimension = class(TvEntityWithPen)
|
||
public
|
||
// Mandatory fields
|
||
BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{@@
|
||
|
||
}
|
||
|
||
{ TvRadialDimension }
|
||
|
||
TvRadialDimension = class(TvEntityWithPen)
|
||
public
|
||
// Mandatory fields
|
||
IsDiameter: Boolean; // If false, it is a radius, if true, it is a diameter
|
||
Center, DimensionLeft, DimensionRight: T3DPoint; // Diameter uses both, Radius uses only DImensionLeft
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvArcDimension }
|
||
|
||
TvArcDimension = class(TvEntityWithPen)
|
||
private
|
||
// Calculated fields
|
||
AngleBase, ArcLeft, ArcRight: T3DPoint;
|
||
al, bl, ar, br, AngleLeft, AngleRight: Double;
|
||
public
|
||
// Mandatory fields
|
||
ArcValue, ArcRadius: Double; // ArcValue is in degrees
|
||
TextPos, BaseLeft, BaseRight, DimensionLeft, DimensionRight: T3DPoint;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
procedure CalculateExtraArcInfo;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{@@
|
||
Vectorial images can contain raster images inside them and this entity
|
||
represents this.
|
||
|
||
If the Width and Height differ from the same data in the image, then
|
||
the raster image will be stretched.
|
||
|
||
X,Y represents the top-left corner of the image
|
||
|
||
Note that TFPCustomImage does not implement a storage, so the property
|
||
RasterImage should be filled with either a FPImage.TFPMemoryImage or with
|
||
a TLazIntfImage. The property RasterImage might be nil.
|
||
}
|
||
|
||
{ TvRasterImage }
|
||
|
||
TvRasterImage = class(TvNamedEntity)
|
||
public
|
||
RasterImage: TFPCustomImage;
|
||
Width, Height: Double;
|
||
AltText: string;
|
||
destructor Destroy; override;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure CreateRGB888Image(AWidth, AHeight: Cardinal);
|
||
procedure CreateImageFromFile(AFilename: string);
|
||
procedure CreateImageFromStream(AStream: TStream; Handler:TFPCustomImageReader);
|
||
procedure InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvPoint }
|
||
|
||
// Keep TvPoint as small as possible in memory foot-print for LAS support
|
||
TvPoint = class(TvEntity)
|
||
public
|
||
Pen: TvPen;
|
||
{constructor Create; override;
|
||
procedure ApplyPenToCanvas(ADest: TFPCustomCanvas; ARenderInfo: TvRenderInfo);
|
||
procedure Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
|
||
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;}
|
||
end;
|
||
|
||
{ TvArrow }
|
||
|
||
//
|
||
// The arrow look like this:
|
||
//
|
||
// A<------|B
|
||
// |
|
||
// |C
|
||
//
|
||
// A -> X,Y,Z
|
||
// B -> Base
|
||
// C -> ExtraLineBase, which exists if HasExtraLine=True
|
||
|
||
TvArrow = class(TvEntityWithPenAndBrush)
|
||
public
|
||
Base: T3DPoint;
|
||
HasExtraLine: Boolean;
|
||
ExtraLineBase: T3DPoint;
|
||
ArrowLength: Double;
|
||
ArrowBaseLength: Double;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
end;
|
||
|
||
{@@
|
||
The elements bellow describe a formula
|
||
|
||
The main element of a formula is TvFormula which contains a horizontal list of
|
||
the elements of the formula. Those can then have sub-elements
|
||
|
||
The formula starts in X, Y and grows downwards, towards a smaller Y
|
||
}
|
||
|
||
TvFormula = class;
|
||
|
||
TvFormulaElementKind = (
|
||
// Basic symbols
|
||
fekVariable, // Text is the text of the variable
|
||
fekEqual, // = symbol
|
||
fekSubtraction, // - symbol
|
||
fekMultiplication, // either a point . or a small x
|
||
fekSum, // + symbol
|
||
fekPlusMinus, // The +/- symbol
|
||
fekLessThan, // The < symbol
|
||
fekLessOrEqualThan, // The <= symbol
|
||
fekGreaterThan, // The > symbol
|
||
fekGreaterOrEqualThan, // The >= symbol
|
||
fekHorizontalLine,
|
||
// More complex elements, utilized for graphical representation of formula
|
||
fekFraction, // a division with Formula on the top and AdjacentFormula in the bottom
|
||
fekRoot, // A root. For example sqrt(something). Number gives the root, usually 2, and inside it goes a Formula
|
||
fekPower, // A Formula elevated to a AdjacentFormula, example: 2^5
|
||
fekSubscript, // A Formula with a subscripted element AdjacentFormula, example: Xi
|
||
fekSummation, // Sum of a variable given by Text set by Formula in the bottom and going up to AdjacentFormula in the top
|
||
fekFormula, // A formula, stored in Formula
|
||
// Elements utilized for formulas for infix to RPN converion, not utilized for graphical representations
|
||
fekParentesesOpen,
|
||
freParentesesClose
|
||
);
|
||
|
||
{ TvFormulaElement }
|
||
|
||
TvFormulaElement = class
|
||
public
|
||
Kind: TvFormulaElementKind;
|
||
Text: string;
|
||
Number: Double;
|
||
Formula: TvFormula;
|
||
AdjacentFormula: TvFormula;
|
||
public
|
||
Top, Left, Width, Height: Double;
|
||
function CalculateHeight(ADest: TFPCustomCanvas): Double; // in millimeters
|
||
function CalculateWidth(ADest: TFPCustomCanvas): Double; // in millimeters
|
||
function AsText: string;
|
||
procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); virtual;
|
||
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual;
|
||
class function GetPrecedenceFromKind(AKind: TvFormulaElementKind): Byte; // 0 is the smallest precedence
|
||
class function IsLeftAssociativeFromKind(AKind: TvFormulaElementKind): Boolean;
|
||
end;
|
||
|
||
{ TvFormula }
|
||
|
||
TvFormula = class(TvEntityWithPenBrushAndFont)
|
||
private
|
||
FCurIndex: Integer;
|
||
procedure CallbackDeleteElement(data,arg:pointer);
|
||
protected
|
||
FElements: TFPList; // of TvFormulaElement
|
||
SpacingBetweenElementsX, SpacingBetweenElementsY: Integer;
|
||
public
|
||
Top, Left, Width, Height: Double;
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
//
|
||
function GetFirstElement: TvFormulaElement;
|
||
function GetNextElement: TvFormulaElement;
|
||
procedure AddElement(AElement: TvFormulaElement);
|
||
function AddElementWithKind(AKind: TvFormulaElementKind): TvFormulaElement;
|
||
function AddElementWithKindAndText(AKind: TvFormulaElementKind; AText: string): TvFormulaElement;
|
||
procedure AddItemsByConvertingInfixToRPN(AInfix: TFPList {of TvFormulaElement});
|
||
procedure AddItemsByConvertingInfixStringToRPN(AStr: string);
|
||
procedure TokenizeInfixString(AStr: string; AOutput: TFPList);
|
||
function CalculateRPNFormulaValue: Double;
|
||
procedure Clear; override;
|
||
//
|
||
function CalculateHeight(ADest: TFPCustomCanvas): Double; virtual; // in millimeters
|
||
function CalculateWidth(ADest: TFPCustomCanvas): Double; virtual; // in millimeters
|
||
procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double); override;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvVerticalFormulaStack }
|
||
|
||
TvVerticalFormulaStack = class(TvFormula)
|
||
public
|
||
function CalculateHeight(ADest: TFPCustomCanvas): Double; override; // in millimeters
|
||
function CalculateWidth(ADest: TFPCustomCanvas): Double; override; // in millimeters
|
||
procedure PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double); override;
|
||
//function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{@@
|
||
A EntityWithSubEntities may have Pen, Brush and/or Font data associated with it, but it is disabled by default
|
||
This data can be active recursively in all children of the group if set in the field
|
||
SetPenBrushAndFontElements
|
||
}
|
||
|
||
{ TvEntityWithSubEntities }
|
||
|
||
TvEntityWithSubEntities = class(TvEntityWithStyle)
|
||
private
|
||
FCurIndex: Integer;
|
||
procedure CallbackDeleteElement(data,arg:pointer);
|
||
protected
|
||
FElements: TFPList; // of TvEntity
|
||
public
|
||
SetPenBrushAndFontElements: TvSetPenBrushAndFontElements;// This is not currently implemented!
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
//
|
||
function GetFirstEntity: TvEntity;
|
||
function GetNextEntity: TvEntity;
|
||
function GetEntitiesCount: Integer;
|
||
function GetEntity(AIndex: Integer): TvEntity;
|
||
function AddEntity(AEntity: TvEntity): Integer;
|
||
function GetEntityIndex(AEntity : TvEntity) : Integer;
|
||
function DeleteEntity(AIndex: Cardinal): Boolean;
|
||
function RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
|
||
procedure Rotate(AAngle: Double; ABase: T3DPoint); override;
|
||
procedure Clear; override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
function FindEntityWithReference(AEntity: TvEntity): Integer;
|
||
function FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity;
|
||
end;
|
||
|
||
{@@
|
||
A block is a group of other elements. It is not rendered directly into the drawing,
|
||
but instead is rendered via another item, called TvInsert
|
||
}
|
||
|
||
{ TvBlock }
|
||
|
||
TvBlock = class(TvEntityWithSubEntities)
|
||
public
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
end;
|
||
|
||
{@@
|
||
A "Insert" inserts a copy of any other element in the specified position.
|
||
Usually TvBlock entities are inserted, but any entity can be inserted.
|
||
}
|
||
|
||
{ TvInsert }
|
||
|
||
TvInsert = class(TvEntityWithStyle) // instead of TvNamedEntity so that it can pass its own style info to the InsertEntity
|
||
public
|
||
InsertEntity: TvEntity; // The entity to be inserted
|
||
RotationAngle: Double; // in angles, normal is zero
|
||
SetElements: TvSetStyleElements; // Defines which of Pen, Brush and Font will be applied to InsertEntity
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{@@
|
||
Layers are groups of elements.
|
||
Layers are similar to blocks and the diference is that the layer draws
|
||
its contents, while the block doesnt, and it cannot be pasted with an TvInsert.
|
||
}
|
||
|
||
{ TvLayer }
|
||
|
||
TvLayer = class(TvEntityWithSubEntities)
|
||
public
|
||
end;
|
||
|
||
{@@
|
||
TvParagraph represents a sequence of elements ordered as characters
|
||
in a paragraph.
|
||
The elements might be richly formatted text, but also images.
|
||
|
||
The basic element to build the sequence is TvText. Note that the X, Y positions
|
||
of elements will be all adjusted to fit the TvParagraph area
|
||
}
|
||
|
||
TvRichTextAutoExpand = (rtaeNone, etaeWidth, etaeHeight);
|
||
|
||
{ TvParagraph }
|
||
|
||
TvParagraph = class(TvEntityWithSubEntities)
|
||
public
|
||
Width, Height: Double;
|
||
AutoExpand: TvRichTextAutoExpand;
|
||
ListStyle : TvListStyle; // For Bulleted or Numbered Lists...
|
||
YPos_NeedsAdjustment_DelFirstLineBodyHeight: Boolean; // SVG coordinates for text are cumbersome, we need this
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
function AddText(AText: string): TvText;
|
||
function AddCurvedText(AText: string): TvCurvedText;
|
||
function AddField(AKind : TvFieldKind): TvField;
|
||
function AddRasterImage: TvRasterImage;
|
||
function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{@@
|
||
TvList represents a list of bulleted texts, like:
|
||
|
||
* First level
|
||
- Second level
|
||
* First level again
|
||
|
||
The basic element to build the sequence is TvParagraph
|
||
}
|
||
|
||
{ TvList }
|
||
|
||
TvList = class(TvEntityWithSubEntities)
|
||
public
|
||
Parent : TvList;
|
||
ListStyle : TvListStyle;
|
||
|
||
constructor Create(APage: TvPage); override; // MJT 31/08 added override;
|
||
destructor Destroy; override;
|
||
// helper function to add the most often used sub-entities
|
||
function AddParagraph(ASimpleText: string): TvParagraph;
|
||
function AddList: TvList;
|
||
// other helper functions
|
||
function GetLevel: Integer;
|
||
function GetBulletSize: Double;
|
||
procedure DrawBullet(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo;
|
||
ALevel: Integer; AX, AY: Double; ADestX: Integer = 0; ADestY: Integer = 0;
|
||
AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = True);
|
||
// overrides
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
//function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;}
|
||
end;
|
||
|
||
{@@
|
||
TvRichText represents a sequence of text paragraphs.
|
||
|
||
The basic element to build the sequence is TvParagraph. Note that the X, Y positions
|
||
of elements will be all adjusted to fit the TvRichText area
|
||
}
|
||
|
||
// Forward reference as Table Cells are TvRichText which in turn
|
||
// can also contain tables...
|
||
TvTable = class;
|
||
TvTableRow = class;
|
||
(*
|
||
TvImage = Class;
|
||
*)
|
||
{ TvRichText }
|
||
|
||
TvRichText = class(TvEntityWithSubEntities)
|
||
public
|
||
Width, Height: Double;
|
||
SpacingLeft, SpacingRight, SpacingTop, SpacingBottom: Double; // space around each side
|
||
AutoExpand: TvRichTextAutoExpand;
|
||
constructor Create(APage: TvPage); override;
|
||
destructor Destroy; override;
|
||
// Data writing methods
|
||
function AddParagraph: TvParagraph;
|
||
function AddList: TvList;
|
||
function AddTable: TvTable;
|
||
function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
|
||
function AddRasterImage: TvRasterImage;
|
||
// Functions for rendering and calculating sizes
|
||
procedure GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double); virtual;
|
||
function CalculateCellHeight_ForWidth(constref ARenderInfo: TvRenderInfo; AWidth: Double): Double; virtual;
|
||
function CalculateMaxNeededWidth(constref ARenderInfo: TvRenderInfo): Double; virtual;
|
||
function TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult; override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
(* Support for Adding Tables to the document
|
||
Each Cell is a TvRichText to allow full formatted text contents
|
||
*)
|
||
|
||
TvUnits = (dimMillimeter, dimPercent, dimPoint);
|
||
|
||
TvDimension = record
|
||
Value : Double;
|
||
Units : TvUnits;
|
||
end;
|
||
|
||
// Use tbtDefault if you don't want the Border settings to be written out
|
||
TvTableBorderType = (tbtSingle, tbtDashed, tbtDouble, tbtNone, tbtDefault);
|
||
|
||
TvTableBorder = record
|
||
LineType : TvTableBorderType;
|
||
Spacing : Double; // mm, default 0
|
||
Color : TFPColor; // Ignored if (0, 0, 0, 0)
|
||
Width : Double; // mm, default 0. Should really be in point for fine control
|
||
end;
|
||
|
||
// Can be applied to Tables AND Cells
|
||
TvTableBorders = record
|
||
Left : TvTableBorder;
|
||
Right : TvTableBorder;
|
||
Top : TvTableBorder;
|
||
Bottom : TvTableBorder;
|
||
InsideHoriz : TvTableBorder; // InsideXXX not normally applied to cells
|
||
InsideVert : TvTableBorder; // (MS Word Table Styles has an exception)
|
||
end;
|
||
|
||
{ TvTableCell }
|
||
|
||
TvVerticalAlignment = (vaTop, vaBottom, vaCenter, cvaBoth);
|
||
// Horizontal alignment taken from Paragraph Style
|
||
|
||
TvTableCell = Class(TvRichText)
|
||
public
|
||
// MJT to Felipe: It may be that Borders can be
|
||
// added to TvRichText if odt supports paragraph
|
||
// borders, in which case we can refactor a little and
|
||
// rename TvTableBorders
|
||
Row: TvTableRow;
|
||
Borders: TvTableBorders; // Defaults to be ignored (tbtDefault)
|
||
PreferredWidth: TvDimension; // Optional
|
||
VerticalAlignment: TvVerticalAlignment; // Defaults to vaTop
|
||
BackgroundColor: TFPColor; // Optional
|
||
BackgroundColorValid: Boolean;
|
||
SpannedCols: Integer; // For merging horiz cells. Default 1.
|
||
// See diagram above TvTable Class
|
||
SpacingDataValid: Boolean; // TvRichText defines spacing, SpacingTop, SpacingLeft, etc
|
||
// if SpacingDataValid is false use Row.Table.CallSpacing
|
||
// instead. Units for SpacingTop, etc, in mm. Spacing is the
|
||
// empty area around Cells (but inside them) without content.
|
||
|
||
constructor Create(APage: TvPage); override;
|
||
function GetEffectiveBorder(): TvTableBorders;
|
||
procedure GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double); override;
|
||
class procedure DrawBorder(ABorder: TvTableBorders;
|
||
AX, AY, AWidth, AHeight: double;
|
||
ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
|
||
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
class function GenerateDebugStrForBorders(ABorders: TvTableBorders): string;
|
||
end;
|
||
|
||
{ TvTableRow }
|
||
|
||
TvTableRow = Class(TvNamedEntity)
|
||
private
|
||
Cells: TFPList; // of TvTableCell
|
||
Public
|
||
Table: TvTable; // Link to the parent table
|
||
Height: Double; // Units mm. Use 0 for default height
|
||
Header: Boolean; // Repeat row across pages
|
||
AllowSplitAcrossPage : Boolean;// Can this Row split across multiple pages?
|
||
BackgroundColor: TFPColor; // Optional
|
||
BackgroundColorValid: Boolean;
|
||
// row spacing data in mm, necessary for docx among other formats
|
||
CellSpacing: Double;
|
||
SpacingDataValid: Boolean;
|
||
|
||
constructor create(APage : TvPage); override;
|
||
destructor destroy; override;
|
||
|
||
function AddCell: TvTableCell;
|
||
function GetCellCount: Integer;
|
||
function GetCell(AIndex: Integer): TvTableCell;
|
||
function GetCellColNr(ACell: TvTableCell): Integer;
|
||
function CalculateMaxCellSpacing_Y(): Double;
|
||
//
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
(*
|
||
Note on the grid used for the table
|
||
|
||
For the table shown below, three ColWidths must be defined.
|
||
|
||
First row should only have 2 cells. First cell spans 2 columns.
|
||
Second row should only have 2 cells. Second cell spans 2 columns.
|
||
Third row should have 3 cells. Each cell only spans 1 column (default)
|
||
|
||
X,Y +-----+------+---------+
|
||
| | |
|
||
+-----+----------------+
|
||
| | |
|
||
+-----+------+---------+
|
||
| | | |
|
||
+-----+------+---------+
|
||
|
||
The table draws at X,Y and downwards
|
||
*)
|
||
|
||
// TvTable.Style should be a Table Style, not a Paragraph Style
|
||
// and is optional.
|
||
TvTable = class(TvEntityWithStyle)
|
||
private
|
||
Rows: TFPList;
|
||
ColWidthsInMM: array of Double; // calculated during Render
|
||
TableWidth, TableHeight: Double; // in mm; calculated during Render
|
||
procedure CalculateColWidths(constref ARenderInfo: TvRenderInfo);
|
||
procedure CalculateRowHeights(constref ARenderInfo: TvRenderInfo);
|
||
public
|
||
ColWidths: array of Double; // Can be left empty for simple tables
|
||
// MUST be fully defined for merging cells
|
||
ColWidthsUnits : TvUnits; // Cannot mix ColWidth Units.
|
||
Borders : TvTableBorders; // Defaults: single/black/inside and out
|
||
PreferredWidth : TvDimension; // Optional. Units mm.
|
||
SpacingBetweenCells: Double; // Units mm. Gap between Cells.
|
||
CellSpacingLeft, CellSpacingRight, CellSpacingTop,
|
||
CellSpacingBottom: Double; // space around each side of cells, in mm
|
||
BackgroundColor : TFPColor; // Optional.
|
||
|
||
constructor create(APage : TvPage); override;
|
||
destructor destroy; override;
|
||
|
||
function AddRow: TvTableRow;
|
||
function GetRowCount : Integer;
|
||
function GetRow(AIndex: Integer) : TvTableRow;
|
||
//
|
||
function AddColWidth(AValue: Double): Integer;
|
||
function GetColCount(): Integer;
|
||
//
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
{ TvEmbeddedVectorialDoc }
|
||
|
||
TvEmbeddedVectorialDoc = class(TvEntity)
|
||
private
|
||
FWidth, FHeight: Double;
|
||
public
|
||
Document: TvVectorialDocument;
|
||
constructor Create(APage : TvPage); override;
|
||
destructor destroy; override;
|
||
procedure UpdateDocumentSize();
|
||
function GetWidth: Double;
|
||
function GetHeight: Double;
|
||
procedure SetWidth(AValue: Double);
|
||
procedure SetHeight(AValue: Double);
|
||
procedure CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out ALeft, ATop, ARight, ABottom: Double); override;
|
||
procedure Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True); override;
|
||
function GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer; override;
|
||
end;
|
||
|
||
TvVectorialReaderFlag = (
|
||
vrf_UseBottomLeftCoords // Instructs the reader to return bottom-left coordinates
|
||
);
|
||
TvVectorialReaderFlags = set of TvVectorialReaderFlag;
|
||
|
||
TvVectorialReaderSettings = record
|
||
VecReaderFlags: TvVectorialReaderFlags;
|
||
HelperToolPath: string;
|
||
end;
|
||
|
||
{ TvVectorialDocument }
|
||
|
||
TvVectorialDocument = class
|
||
private
|
||
FOnProgress: TvProgressEvent;
|
||
FPages: TFPList;
|
||
FStyles: TFPList;
|
||
FListStyles: TFPList;
|
||
FCurrentPageIndex: Integer;
|
||
FRenderer: TvRenderer;
|
||
function CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
|
||
function CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
|
||
public
|
||
Width, Height: Double; // in millimeters
|
||
Name: string;
|
||
Encoding: string; // The encoding on which to save the file, if empty UTF-8 will be utilized. This value is filled when reading
|
||
ForcedEncodingOnRead: string; // if empty, no encoding will be forced when reading, but it can be set to a LazUtils compatible value
|
||
// User-Interface information
|
||
ZoomLevel: Double; // 1 = 100%
|
||
{ Selection fields }
|
||
SelectedElement: TvEntity;
|
||
// List of common styles, for conveniently finding them
|
||
StyleTextBody, StyleHeading1, StyleHeading2, StyleHeading3,
|
||
StyleHeading4, StyleHeading5, StyleHeading6: TvStyle;
|
||
StyleTextBodyCentralized, StyleTextBodyBold: TvStyle; // text body modifications
|
||
StyleHeading1Centralized, StyleHeading2Centralized, StyleHeading3Centralized: TvStyle; // heading modifications
|
||
StyleBulletList, StyleNumberList : TvListStyle;
|
||
StyleTextSpanBold, StyleTextSpanItalic, StyleTextSpanUnderline: TvStyle;
|
||
// Reader properties
|
||
ReaderSettings: TvVectorialReaderSettings;
|
||
{ Base methods }
|
||
constructor Create; virtual;
|
||
destructor Destroy; override;
|
||
procedure Assign(ASource: TvVectorialDocument);
|
||
procedure AssignTo(ADest: TvVectorialDocument);
|
||
procedure WriteToFile(AFileName: string; AFormat: TvVectorialFormat); overload;
|
||
procedure WriteToFile(AFileName: string); overload;
|
||
procedure WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
|
||
procedure WriteToStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
|
||
procedure ReadFromFile(AFileName: string; AFormat: TvVectorialFormat); overload;
|
||
procedure ReadFromFile(AFileName: string); overload;
|
||
procedure ReadFromStream(AStream: TStream; AFormat: TvVectorialFormat);
|
||
procedure ReadFromStrings(AStrings: TStrings; AFormat: TvVectorialFormat);
|
||
procedure ReadFromXML(ADoc: TXMLDocument; AFormat: TvVectorialFormat);
|
||
class function GetFormatFromExtension(AFileName: string; ARaiseException: Boolean = True): TvVectorialFormat;
|
||
function GetDetailedFileFormat(): string;
|
||
procedure GuessDocumentSize();
|
||
procedure GuessGoodZoomLevel(AScreenSize: Integer = 500);
|
||
{ Page methods }
|
||
function GetPage(AIndex: Integer): TvPage;
|
||
function GetPageIndex(APage : TvPage): Integer;
|
||
function GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
|
||
function GetPageAsText(AIndex: Integer): TvTextPageSequence;
|
||
function GetPageCount: Integer;
|
||
function GetCurrentPage: TvPage;
|
||
function GetCurrentPageAsVectorial: TvVectorialPage;
|
||
procedure SetCurrentPage(AIndex: Integer);
|
||
procedure SetDefaultPageFormat(AFormat: TvPageFormat);
|
||
function AddPage(AUseTopLeftCoords: Boolean = False): TvVectorialPage;
|
||
function AddTextPageSequence(): TvTextPageSequence;
|
||
{ Style methods }
|
||
function AddStyle(): TvStyle;
|
||
function AddListStyle: TvListStyle;
|
||
procedure AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
|
||
function GetStyleCount: Integer;
|
||
function GetStyle(AIndex: Integer): TvStyle;
|
||
function FindStyleIndex(AStyle: TvStyle): Integer;
|
||
function GetListStyleCount: Integer;
|
||
function GetListStyle(AIndex: Integer): TvListStyle;
|
||
function FindListStyleIndex(AListStyle: TvListStyle): Integer;
|
||
{ Data removing methods }
|
||
procedure Clear; virtual;
|
||
{ Drawer selection methods }
|
||
function GetRenderer: TvRenderer;
|
||
procedure SetRenderer(ARenderer: TvRenderer);
|
||
procedure ClearRenderer();
|
||
{ Debug methods }
|
||
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer = nil);
|
||
{ Events }
|
||
property OnProgress: TvProgressEvent read FOnProgress write FOnprogress;
|
||
end;
|
||
|
||
{ TvPage }
|
||
|
||
TvPage = class
|
||
private
|
||
procedure InitializeRenderInfo(out ARenderInfo: TvRenderInfo; ACanvas: TFPCustomCanvas; AEntity: TvEntity);
|
||
protected
|
||
FOwner: TvVectorialDocument;
|
||
FUseTopLeftCoordinates: Boolean;
|
||
public
|
||
// Document size for page-based documents
|
||
Width, Height: Double; // in millimeters, may be 0 to use TvVectorialDocument defaults
|
||
// Document size for other documents
|
||
MinX, MinY, MinZ, MaxX, MaxY, MaxZ: Double;
|
||
// Other basic document information
|
||
BackgroundColor: TFPColor;
|
||
AdjustPenColorToBackground: Boolean;
|
||
RenderInfo: TvRenderInfo; // Prepared by the reader with info on how to draw the page
|
||
public
|
||
{ Base methods }
|
||
constructor Create(AOwner: TvVectorialDocument); virtual;
|
||
destructor Destroy; override;
|
||
procedure Assign(ASource: TvPage); virtual;
|
||
procedure SetPageFormat(AFormat: TvPageFormat);
|
||
function RealWidth: Double;
|
||
function RealHeight: Double;
|
||
{ Data reading methods }
|
||
procedure CalculateDocumentSize; virtual;
|
||
function GetEntity(ANum: Cardinal): TvEntity; virtual; abstract;
|
||
function GetEntitiesCount: Integer; virtual; abstract;
|
||
function GetLastEntity(): TvEntity; virtual; abstract;
|
||
function GetEntityIndex(AEntity : TvEntity) : Integer; virtual; abstract;
|
||
function FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; virtual; abstract;
|
||
function FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; virtual; abstract;
|
||
{ Data removing methods }
|
||
procedure Clear; virtual; abstract;
|
||
function DeleteEntity(AIndex: Cardinal): Boolean; virtual; abstract;
|
||
function RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; virtual; abstract;
|
||
{ Data writing methods }
|
||
function AddEntity(AEntity: TvEntity): Integer; virtual; abstract;
|
||
{ Drawing methods }
|
||
procedure DrawBackground(ADest: TFPCustomCanvas); virtual; abstract;
|
||
procedure RenderPageBorder(ADest: TFPCustomCanvas;
|
||
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); virtual; abstract;
|
||
procedure Render(ADest: TFPCustomCanvas;
|
||
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0;
|
||
ADoDraw: Boolean = true); virtual; abstract;
|
||
procedure AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer; out ADeltaX, ADeltaY: Integer; out AZoom: Double); virtual;
|
||
procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); virtual; abstract;
|
||
procedure SetNaturalRenderPos(AUseTopLeftCoords: Boolean); virtual;
|
||
function HasNaturalRenderPos: Boolean;
|
||
function GetTopLeftCoords_Adjustment(): Double;
|
||
{ Debug methods }
|
||
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); virtual; abstract;
|
||
|
||
property Owner: TvVectorialDocument read FOwner;
|
||
property UseTopLeftCoordinates: Boolean read FUseTopLeftCoordinates write FUseTopLeftCoordinates;
|
||
end;
|
||
|
||
{ TvVectorialPage }
|
||
|
||
TvVectorialPage = class(TvPage)
|
||
private
|
||
FEntities: TFPList; // of TvEntity
|
||
FTmpPath: TPath;
|
||
FTmpText: TvText;
|
||
FCurrentLayer: TvEntityWithSubEntities;
|
||
//procedure RemoveCallback(data, arg: pointer);
|
||
procedure ClearTmpPath();
|
||
procedure AppendSegmentToTmpPath(ASegment: TPathSegment);
|
||
procedure CallbackDeleteEntity(data,arg:pointer);
|
||
public
|
||
{ Base methods }
|
||
constructor Create(AOwner: TvVectorialDocument); override;
|
||
destructor Destroy; override;
|
||
procedure Assign(ASource: TvPage); override;
|
||
{ Data reading methods }
|
||
function GetEntity(ANum: Cardinal): TvEntity; override;
|
||
function GetEntitiesCount: Integer; override;
|
||
function GetLastEntity(): TvEntity; override;
|
||
function GetEntityIndex(AEntity : TvEntity) : Integer; override;
|
||
function FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; override;
|
||
function FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; override;
|
||
{ Data removing methods }
|
||
procedure Clear; override;
|
||
function DeleteEntity(AIndex: Cardinal): Boolean; override;
|
||
function RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; override;
|
||
{ Data writing methods }
|
||
function AddEntity(AEntity: TvEntity): Integer; override;
|
||
function AddPathCopyMem(APath: TPath; AOnlyCreate: Boolean = False): TPath;
|
||
procedure StartPath(AX, AY: Double); overload;
|
||
procedure StartPath(); overload;
|
||
procedure AddMoveToPath(AX, AY: Double);
|
||
procedure AddLineToPath(AX, AY: Double); overload;
|
||
procedure AddLineToPath(AX, AY: Double; AColor: TFPColor); overload;
|
||
procedure AddLineToPath(AX, AY, AZ: Double); overload;
|
||
procedure GetCurrentPathPenPos(var AX, AY: Double);
|
||
procedure GetTmpPathStartPos(var AX, AY: Double);
|
||
procedure AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double); overload;
|
||
procedure AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double); overload;
|
||
procedure AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean); // See http://www.w3.org/TR/SVG/paths.html#PathDataEllipticalArcCommands
|
||
procedure AddEllipticalArcWithCenterToPath(ARadX, ARadY, AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
|
||
procedure SetBrushColor(AColor: TFPColor);
|
||
procedure SetBrushStyle(AStyle: TFPBrushStyle);
|
||
procedure SetPenColor(AColor: TFPColor);
|
||
procedure SetPenStyle(AStyle: TFPPenStyle);
|
||
procedure SetPenWidth(AWidth: Integer);
|
||
procedure SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
|
||
function EndPath(AOnlyCreate: Boolean = False): TPath;
|
||
function AddText(AX, AY, AZ: Double; FontName: string; FontSize: Double; AText: string; AOnlyCreate: Boolean = False): TvText; overload;
|
||
function AddText(AX, AY: Double; AStr: string; AOnlyCreate: Boolean = False): TvText; overload;
|
||
function AddText(AX, AY, AZ: Double; AStr: string; AOnlyCreate: Boolean = False): TvText; overload;
|
||
function AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
|
||
function AddCircularArc(ACenterX, ACenterY, ARadius, AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
|
||
function AddEllipse(CenterX, CenterY, HorzHalfAxis, VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
|
||
function AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
|
||
function AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
|
||
// Layers
|
||
function AddLayer(AName: string): TvLayer;
|
||
function AddLayerAndSetAsCurrent(AName: string): TvLayer;
|
||
procedure ClearLayerSelection();
|
||
function SetCurrentLayer(ALayer: TvEntityWithSubEntities): Boolean;
|
||
function GetCurrentLayer: TvEntityWithSubEntities;
|
||
// Dimensions
|
||
function AddAlignedDimension(BaseLeft, BaseRight, DimLeft, DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
|
||
function AddRadialDimension(AIsDiameter: Boolean; ACenter, ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
|
||
function AddArcDimension(AArcValue, AArcRadius: Double; ABaseLeft, ABaseRight, ADimLeft, ADimRight, ATextPos: T3DPoint; AOnlyCreate: Boolean): TvArcDimension;
|
||
//
|
||
function AddPoint(AX, AY, AZ: Double): TvPoint;
|
||
{ Drawing methods }
|
||
procedure PositionEntitySubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
|
||
procedure DrawBackground(ADest: TFPCustomCanvas); override;
|
||
procedure RenderPageBorder(ADest: TFPCustomCanvas;
|
||
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
|
||
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0;
|
||
AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = true); override;
|
||
procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); override;
|
||
{ Debug methods }
|
||
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); override;
|
||
//
|
||
property Entities[AIndex: Cardinal]: TvEntity read GetEntity;
|
||
end;
|
||
|
||
{ TvTextPageSequence }
|
||
|
||
{@@ Represents a sequence of text pages up to a page break }
|
||
|
||
TvTextPageSequence = class(TvPage)
|
||
public
|
||
Footer, Header: TvRichText;
|
||
MainText: TvRichText;
|
||
{ Base methods }
|
||
constructor Create(AOwner: TvVectorialDocument); override;
|
||
destructor Destroy; override;
|
||
procedure Assign(ASource: TvPage); override;
|
||
{ Data reading methods }
|
||
function GetEntity(ANum: Cardinal): TvEntity; override;
|
||
function GetEntitiesCount: Integer; override;
|
||
function GetLastEntity(): TvEntity; override;
|
||
function GetEntityIndex(AEntity : TvEntity) : Integer; override;
|
||
function FindAndSelectEntity(Pos: TPoint): TvFindEntityResult; override;
|
||
function FindEntityWithNameAndType(AName: string; AType: TvEntityClass {= TvEntity}; ARecursively: Boolean = False): TvEntity; override;
|
||
{ Data removing methods }
|
||
procedure Clear; override;
|
||
function DeleteEntity(AIndex: Cardinal): Boolean; override;
|
||
function RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean; override;
|
||
{ Data writing methods }
|
||
function AddEntity(AEntity: TvEntity): Integer; override;
|
||
{ Data writing methods }
|
||
function AddParagraph: TvParagraph;
|
||
function AddList: TvList;
|
||
function AddTable: TvTable;
|
||
function AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
|
||
//function AddImage: TvImage;
|
||
{ Drawing methods }
|
||
procedure DrawBackground(ADest: TFPCustomCanvas); override;
|
||
procedure RenderPageBorder(ADest: TFPCustomCanvas;
|
||
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0); override;
|
||
procedure Render(ADest: TFPCustomCanvas; ADestX: Integer = 0; ADestY: Integer = 0;
|
||
AMulX: Double = 1.0; AMulY: Double = 1.0; ADoDraw: Boolean = true); override;
|
||
procedure GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double); override;
|
||
{ Debug methods }
|
||
procedure GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer); override;
|
||
end;
|
||
|
||
{@@ TvVectorialReader class reference type }
|
||
|
||
TvVectorialReaderClass = class of TvCustomVectorialReader;
|
||
|
||
{ TvCustomVectorialReader }
|
||
|
||
TvCustomVectorialReader = class
|
||
protected
|
||
FFilename: string;
|
||
class function GetTextContentsFromNode(ANode: TDOMNode): DOMString;
|
||
class function RemoveLineEndingsAndTrim(AStr: string): string;
|
||
public
|
||
Settings: TvVectorialReaderSettings;
|
||
{ General reading methods }
|
||
constructor Create; virtual;
|
||
procedure ReadFromFile(AFileName: string; AData: TvVectorialDocument); virtual;
|
||
procedure ReadFromStream(AStream: TStream; AData: TvVectorialDocument); virtual;
|
||
procedure ReadFromStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
|
||
procedure ReadFromXML(ADoc: TXMLDocument; AData: TvVectorialDocument); virtual;
|
||
end;
|
||
|
||
{@@ TvVectorialWriter class reference type }
|
||
|
||
TvVectorialWriterClass = class of TvCustomVectorialWriter;
|
||
|
||
{@@ TvCustomVectorialWriter }
|
||
|
||
{ TvCustomVectorialWriter }
|
||
|
||
TvCustomVectorialWriter = class
|
||
public
|
||
{ General writing methods }
|
||
constructor Create; virtual;
|
||
procedure WriteToFile(AFileName: string; AData: TvVectorialDocument); virtual;
|
||
procedure WriteToStream(AStream: TStream; AData: TvVectorialDocument); virtual;
|
||
procedure WriteToStrings(AStrings: TStrings; AData: TvVectorialDocument); virtual;
|
||
end;
|
||
|
||
{@@ List of registered formats }
|
||
|
||
TvVectorialFormatData = record
|
||
ReaderClass: TvVectorialReaderClass;
|
||
WriterClass: TvVectorialWriterClass;
|
||
ReaderRegistered: Boolean;
|
||
WriterRegistered: Boolean;
|
||
Format: TvVectorialFormat;
|
||
end;
|
||
|
||
TvRenderer = class
|
||
public
|
||
procedure BeginRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); virtual; abstract;
|
||
procedure EndRender(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean); virtual; abstract;
|
||
// TPath
|
||
procedure TPath_Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean; APath: TPath); virtual; abstract;
|
||
end;
|
||
TvRendererClass = class of TvRenderer;
|
||
|
||
var
|
||
GvVectorialFormats: array of TvVectorialFormatData;
|
||
|
||
const
|
||
FormulaOperators = [fekSubtraction, fekMultiplication, fekSum, fekFraction, fekRoot, fekPower];
|
||
|
||
procedure RegisterVectorialReader(
|
||
AReaderClass: TvVectorialReaderClass;
|
||
AFormat: TvVectorialFormat);
|
||
procedure RegisterVectorialWriter(
|
||
AWriterClass: TvVectorialWriterClass;
|
||
AFormat: TvVectorialFormat);
|
||
|
||
function Make2DPoint(AX, AY: Double): T3DPoint;
|
||
function Dimension(AValue : Double; AUnits : TvUnits) : TvDimension;
|
||
function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
|
||
procedure RegisterDefaultRenderer(ARenderer: TvRendererClass);
|
||
|
||
implementation
|
||
|
||
uses fpvutils;
|
||
|
||
const
|
||
Str_Error_Nil_Path = ' The program attempted to add a segment before creating a path';
|
||
INVALID_RENDERINFO_CANVAS_XY = Low(Integer);
|
||
Str_Line_Height_Tester = 'Áç';
|
||
|
||
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
|
||
var
|
||
AutoFitDebug: TStrings = nil;
|
||
{$endif}
|
||
|
||
var
|
||
gDefaultRenderer: TvRendererClass = nil;
|
||
|
||
{@@
|
||
Registers a new reader for a format
|
||
}
|
||
procedure RegisterVectorialReader(
|
||
AReaderClass: TvVectorialReaderClass;
|
||
AFormat: TvVectorialFormat);
|
||
var
|
||
i, len: Integer;
|
||
FormatInTheList: Boolean;
|
||
begin
|
||
len := Length(GvVectorialFormats);
|
||
FormatInTheList := False;
|
||
|
||
{ First search for the format in the list }
|
||
for i := 0 to len - 1 do
|
||
begin
|
||
if GvVectorialFormats[i].Format = AFormat then
|
||
begin
|
||
//if GvVectorialFormats[i].ReaderRegistered then
|
||
//raise Exception.Create('RegisterVectorialReader: Reader class for format ' {+ AFormat} + ' already registered.');
|
||
|
||
GvVectorialFormats[i].ReaderRegistered := True;
|
||
GvVectorialFormats[i].ReaderClass := AReaderClass;
|
||
|
||
FormatInTheList := True;
|
||
Break;
|
||
end;
|
||
end;
|
||
|
||
{ If not already in the list, then add it }
|
||
if not FormatInTheList then
|
||
begin
|
||
SetLength(GvVectorialFormats, len + 1);
|
||
|
||
GvVectorialFormats[len].ReaderClass := AReaderClass;
|
||
GvVectorialFormats[len].WriterClass := nil;
|
||
GvVectorialFormats[len].ReaderRegistered := True;
|
||
GvVectorialFormats[len].WriterRegistered := False;
|
||
GvVectorialFormats[len].Format := AFormat;
|
||
end;
|
||
end;
|
||
|
||
{@@
|
||
Registers a new writer for a format
|
||
}
|
||
procedure RegisterVectorialWriter(
|
||
AWriterClass: TvVectorialWriterClass;
|
||
AFormat: TvVectorialFormat);
|
||
var
|
||
i, len: Integer;
|
||
FormatInTheList: Boolean;
|
||
begin
|
||
len := Length(GvVectorialFormats);
|
||
FormatInTheList := False;
|
||
|
||
{ First search for the format in the list }
|
||
for i := 0 to len - 1 do
|
||
begin
|
||
if GvVectorialFormats[i].Format = AFormat then
|
||
begin
|
||
if GvVectorialFormats[i].WriterRegistered then
|
||
raise Exception.Create('RegisterVectorialWriter: Writer class for format ' + {AFormat +} ' already registered.');
|
||
|
||
GvVectorialFormats[i].WriterRegistered := True;
|
||
GvVectorialFormats[i].WriterClass := AWriterClass;
|
||
|
||
FormatInTheList := True;
|
||
Break;
|
||
end;
|
||
end;
|
||
|
||
{ If not already in the list, then add it }
|
||
if not FormatInTheList then
|
||
begin
|
||
SetLength(GvVectorialFormats, len + 1);
|
||
|
||
GvVectorialFormats[len].ReaderClass := nil;
|
||
GvVectorialFormats[len].WriterClass := AWriterClass;
|
||
GvVectorialFormats[len].ReaderRegistered := False;
|
||
GvVectorialFormats[len].WriterRegistered := True;
|
||
GvVectorialFormats[len].Format := AFormat;
|
||
end;
|
||
end;
|
||
|
||
function Make2DPoint(AX, AY: Double): T3DPoint;
|
||
begin
|
||
Result.X := AX;
|
||
Result.Y := AY;
|
||
Result.Z := 0;
|
||
end;
|
||
|
||
function Dimension(AValue: Double; AUnits: TvUnits): TvDimension;
|
||
begin
|
||
Result.Value := AValue;
|
||
Result.Units := AUnits;
|
||
end;
|
||
|
||
function ConvertDimensionToMM(ADimension: TvDimension; ATotalSize: Double): Double;
|
||
begin
|
||
case ADimension.Units of
|
||
dimMillimeter: Result := ADimension.Value;
|
||
dimPercent: Result := ATotalSize * ADimension.Value;
|
||
dimPoint: Result := ADimension.Value; // ToDo
|
||
end;
|
||
end;
|
||
|
||
procedure RegisterDefaultRenderer(ARenderer: TvRendererClass);
|
||
begin
|
||
gDefaultRenderer := ARenderer;
|
||
end;
|
||
|
||
{ TvStyle }
|
||
|
||
constructor TvStyle.Create;
|
||
begin
|
||
// Defaults
|
||
SuppressSpacingBetweenSameParagraphs:=False;
|
||
end;
|
||
|
||
function TvStyle.GetKind: TvStyleKind;
|
||
begin
|
||
if Parent = nil then Result := Kind
|
||
else Result := Parent.GetKind();
|
||
end;
|
||
|
||
procedure TvStyle.Clear;
|
||
begin
|
||
Name := '';
|
||
Parent := nil;
|
||
Kind := vskTextBody;
|
||
Alignment := vsaLeft;
|
||
|
||
//
|
||
{Pen.Color := col;
|
||
Brush := nil;
|
||
Font := nil;}
|
||
SetElements := [];
|
||
//
|
||
MarginTop := 0;
|
||
MarginBottom := 0;
|
||
MarginLeft := 0;
|
||
MarginRight := 0;
|
||
//
|
||
end;
|
||
|
||
procedure TvStyle.CopyFrom(AFrom: TvStyle);
|
||
begin
|
||
Clear();
|
||
ApplyOver(AFrom);
|
||
end;
|
||
|
||
procedure TvStyle.CopyFromEntity(AEntity: TvEntity);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvStyle.ApplyOverFromPen(APen: PvPen; ASetElements: TvSetStyleElements);
|
||
begin
|
||
if spbfPenColor in ASetElements then
|
||
Pen.Color := APen^.Color;
|
||
if spbfPenStyle in ASetElements then
|
||
Pen.Style := APen^.Style;
|
||
if spbfPenWidth in ASetElements then
|
||
Pen.Width := APen^.Width;
|
||
|
||
SetElements += ASetElements * [spbfPenColor, spbfPenStyle, spbfPenWidth];
|
||
end;
|
||
|
||
procedure TvStyle.ApplyOverFromBrush(ABrush: PvBrush; ASetElements: TvSetStyleElements);
|
||
begin
|
||
if spbfBrushColor in ASetElements then
|
||
Brush.Color := ABrush^.Color;
|
||
if spbfBrushStyle in ASetElements then
|
||
Brush.Style := ABrush^.Style;
|
||
{if spbfBrushGradient in ASetElements then
|
||
Brush.Gra := AFrom.Brush.Style;}
|
||
if spbfBrushKind in ASetElements then
|
||
Brush.Kind := ABrush^.Kind;
|
||
|
||
SetElements += ASetElements * [spbfBrushColor, spbfBrushStyle, spbfBrushGradient, spbfBrushKind];
|
||
end;
|
||
|
||
procedure TvStyle.ApplyOverFromFont(AFont: PvFont; ASetElements: TvSetStyleElements);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvStyle.ApplyOver(AFrom: TvStyle);
|
||
begin
|
||
if AFrom = nil then Exit;
|
||
|
||
// Pen
|
||
|
||
ApplyOverFromPen(@AFrom.Pen, AFrom.SetElements);
|
||
|
||
// Brush
|
||
|
||
ApplyOverFromBrush(@AFrom.Brush, AFrom.SetElements);
|
||
|
||
// Font
|
||
|
||
//ApplyOverFromFont(@AFrom.Font, AFrom.SetElements);
|
||
if spbfFontColor in AFrom.SetElements then
|
||
Font.Color := AFrom.Font.Color;
|
||
if spbfFontSize in AFrom.SetElements then
|
||
Font.Size := AFrom.Font.Size;
|
||
if spbfFontName in AFrom.SetElements then
|
||
Font.Name := AFrom.Font.Name;
|
||
if spbfFontBold in AFrom.SetElements then
|
||
Font.Bold := AFrom.Font.Bold;
|
||
if spbfFontItalic in AFrom.SetElements then
|
||
Font.Italic := AFrom.Font.Italic;
|
||
If spbfFontUnderline in AFrom.SetElements then
|
||
Font.Underline := AFrom.Font.Underline;
|
||
If spbfFontStrikeThrough in AFrom.SetElements then
|
||
Font.StrikeThrough := AFrom.Font.StrikeThrough;
|
||
If spbfAlignment in AFrom.SetElements then
|
||
Alignment := AFrom.Alignment;
|
||
|
||
// TextAnchor
|
||
if spbfTextAnchor in AFrom.SetElements then
|
||
TextAnchor := AFrom.TextAnchor;
|
||
|
||
// Style
|
||
|
||
if sseMarginTop in AFrom.SetElements then
|
||
MarginTop := AFrom.MarginTop;
|
||
If sseMarginBottom in AFrom.SetElements then
|
||
MarginBottom := AFrom.MarginBottom;
|
||
If sseMarginLeft in AFrom.SetElements then
|
||
MarginLeft := AFrom.MarginLeft;
|
||
If sseMarginRight in AFrom.SetElements then
|
||
MarginRight := AFrom.MarginRight;
|
||
|
||
// Other
|
||
SuppressSpacingBetweenSameParagraphs:=AFrom.SuppressSpacingBetweenSameParagraphs;
|
||
|
||
SetElements := AFrom.SetElements + SetElements;
|
||
end;
|
||
|
||
procedure TvStyle.ApplyIntoEntity(ADest: TvEntity);
|
||
var
|
||
lCurEntity: TvEntity;
|
||
ADestWithPen: TvEntityWithPen absolute ADest;
|
||
ADestWithBrush: TvEntityWithPenAndBrush absolute ADest;
|
||
ADestWithFont: TvEntityWithPenBrushAndFont absolute ADest;
|
||
begin
|
||
if ADest = nil then Exit;
|
||
|
||
if ADest is TvEntityWithSubEntities then
|
||
begin
|
||
lCurEntity := (ADest as TvEntityWithSubEntities).GetFirstEntity();
|
||
while lCurEntity <> nil do
|
||
begin
|
||
ApplyIntoEntity(lCurEntity);
|
||
lCurEntity := (ADest as TvEntityWithSubEntities).GetNextEntity();
|
||
end;
|
||
Exit;
|
||
end;
|
||
|
||
// Pen
|
||
if ADest is TvEntityWithPen then
|
||
begin
|
||
if spbfPenColor in SetElements then
|
||
ADestWithPen.Pen.Color := Pen.Color;
|
||
if spbfPenStyle in SetElements then
|
||
ADestWithPen.Pen.Style := Pen.Style;
|
||
if spbfPenWidth in SetElements then
|
||
ADestWithPen.Pen.Width := Pen.Width;
|
||
end;
|
||
|
||
// Brush
|
||
if ADest is TvEntityWithPenAndBrush then
|
||
begin
|
||
if spbfBrushColor in SetElements then
|
||
ADestWithBrush.Brush.Color := Brush.Color;
|
||
if spbfBrushStyle in SetElements then
|
||
ADestWithBrush.Brush.Style := Brush.Style;
|
||
{if spbfBrushGradient in SetElements then
|
||
ADestWithBrush.Gra := AFrom.Brush.Style;}
|
||
if spbfBrushKind in SetElements then
|
||
ADestWithBrush.Brush.Kind := Brush.Kind;
|
||
end;
|
||
|
||
// Font
|
||
if ADest is TvEntityWithPenBrushAndFont then
|
||
begin
|
||
if spbfFontColor in SetElements then
|
||
ADestWithFont.Font.Color := Font.Color;
|
||
if spbfFontSize in SetElements then
|
||
ADestWithFont.Font.Size := Font.Size;
|
||
if spbfFontName in SetElements then
|
||
ADestWithFont.Font.Name := Font.Name;
|
||
if spbfFontBold in SetElements then
|
||
ADestWithFont.Font.Bold := Font.Bold;
|
||
if spbfFontItalic in SetElements then
|
||
ADestWithFont.Font.Italic := Font.Italic;
|
||
If spbfFontUnderline in SetElements then
|
||
ADestWithFont.Font.Underline := Font.Underline;
|
||
If spbfFontStrikeThrough in SetElements then
|
||
ADestWithFont.Font.StrikeThrough := Font.StrikeThrough;
|
||
{If spbfAlignment in SetElements then
|
||
ADestWithFont.Alignment := Alignment; }
|
||
|
||
// TextAnchor
|
||
if spbfTextAnchor in SetElements then
|
||
ADestWithFont.TextAnchor := TextAnchor;
|
||
end;
|
||
end;
|
||
|
||
function TvStyle.CreateStyleCombinedWithParent: TvStyle;
|
||
begin
|
||
Result := TvStyle.Create;
|
||
Result.CopyFrom(Self);
|
||
if Parent <> nil then Result.ApplyOver(Parent);
|
||
end;
|
||
|
||
function TvStyle.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr, lParentName: string;
|
||
begin
|
||
if Parent <> nil then lParentName := Parent.Name
|
||
else lParentName := '<No Parent>';
|
||
|
||
lStr := Format('[%s] Name=%s Parent=%s',
|
||
[Self.ClassName, Name, lParentName]);
|
||
|
||
if spbfPenColor in SetElements then
|
||
lStr := lStr + Format(' Pen.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
|
||
{ spbfPenStyle, spbfPenWidth,
|
||
spbfBrushColor, spbfBrushStyle, spbfBrushGradient,}
|
||
if spbfFontColor in SetElements then
|
||
lStr := lStr + Format(' Font.Color=%s', [TvEntity.GenerateDebugStrForFPColor(Pen.Color)]);
|
||
if spbfFontSize in SetElements then
|
||
lStr := lStr + Format(' Font.Size=%f', [Font.Size]);
|
||
if spbfFontName in SetElements then
|
||
lStr := lStr + ' Font.Name=' + Font.Name;
|
||
if spbfFontBold in SetElements then
|
||
if Font.Bold then lStr := lStr + Format(' Font.Bold=%s', [BoolToStr(Font.Bold)]);
|
||
if spbfFontItalic in SetElements then
|
||
if Font.Italic then lStr := lStr + Format(' Font.Bold=%s', [BoolToStr(Font.Italic)]);
|
||
{
|
||
spbfFontUnderline, spbfFontStrikeThrough, spbfAlignment,
|
||
// Page style
|
||
sseMarginTop, sseMarginBottom, sseMarginLeft, sseMarginRight
|
||
);
|
||
Font.Size, Font.Name, Font.Orientation,
|
||
BoolToStr(Font.Underline),
|
||
BoolToStr(Font.StrikeThrough),
|
||
GetEnumName(TypeInfo(TvTextAnchor), integer(TextAnchor))}
|
||
lStr := lStr + FExtraDebugStr;
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
{ TvListLevelStyle }
|
||
|
||
constructor TvListLevelStyle.Create;
|
||
begin
|
||
Start := 1;
|
||
Bullet := '·';
|
||
LeaderFontName := 'Symbol';
|
||
Alignment := vsaLeft;
|
||
end;
|
||
|
||
{ TvListStyle }
|
||
|
||
constructor TvListStyle.Create;
|
||
begin
|
||
ListLevelStyles:=TFPList.Create;
|
||
end;
|
||
|
||
destructor TvListStyle.Destroy;
|
||
begin
|
||
Clear;
|
||
ListLevelStyles.Free;
|
||
ListLevelStyles := Nil;
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvListStyle.Clear;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i := ListLevelStyles.Count-1 downto 0 do
|
||
begin
|
||
TvListLevelStyle(ListLevelStyles[i]).free;
|
||
ListLevelStyles.Delete(i);
|
||
end;
|
||
end;
|
||
|
||
function TvListStyle.AddListLevelStyle: TvListLevelStyle;
|
||
begin
|
||
Result := TvListLevelStyle.Create;
|
||
ListLevelStyles.Add(Result);
|
||
end;
|
||
|
||
function TvListStyle.GetListLevelStyleCount: Integer;
|
||
begin
|
||
Result := ListLevelStyles.Count;
|
||
end;
|
||
|
||
function TvListStyle.GetListLevelStyle(AIndex : Integer): TvListLevelStyle;
|
||
begin
|
||
Result := TvListLevelStyle(ListLevelStyles[Aindex]);
|
||
end;
|
||
|
||
{ TvTableCell }
|
||
|
||
constructor TvTableCell.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
|
||
Borders.Left.LineType:=tbtDefault;
|
||
Borders.Right.LineType:=tbtDefault;
|
||
Borders.Top.LineType:=tbtDefault;
|
||
Borders.Bottom.LineType:=tbtDefault;
|
||
Borders.InsideHoriz.LineType:=tbtDefault;
|
||
Borders.InsideVert.LineType:=tbtDefault;
|
||
|
||
SpacingLeft := 2;
|
||
SpacingRight := 2;
|
||
SpacingTop := 2;
|
||
SpacingBottom := 2;
|
||
|
||
SpannedCols := 1;
|
||
end;
|
||
|
||
function TvTableCell.GetEffectiveBorder(): TvTableBorders;
|
||
begin
|
||
Result := Borders;
|
||
if (Row <> nil) and (Row.Table <> nil) then
|
||
begin
|
||
if Borders.Left.LineType = tbtDefault then
|
||
Result.Left := Row.Table.Borders.Left;
|
||
if Borders.Right.LineType = tbtDefault then
|
||
Result.Right := Row.Table.Borders.Right;
|
||
if Borders.Top.LineType = tbtDefault then
|
||
Result.Top := Row.Table.Borders.Top;
|
||
if Borders.Bottom.LineType = tbtDefault then
|
||
Result.Bottom := Row.Table.Borders.Bottom;
|
||
end;
|
||
end;
|
||
|
||
procedure TvTableCell.GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double);
|
||
begin
|
||
ATopSpacing := 0;
|
||
ALeftSpacing := 0;
|
||
ARightSpacing := 0;
|
||
ABottomSpacing := 0;
|
||
if SpacingDataValid then
|
||
begin
|
||
ATopSpacing := SpacingTop;
|
||
ALeftSpacing := SpacingLeft;
|
||
ARightSpacing := SpacingRight;
|
||
ABottomSpacing := SpacingBottom;
|
||
end
|
||
else if (Row <> nil) and (Row.SpacingDataValid) then
|
||
begin
|
||
ATopSpacing := Row.CellSpacing;
|
||
ALeftSpacing := Row.CellSpacing;
|
||
ARightSpacing := Row.CellSpacing;
|
||
ABottomSpacing := Row.CellSpacing;
|
||
end
|
||
else if (Row <> nil) and (Row.Table <> nil) then
|
||
begin
|
||
ATopSpacing := Row.Table.CellSpacingLeft;
|
||
ALeftSpacing := Row.Table.CellSpacingTop;
|
||
ARightSpacing := Row.Table.CellSpacingRight;
|
||
ABottomSpacing := Row.Table.CellSpacingBottom;
|
||
end;
|
||
end;
|
||
|
||
class procedure TvTableCell.DrawBorder(ABorder: TvTableBorders;
|
||
AX, AY, AWidth, AHeight: double;
|
||
ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer = 0;
|
||
ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
begin
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(AX), CoordToCanvasY(AY));
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(AX), CoordToCanvasY(AY+AHeight));
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Pen.FPColor := colBlack;
|
||
if ABorder.Left.LineType <> tbtNone then
|
||
begin
|
||
ADest.Pen.Width := Round(ABorder.Left.Width * AMulX);
|
||
ADest.Line(
|
||
CoordToCanvasX(AX),
|
||
CoordToCanvasY(AY),
|
||
CoordToCanvasX(AX),
|
||
CoordToCanvasY(AY+AHeight));
|
||
end;
|
||
if ABorder.Right.LineType <> tbtNone then
|
||
begin
|
||
ADest.Pen.Width := Round(ABorder.Right.Width * AMulX);
|
||
ADest.Line(
|
||
CoordToCanvasX(AX+AWidth),
|
||
CoordToCanvasY(AY),
|
||
CoordToCanvasX(AX+AWidth),
|
||
CoordToCanvasY(AY+AHeight));
|
||
end;
|
||
if ABorder.Top.LineType <> tbtNone then
|
||
begin
|
||
ADest.Pen.Width := Round(ABorder.Top.Width * AMulX);
|
||
ADest.Line(
|
||
CoordToCanvasX(AX),
|
||
CoordToCanvasY(AY),
|
||
CoordToCanvasX(AX+AWidth),
|
||
CoordToCanvasY(AY));
|
||
end;
|
||
if ABorder.Bottom.LineType <> tbtNone then
|
||
begin
|
||
ADest.Pen.Width := Round(ABorder.Bottom.Width * AMulX);
|
||
ADest.Line(
|
||
CoordToCanvasX(AX),
|
||
CoordToCanvasY(AY+AHeight),
|
||
CoordToCanvasX(AX+AWidth),
|
||
CoordToCanvasY(AY+AHeight));
|
||
end;
|
||
end;
|
||
|
||
procedure TvTableCell.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
lBorders: TvTableBorders;
|
||
CellWidth, CellHeight, lCellSpacingX, lCellSpacingY, lTmp: Double;
|
||
lColNr: Integer;
|
||
i: Integer;
|
||
begin
|
||
// draw borders
|
||
if (Row <> nil) and (Row.Table <> nil) and ADoDraw then
|
||
begin
|
||
lBorders := GetEffectiveBorder();
|
||
lColNr := Row.GetCellColNr(Self);
|
||
|
||
CellWidth := 0;
|
||
for i := lColNr to lColNr+SpannedCols-1 do
|
||
begin
|
||
CellWidth := CellWidth + Row.Table.ColWidthsInMM[i];
|
||
end;
|
||
CellHeight := Row.Height;
|
||
|
||
TvTableCell.DrawBorder(lBorders, X, Y, CellWidth, CellHeight,
|
||
ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
|
||
end;
|
||
|
||
GetEffectiveCellSpacing(lCellSpacingX, lCellSpacingY, lTmp, lTmp);
|
||
X := X + lCellSpacingX;
|
||
Y := Y + lCellSpacingY;
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
X := X - lCellSpacingX;
|
||
Y := Y - lCellSpacingY;
|
||
end;
|
||
|
||
function TvTableCell.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
|
||
begin
|
||
FExtraDebugStr := Format(' Borders=%s PreferredWidth=%f VerticalAlignment=%s' +
|
||
' BackgroundColor=%s SpannedCols=%d',
|
||
[GenerateDebugStrForBorders(Borders),
|
||
PreferredWidth.Value,
|
||
GetEnumName(TypeInfo(TvVerticalAlignment), integer(VerticalAlignment)),
|
||
GenerateDebugStrForFPColor(BackgroundColor), SpannedCols]);
|
||
|
||
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
end;
|
||
|
||
class function TvTableCell.GenerateDebugStrForBorders(ABorders: TvTableBorders): string;
|
||
begin
|
||
Result := Format('L=%s:%f T=%s:%f R=%s:%f B=%s:%f',
|
||
[GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Left.LineType)),
|
||
ABorders.Left.Width,
|
||
GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Top.LineType)),
|
||
ABorders.Top.Width,
|
||
GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Right.LineType)),
|
||
ABorders.Right.Width,
|
||
GetEnumName(TypeInfo(TvTableBorderType), integer(ABorders.Bottom.LineType)),
|
||
ABorders.Bottom.Width]);
|
||
end;
|
||
|
||
{ TvTable }
|
||
|
||
// Returns the table width
|
||
procedure TvTable.CalculateColWidths(constref ARenderInfo: TvRenderInfo);
|
||
var
|
||
CurRow: TvTableRow;
|
||
CurCell: TvTableCell;
|
||
lWidth: Double;
|
||
col, row, i: Integer;
|
||
//DebugStr: string;
|
||
OriginalColWidthsInMM: array of Double;
|
||
CurRowTableWidth: Double;
|
||
begin
|
||
SetLength(ColWidthsInMM, GetColCount());
|
||
|
||
// Process predefined widths
|
||
for col := 0 to Length(ColWidthsInMM)-1 do
|
||
begin
|
||
ColWidthsInMM[col] := 0;
|
||
if Length(ColWidths) > col then
|
||
ColWidthsInMM[col] := ConvertDimensionToMM(Dimension(ColWidths[col], ColWidthsUnits), FPage.Width);
|
||
end;
|
||
|
||
// Process initial value for non-predefined widths
|
||
OriginalColWidthsInMM := Copy(ColWidthsInMM, 0, Length(ColWidthsInMM));
|
||
TableWidth := 0;
|
||
for row := 0 to GetRowCount()-1 do
|
||
begin
|
||
CurRow := GetRow(row);
|
||
CurRowTableWidth := 0;
|
||
|
||
for col := 0 to CurRow.GetCellCount()-1 do
|
||
begin
|
||
CurCell := CurRow.GetCell(col);
|
||
//DebugStr := ((CurCell.GetFirstEntity() as TvParagraph).GetFirstEntity() as TvText).Value.Text;
|
||
|
||
// skip cells with span since they are complex
|
||
// skip columns with width pre-set
|
||
if (OriginalColWidthsInMM[col] > 0) then
|
||
begin
|
||
CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
|
||
Continue;
|
||
end;
|
||
if (CurCell.SpannedCols > 1) then
|
||
begin
|
||
CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
|
||
for i := 0 to CurCell.SpannedCols-1 do
|
||
CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col+i];
|
||
Continue;
|
||
end;
|
||
|
||
lWidth := CurCell.CalculateMaxNeededWidth(ARenderInfo);
|
||
ColWidthsInMM[col] := Max(ColWidthsInMM[col], lWidth);
|
||
CurRowTableWidth := CurRowTableWidth + ColWidthsInMM[col];
|
||
end;
|
||
|
||
TableWidth := Max(TableWidth, CurRowTableWidth);
|
||
end;
|
||
|
||
// If it goes over the page width, recalculate with equal sizes (in the future do better)
|
||
if FPage.Width <= 0 then Exit;
|
||
if TableWidth <= FPage.Width then Exit;
|
||
TableWidth := FPage.Width;
|
||
for col := 0 to Length(ColWidthsInMM)-1 do
|
||
begin
|
||
ColWidthsInMM[col] := FPage.Width / GetRowCount();
|
||
end;
|
||
end;
|
||
|
||
procedure TvTable.CalculateRowHeights(constref ARenderInfo: TvRenderInfo);
|
||
var
|
||
col, row: Integer;
|
||
CurRow: TvTableRow;
|
||
CurCell: TvTableCell;
|
||
lCellHeight: Double;
|
||
begin
|
||
TableHeight := 0;
|
||
|
||
for row := 0 to GetRowCount()-1 do
|
||
begin
|
||
CurRow := GetRow(row);
|
||
CurRow.Height := 0;
|
||
|
||
for col := 0 to CurRow.GetCellCount()-1 do
|
||
begin
|
||
CurCell := CurRow.GetCell(col);
|
||
lCellHeight := CurCell.CalculateCellHeight_ForWidth(ARenderInfo, ColWidthsInMM[col]);
|
||
CurRow.Height := Max(CurRow.Height, lCellHeight);
|
||
end;
|
||
|
||
CurRow.Height := CurRow.Height + CurRow.CalculateMaxCellSpacing_Y();
|
||
TableHeight := TableHeight + SpacingBetweenCells;
|
||
CurRow.Y := TableHeight;
|
||
TableHeight := TableHeight + CurRow.Height;
|
||
end;
|
||
|
||
TableHeight := TableHeight + SpacingBetweenCells;
|
||
end;
|
||
|
||
constructor TvTable.create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
Rows := TFPList.Create;
|
||
|
||
// Use default cell border widths of 0.5 pts, like Word or Writer.
|
||
Borders.Left.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
|
||
Borders.Right.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
|
||
Borders.Top.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
|
||
Borders.Bottom.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
|
||
Borders.InsideHoriz.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
|
||
Borders.InsideVert.Width := 0.5 * FPV_TEXT_POINT_TO_MM;
|
||
end;
|
||
|
||
destructor TvTable.destroy;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i := Rows.Count-1 downto 0 do
|
||
begin
|
||
TvTableRow(Rows.Last).Free;
|
||
Rows.Delete(Rows.Count-1);
|
||
end;
|
||
|
||
Rows.Free;
|
||
Rows := nil;
|
||
|
||
inherited destroy;
|
||
end;
|
||
|
||
function TvTable.AddRow: TvTableRow;
|
||
begin
|
||
Result := TvTableRow.create(FPage);
|
||
Result.Table := Self;
|
||
Rows.Add(result);
|
||
end;
|
||
|
||
function TvTable.GetRowCount: Integer;
|
||
begin
|
||
Result := Rows.Count;
|
||
end;
|
||
|
||
function TvTable.GetRow(AIndex: Integer): TvTableRow;
|
||
begin
|
||
Result := TvTableRow(Rows[AIndex]);
|
||
end;
|
||
|
||
function TvTable.GetColCount(): Integer;
|
||
var
|
||
row, col, CurRowColCount: Integer;
|
||
CurRow: TvTableRow;
|
||
CurCell: TvTableCell;
|
||
begin
|
||
Result := 0;
|
||
for row := 0 to GetRowCount()-1 do
|
||
begin
|
||
CurRow := GetRow(row);
|
||
CurRowColCount := 0;
|
||
for col := 0 to CurRow.GetCellCount()-1 do
|
||
begin
|
||
CurCell := CurRow.GetCell(col);
|
||
CurRowColCount := CurRowColCount + CurCell.SpannedCols;
|
||
end;
|
||
|
||
Result := Max(Result, CurRowColCount);
|
||
end;
|
||
end;
|
||
|
||
procedure TvTable.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
function DeltaToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
row: Integer;
|
||
CurRow: TvTableRow;
|
||
lEntityRenderInfo: TvRenderInfo;
|
||
begin
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
|
||
// First calculate the column widths and heights
|
||
CalculateColWidths(ARenderInfo);
|
||
|
||
// Now calculate the row heights
|
||
CalculateRowHeights(ARenderInfo);
|
||
|
||
// Draw the table border
|
||
if ADoDraw then
|
||
begin
|
||
TvTableCell.DrawBorder(Borders, X, Y, TableWidth, TableHeight,
|
||
ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
|
||
end;
|
||
|
||
// Now draw the table
|
||
for row := 0 to GetRowCount()-1 do
|
||
begin
|
||
CurRow := GetRow(row);
|
||
|
||
// changes from pos relative inside table (calculated in CalculateRowHeights) to absolute pos
|
||
CurRow.Y := Y + CurRow.Y;
|
||
|
||
CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
CurRow.Render(lEntityRenderInfo, ADoDraw);
|
||
//MergeRenderInfo(lEntityRenderInfo, ARenderInfo); no need to merge, since TvTableCell.DrawBorder calculates the proper size
|
||
end;
|
||
end;
|
||
|
||
function TvTable.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
i: Integer;
|
||
lCurRow: TvTableRow;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
|
||
// data which goes into a separate item
|
||
FExtraDebugStr := 'ColWidthsInMM=';
|
||
for i := 0 to Length(ColWidthsInMM)-1 do
|
||
FExtraDebugStr := FExtraDebugStr + Format('[%d]=%f ', [i, ColWidthsInMM[i]]);
|
||
ADestRoutine(FExtraDebugStr, Result);
|
||
|
||
// Add rows
|
||
for i := 0 to GetRowCount()-1 do
|
||
begin
|
||
lCurRow := GetRow(i);
|
||
lCurRow.GenerateDebugTree(ADestRoutine, Result);
|
||
end;
|
||
end;
|
||
|
||
function TvTable.AddColWidth(AValue: Double): Integer;
|
||
begin
|
||
SetLength(ColWidths, Length(ColWidths) + 1);
|
||
Result := High(ColWidths);
|
||
ColWidths[Result] := AValue;
|
||
end;
|
||
|
||
|
||
{ TvEmbeddedVectorialDoc }
|
||
|
||
constructor TvEmbeddedVectorialDoc.create(APage: TvPage);
|
||
begin
|
||
inherited create(APage);
|
||
Document := TvVectorialDocument.Create();
|
||
FWidth := -1;
|
||
FHeight := -1;
|
||
end;
|
||
|
||
destructor TvEmbeddedVectorialDoc.destroy;
|
||
begin
|
||
Document.Free;
|
||
inherited destroy;
|
||
end;
|
||
|
||
procedure TvEmbeddedVectorialDoc.UpdateDocumentSize;
|
||
begin
|
||
if (Document.Width = 0) or (Document.Height = 0) then
|
||
begin
|
||
Document.GuessDocumentSize();
|
||
end;
|
||
end;
|
||
|
||
function TvEmbeddedVectorialDoc.GetWidth: Double;
|
||
begin
|
||
if FWidth >= 0 then
|
||
Result := FWidth
|
||
else
|
||
Result := Document.Width;
|
||
end;
|
||
|
||
function TvEmbeddedVectorialDoc.GetHeight: Double;
|
||
begin
|
||
if FHeight >= 0 then
|
||
Result := FHeight
|
||
else
|
||
Result := Document.Height;
|
||
end;
|
||
|
||
procedure TvEmbeddedVectorialDoc.SetWidth(AValue: Double);
|
||
begin
|
||
FWidth := AValue;
|
||
end;
|
||
|
||
procedure TvEmbeddedVectorialDoc.SetHeight(AValue: Double);
|
||
begin
|
||
FHeight := AValue;
|
||
end;
|
||
|
||
procedure TvEmbeddedVectorialDoc.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
begin
|
||
UpdateDocumentSize();
|
||
ALeft := X;
|
||
ATop := Y;
|
||
ARight := X + GetWidth();
|
||
ABottom := Y + GetHeight();
|
||
end;
|
||
|
||
procedure TvEmbeddedVectorialDoc.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
lPage: TvPage;
|
||
lX_px, lY_px, lWidth_px, lHeight_px, lPageHeight, lDeltaX, lDeltaY: Integer;
|
||
lMulY, lZoom: Double;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
if Document.GetPageCount() = 0 then Exit;
|
||
|
||
lPage := Document.GetPage(0);
|
||
lPageHeight := Round(lPage.Height);
|
||
lPage.GetNaturalRenderPos(lPageHeight, lMulY);
|
||
|
||
UpdateDocumentSize();
|
||
lX_px := CoordToCanvasX(X);
|
||
lY_px := CoordToCanvasY(Y);
|
||
|
||
// Ignore MulX/MulY here so that it doesn't affect AutoFit, this fixes an
|
||
// issue where embeded svg in html was getting out of proportion if the zoom
|
||
// was different than 1.0
|
||
// Calculate the standard zoom (zoom with mulx=1.0)
|
||
lWidth_px := Round(GetWidth());
|
||
lHeight_px := Round(GetHeight());
|
||
lPage.AutoFit(ADest, lWidth_px, lHeight_px, lHeight_px, lDeltaX, lDeltaY, lZoom);
|
||
lZoom := Abs(lZoom);
|
||
lX_px += lDeltaX;
|
||
lY_px += lDeltaY;
|
||
if AmulY * lMulY < 0 then
|
||
begin
|
||
lY_px := lY_px + lHeight_px;
|
||
end;
|
||
// recalculate lWidth_px/height considering now mulx/muly
|
||
lWidth_px := Abs(CoordToCanvasX(GetWidth()));
|
||
lHeight_px := Abs(CoordToCanvasY(GetHeight()));
|
||
|
||
if ADoDraw then
|
||
begin
|
||
lPage.Render(ADest, lX_px, lY_px, AMulX * lZoom, AMulY * lMulY * lZoom);
|
||
{ADest.Pen.FPColor := colRed;
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Rectangle(CoordToCanvasX(X), CoordToCanvasY(lY), CoordToCanvasX(X+Width), CoordToCanvasY(lY+Height));
|
||
ADest.Rectangle(lX_px, lY_px, lX_px+100, lY_px+100);}
|
||
end;
|
||
|
||
if (ARenderInfo.Errors <> nil) and (lPage.RenderInfo.Errors <> nil) then
|
||
begin
|
||
AddStringsToArray(ARenderInfo.Errors, lPage.RenderInfo.Errors);
|
||
// was: ARenderInfo.Errors.AddStrings(lPage.RenderInfo.Errors);
|
||
end;
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, CoordToCanvasX(X), CoordToCanvasY(Y));
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo,
|
||
CoordToCanvasX(X + Document.Width),
|
||
CoordToCanvasY(Y + Document.Height));
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, lX_px, lY_px);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, lX_px+lWidth_px, lY_px+lHeight_px);
|
||
end;
|
||
|
||
function TvEmbeddedVectorialDoc.GenerateDebugTree(
|
||
ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
|
||
begin
|
||
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
Document.GenerateDebugTree(ADestRoutine, Result);
|
||
end;
|
||
|
||
{ TvTableRow }
|
||
|
||
constructor TvTableRow.create(APage: TvPage);
|
||
begin
|
||
inherited create(APage);
|
||
|
||
Cells := TFPList.Create;
|
||
|
||
Header := False;
|
||
end;
|
||
|
||
destructor TvTableRow.destroy;
|
||
Var
|
||
i : Integer;
|
||
begin
|
||
for i := Cells.Count-1 downto 0 do
|
||
begin
|
||
TvTableCell(Cells.Last).Free;
|
||
Cells.Delete(Cells.Count-1);
|
||
end;
|
||
|
||
Cells.Free;
|
||
Cells := Nil;
|
||
|
||
inherited destroy;
|
||
end;
|
||
|
||
function TvTableRow.AddCell : TvTableCell;
|
||
begin
|
||
Result := TvTableCell.Create(FPage);
|
||
Result.Row := Self;
|
||
Cells.Add(Result);
|
||
end;
|
||
|
||
function TvTableRow.GetCellCount: Integer;
|
||
begin
|
||
Result := Cells.Count;
|
||
end;
|
||
|
||
function TvTableRow.GetCell(AIndex: Integer): TvTableCell;
|
||
begin
|
||
Result := TvTableCell(Cells[AIndex]);
|
||
end;
|
||
|
||
function TvTableRow.GetCellColNr(ACell: TvTableCell): Integer;
|
||
begin
|
||
Result := Cells.IndexOf(Pointer(ACell));
|
||
end;
|
||
|
||
function TvTableRow.CalculateMaxCellSpacing_Y(): Double;
|
||
Var
|
||
i : Integer;
|
||
CurCell: TvTableCell;
|
||
lTopSpacing, lLeftSpacing, lRightSpacing, lBottomSpacing: Double;
|
||
begin
|
||
Result := 0;
|
||
for i := 0 to GetCellCount()-1 do
|
||
begin
|
||
CurCell := GetCell(i);
|
||
CurCell.GetEffectiveCellSpacing(lTopSpacing, lLeftSpacing, lRightSpacing, lBottomSpacing);
|
||
Result := Max(Result, lBottomSpacing+lTopSpacing);
|
||
end;
|
||
end;
|
||
|
||
procedure TvTableRow.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
begin
|
||
ALeft := X;
|
||
ATop := Y;
|
||
ARight := X + FPage.Width;
|
||
ABottom := Y + Height;
|
||
end;
|
||
|
||
procedure TvTableRow.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
CurCell: TvTableCell;
|
||
i: Integer;
|
||
CurX_mm: Double = 0.0;
|
||
lEntityRenderInfo: TvRenderInfo;
|
||
begin
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
|
||
for i := 0 to GetCellCount()-1 do
|
||
begin
|
||
CurCell := GetCell(i);
|
||
CurCell.X := CurX_mm;
|
||
CurCell.Y := Y;
|
||
//ADest.Line(CoordToCanvasX(CurX_mm), CoordToCanvasY(Y), CoordToCanvasX(CurX_mm+1), CoordToCanvasY(Y+1));
|
||
CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
CurCell.Render(lEntityRenderInfo, ADoDraw);
|
||
if (Table <> nil) then
|
||
begin
|
||
if (Length(Table.ColWidthsInMM) > i) then
|
||
CurX_mm := CurX_mm + Table.ColWidthsInMM[i];
|
||
end;
|
||
|
||
MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
end;
|
||
end;
|
||
|
||
function TvTableRow.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
i: Integer;
|
||
lCurCell: TvTableCell;
|
||
begin
|
||
FExtraDebugStr := Format(' Height=%f CellSpacing=%f SpacingDataValid=%s',
|
||
[Height, CellSpacing, BoolToStr(SpacingDataValid)]);
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
|
||
// Add cells
|
||
for i := 0 to GetCellCount()-1 do
|
||
begin
|
||
lCurCell := GetCell(i);
|
||
lCurCell.GenerateDebugTree(ADestRoutine, Result);
|
||
end;
|
||
end;
|
||
|
||
{ T2DEllipticalArcSegment }
|
||
|
||
// wp: no longer needed...
|
||
function T2DEllipticalArcSegment.AlignedEllipseCenterEquationT1(
|
||
AParam: Double): Double;
|
||
var
|
||
lLeftSide, lRightSide, lArg: Double;
|
||
begin
|
||
// E1.Y - RY*sin(t1) = E2.Y - RY*sin(arccos((- E1.X + RX*cos(t1) + E2.X)/RX))
|
||
lLeftSide := E1.Y - RY*sin(AParam);
|
||
lArg := (- E1.X + RX*cos(AParam) + E2.X)/RX;
|
||
if (lArg > 1) or (lArg < -1) then Exit($FFFFFFFF);
|
||
lRightSide := E2.Y - RY*sin(arccos(lArg));
|
||
Result := lLeftSide - lRightSide;
|
||
if Result < 0 then Result := -1* Result;
|
||
end;
|
||
|
||
procedure T2DEllipticalArcSegment.BezierApproximate(var Points: T3dPointsArray);
|
||
var
|
||
P1, P2, P3, P4: T3dPoint;
|
||
startangle, endangle: Double;
|
||
startanglePi2, endanglePi2: Double;
|
||
xstart, ystart: Double;
|
||
nextx, nexty: Double;
|
||
angle: Double;
|
||
n: Integer;
|
||
begin
|
||
SetLength(Points, 30);
|
||
n := 0;
|
||
|
||
xstart := T2DSegment(Previous).X;
|
||
ystart := T2DSegment(Previous).Y;
|
||
startangle := CalcEllipsePointAngle(xstart, ystart, RX, RY, CX, CY, XRotation);
|
||
endangle := CalcEllipsePointAngle(X, Y, RX, RY, CX, CY, XRotation);
|
||
if endangle < 0 then endangle := 2*pi + endangle;
|
||
|
||
angle := arctan2(-1,1);
|
||
angle := radtodeg(angle);
|
||
|
||
angle := radtodeg(startangle);
|
||
angle := radtodeg(endangle);
|
||
|
||
// Since the algorithm for bezier approximation requires that the angle
|
||
// between start and end is at most pi/3 we have to progress in pi/3 steps.
|
||
angle := startangle + pi/3;
|
||
while true do
|
||
begin
|
||
if angle >= endangle then begin
|
||
EllipticalArcToBezier(CX, CY, RX, RY, startAngle, endangle, Points[n], Points[n+1], Points[n+2], Points[n+3]);
|
||
inc(n, 4);
|
||
break;
|
||
end else
|
||
EllipticalArcToBezier(CX, CY, RX, RY, startangle, angle, Points[n], Points[n+1], Points[n+2], Points[n+3]);
|
||
inc(n, 4);
|
||
startangle := angle;
|
||
angle := angle + pi/2;
|
||
end;
|
||
SetLength(Points, n);
|
||
end;
|
||
|
||
procedure T2DEllipticalArcSegment.PolyApproximate(var Points: T3dPointsArray);
|
||
const
|
||
BUFSIZE = 100;
|
||
var
|
||
t, tstart, tend, dt: Double;
|
||
xstart, ystart: Double;
|
||
n: Integer;
|
||
done: Boolean;
|
||
clockwise: Boolean;
|
||
begin
|
||
n := 0;
|
||
SetLength(Points, BUFSIZE);
|
||
|
||
dt := DegToRad(1.0); // 1-degree increments
|
||
|
||
xstart := T2DSegment(Previous).X;
|
||
ystart := T2DSegment(Previous).Y;
|
||
tstart := CalcEllipsePointAngle(xstart, ystart, RX, RY, CX, CY, XRotation);
|
||
tend := CalcEllipsePointAngle(X, Y, RX, RY, CX, CY, XRotation);
|
||
|
||
// Flip clockwise flag in case of top/left coordinates
|
||
clockwise := ClockwiseArcFlag xor UseTopLeftCoordinates;
|
||
|
||
if clockwise then
|
||
begin
|
||
// clockwise --> angle decreases --> tstart must be > tend
|
||
dt := -dt;
|
||
if tstart < tend then tstart := TWO_PI + tstart;
|
||
end else
|
||
begin
|
||
// counter-clockwise --> angle increases --> tstart must be < tend
|
||
if tend < tstart then tend := TWO_PI + tend;
|
||
end;
|
||
|
||
done := false;
|
||
t := tstart;
|
||
while not done do begin
|
||
if (clockwise and (t < tend)) or // angle decreases
|
||
(not clockwise and (t > tend)) then // angle increases
|
||
begin
|
||
t := tend;
|
||
done := true;
|
||
end;
|
||
if n >= Length(Points) then
|
||
SetLength(Points, Length(Points) + BUFSIZE);
|
||
CalcEllipsePoint(t, RX, RY, CX, CY, XRotation, Points[n].x, Points[n].y);
|
||
inc(n);
|
||
t := t + dt; // Note: dt is < 0 in clockwise case
|
||
end;
|
||
SetLength(Points, n);
|
||
end;
|
||
|
||
procedure T2DEllipticalArcSegment.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
inherited Move(ADeltaX, ADeltaY);
|
||
|
||
E1.X := E1.X + ADeltaX;
|
||
E1.X := E1.Y + ADeltaY;
|
||
|
||
E2.X := E2.X + ADeltaX;
|
||
E2.X := E2.Y + ADeltaY;
|
||
|
||
CX := CX + ADeltaX;
|
||
CY := CY + ADeltaY;
|
||
end;
|
||
|
||
|
||
procedure T2DEllipticalArcSegment.Rotate(AAngle: Double; ABase: T3dPoint);
|
||
var
|
||
p: T3DPoint;
|
||
begin
|
||
inherited Rotate(AAngle, ABase);
|
||
|
||
XRotation := XRotation + AAngle;
|
||
|
||
p := fpvutils.Rotate3DPointInXY(E1, ABase, -AAngle);
|
||
E1.X := p.X;
|
||
E1.Y := p.Y;
|
||
|
||
p := fpvutils.Rotate3DPointInXY(E2, ABase, -AAngle);
|
||
E2.X := p.X;
|
||
E2.Y := p.Y;
|
||
|
||
p := fpvutils.Rotate3DPointInXY(Make2dPoint(CX, CY), ABase, -AAngle);
|
||
CX := p.X;
|
||
CY := p.Y;
|
||
end;
|
||
|
||
// wp: no longer needed...
|
||
procedure T2DEllipticalArcSegment.CalculateCenter;
|
||
var
|
||
XStart, YStart, lT1: Double;
|
||
CX1, CY1, CX2, CY2, LeftMostX, LeftMostY, RightMostX, RightMostY: Double;
|
||
RotatedCenter: T3DPoint;
|
||
begin
|
||
if CenterSetByUser then Exit;
|
||
|
||
// Rotated Ellipse equation:
|
||
// (xcosθ+ysinθ)^2 / RX^2 + (ycosθ−xsinθ)^2 / RY^2 = 1
|
||
//
|
||
// parametrized:
|
||
// x = Cx + RX*cos(t)*cos(phi) - RY*sin(t)*sin(phi) [1]
|
||
// y = Cy + RY*sin(t)*cos(phi) + RX*cos(t)*sin(phi) [2]
|
||
|
||
if Previous = nil then
|
||
begin
|
||
CX := X - RX*Cos(0)*Cos(XRotation) + RY*Sin(0)*Sin(XRotation);
|
||
CY := Y - RY*Sin(0)*Cos(XRotation) - RX*Cos(0)*Sin(XRotation);
|
||
Exit;
|
||
end;
|
||
|
||
XStart := T2DSegment(Previous).X;
|
||
YStart := T2DSegment(Previous).Y;
|
||
|
||
// Solve by rotating everything to align the ellipse to the axises and then rotating back again
|
||
E1 := Rotate3DPointInXY(Make3DPoint(XStart,YStart), Make3DPoint(0,0),-1*XRotation);
|
||
E2 := Rotate3DPointInXY(Make3DPoint(X,Y), Make3DPoint(0,0),-1*XRotation);
|
||
|
||
// parametrized:
|
||
// CX = E1.X - RX*cos(t1)
|
||
// CY = E1.Y - RY*sin(t1)
|
||
// CX = E2.X - RX*cos(t2)
|
||
// CY = E2.Y - RY*sin(t2)
|
||
//
|
||
// E1.X - RX*cos(t1) = E2.X - RX*cos(t2)
|
||
// E1.Y - RY*sin(t1) = E2.Y - RY*sin(t2)
|
||
//
|
||
// (- E1.X + RX*cos(t1) + E2.X)/RX = cos(t2)
|
||
// arccos((- E1.X + RX*cos(t1) + E2.X)/RX) = t2
|
||
//
|
||
// E1.Y - RY*sin(t1) = E2.Y - RY*sin(arccos((- E1.X + RX*cos(t1) + E2.X)/RX))
|
||
|
||
// SolveNumerically
|
||
|
||
lT1 := SolveNumericallyAngle(@AlignedEllipseCenterEquationT1, 0.0001, 20);
|
||
|
||
CX1 := E1.X - RX*cos(lt1);
|
||
CY1 := E1.Y - RY*sin(lt1);
|
||
|
||
// Rotate back!
|
||
RotatedCenter := Rotate3DPointInXY(Make3DPoint(CX1,CY1), Make3DPoint(0,0),XRotation);
|
||
CX1 := RotatedCenter.X;
|
||
CY1 := RotatedCenter.Y;
|
||
|
||
// The other ellipse is symmetrically positioned
|
||
if (CX1 > Xstart) then
|
||
CX2 := X - (CX1-Xstart)
|
||
else
|
||
CX2 := Xstart - (CX1-X);
|
||
//
|
||
if (CY1 > Y) then
|
||
CY2 := Ystart - (CY1-Y)
|
||
else
|
||
CY2 := Y - (CY1-Ystart);
|
||
|
||
// Achar qual é a da esquerda e qual a da direita
|
||
if CX1 < CX2 then
|
||
begin
|
||
LeftMostX := CX1;
|
||
LeftMostY := CY1;
|
||
RightMostX := CX2;
|
||
RightMostY := CY2;
|
||
end
|
||
else
|
||
begin
|
||
LeftMostX := CX2;
|
||
LeftMostY := CY2;
|
||
RightMostX := CX1;
|
||
RightMostY := CY1;
|
||
end;
|
||
|
||
if LeftmostEllipse then
|
||
begin
|
||
CX := LeftMostX;
|
||
CY := LeftMostY;
|
||
end
|
||
else
|
||
begin
|
||
CX := RightMostX;
|
||
CY := RightMostY;
|
||
end;
|
||
end;
|
||
|
||
procedure T2DEllipticalArcSegment.CalculateEllipseBoundingBox(out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
t1, t2, t3: Double;
|
||
x1, x2, x3: Double;
|
||
y1, y2, y3: Double;
|
||
begin
|
||
ALeft := 0;
|
||
ATop := 0;
|
||
ARight := 0;
|
||
ABottom := 0;
|
||
if Previous = nil then Exit;
|
||
|
||
// Alligned Ellipse equation:
|
||
// x^2 / RX^2 + Y^2 / RY^2 = 1
|
||
//
|
||
// Rotated Ellipse equation:
|
||
// (xcosθ+ysinθ)^2 / RX^2 + (ycosθ−xsinθ)^2 / RY^2 = 1
|
||
//
|
||
// parametrized:
|
||
// x = Cx + a*cos(t)*cos(phi) - b*sin(t)*sin(phi) [1]
|
||
// y = Cy + b*sin(t)*cos(phi) + a*cos(t)*sin(phi) [2]
|
||
// ...where ellipse has centre (h,k) semimajor axis a and semiminor axis b, and is rotated through angle phi.
|
||
//
|
||
// You can then differentiate and solve for gradient = 0:
|
||
// 0 = dx/dt = -a*sin(t)*cos(phi) - b*cos(t)*sin(phi)
|
||
// => tan(t) = -b*tan(phi)/a [3]
|
||
// => t = arctan(-b*tan(phi)/a) + n*Pi [4]
|
||
//
|
||
// And the same for Y
|
||
// 0 = dy/dt = b*cos(t)*cos(phi) - a*sin(t)*sin(phi)
|
||
// a*sin(t)/cos(t) = b*cos(phi)/sin(phi)
|
||
// => tan(t) = b*cotan(phi)/a
|
||
// => t = arctan(b*cotan(phi)/a) + n*Pi [5]
|
||
//
|
||
// calculate some values of t for n in -1, 0, 1 and see which are the smaller, bigger ones
|
||
// done!
|
||
|
||
CalculateCenter();
|
||
|
||
if XRotation = 0 then
|
||
begin
|
||
ALeft := CX-RX;
|
||
ARight := CX+RX;
|
||
ATop := CY+RY;
|
||
ABottom := CY-RY;
|
||
end
|
||
else
|
||
begin
|
||
// Search for the minimum and maximum X
|
||
// There are two solutions in each 2pi range
|
||
t1 := arctan(-RY*tan(XRotation)/RX);
|
||
t2 := arctan(-RY*tan(XRotation)/RX) + pi; //Pi/2; // why add pi/2 ??
|
||
// t3 := arctan(-RY*tan(XRotation)/RX) + Pi;
|
||
|
||
x1 := Cx + RX*Cos(t1)*Cos(XRotation)-RY*Sin(t1)*Sin(XRotation);
|
||
x2 := Cx + RX*Cos(t2)*Cos(XRotation)-RY*Sin(t2)*Sin(XRotation);
|
||
// x3 := Cx + RX*Cos(t3)*Cos(XRotation)-RY*Sin(t3)*Sin(XRotation);
|
||
|
||
ALeft := Min(x1, x2);
|
||
// ALeft := Min(ALeft, x3);
|
||
|
||
ARight := Max(x1, x2);
|
||
//ARight := Max(ARight, x3);
|
||
|
||
// Now the same for Y
|
||
|
||
t1 := arctan(RY*cotan(XRotation)/RX);
|
||
t2 := arctan(RY*cotan(XRotation)/RX) + pi; //Pi/2; // why add pi/2 ??
|
||
// t3 := arctan(RY*cotan(XRotation)/RX) + 3*Pi/2;
|
||
|
||
y1 := CY + RY*Sin(t1)*Cos(XRotation)+RX*Cos(t1)*Sin(XRotation);
|
||
y2 := CY + RY*Sin(t2)*Cos(XRotation)+RX*Cos(t2)*Sin(XRotation);
|
||
// y3 := CY + RY*Sin(t3)*Cos(XRotation)+RX*Cos(t3)*Sin(XRotation);
|
||
|
||
ATop := Max(y1, y2);
|
||
// ATop := Max(ATop, y3);
|
||
|
||
ABottom := Min(y1, y2);
|
||
// ABottom := Min(ABottom, y3);
|
||
{
|
||
ATop := Min(y1, y2);
|
||
ATop := Min(ATop, y3);
|
||
|
||
ABottom := Max(y1, y2);
|
||
ABottom := Max(ABottom, y3);
|
||
}
|
||
end;
|
||
end;
|
||
|
||
function T2DEllipticalArcSegment.GenerateDebugTree(
|
||
ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
lStrLeftmostEllipse, lStrClockwiseArcFlag: string;
|
||
begin
|
||
if LeftmostEllipse then lStrLeftmostEllipse := 'true'
|
||
else lStrLeftmostEllipse := 'false';
|
||
if ClockwiseArcFlag then lStrClockwiseArcFlag := 'true'
|
||
else lStrClockwiseArcFlag := 'false';
|
||
lStr := Format('[%s] X=%f Y=%f RX=%f RY=%f LeftmostEllipse=%s ClockwiseArcFlag=%s CX=%f CY=%f',
|
||
[Self.ClassName, X, Y, RX, RY, lStrLeftmostEllipse, lStrClockwiseArcFlag, CX, CY]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
procedure T2DEllipticalArcSegment.AddToPoints(ADestX, ADestY: Integer;
|
||
AMulX, AMulY: Double; var Points: TPointsArray);
|
||
var
|
||
pts3D: T3DPointsArray;
|
||
i, n: Integer;
|
||
begin
|
||
SetLength(pts3d, 0);
|
||
PolyApproximate(pts3D);
|
||
n := Length(Points);
|
||
SetLength(Points, n + Length(pts3D) - 1); // we don't need the start point --> -1
|
||
for i:=0 to High(pts3D)-1 do // i=0 is end point of prev segment -> we can skip it.
|
||
begin
|
||
Points[n].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
|
||
Points[n].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
|
||
inc(n);
|
||
end;
|
||
end;
|
||
|
||
{ TvVerticalFormulaStack }
|
||
|
||
function TvVerticalFormulaStack.CalculateHeight(ADest: TFPCustomCanvas): Double;
|
||
var
|
||
lElement: TvFormulaElement;
|
||
begin
|
||
Result := 0;
|
||
lElement := GetFirstElement();
|
||
while lElement <> nil do
|
||
begin
|
||
Result := Result + lElement.CalculateHeight(ADest) + SpacingBetweenElementsY;
|
||
lElement := GetNextElement;
|
||
end;
|
||
// Remove an extra spacing, since it is added even to the last item
|
||
Result := Result - SpacingBetweenElementsY;
|
||
// Cache the result
|
||
Height := Result;
|
||
end;
|
||
|
||
function TvVerticalFormulaStack.CalculateWidth(ADest: TFPCustomCanvas): Double;
|
||
var
|
||
lElement: TvFormulaElement;
|
||
begin
|
||
Result := 0;
|
||
|
||
lElement := GetFirstElement();
|
||
while lElement <> nil do
|
||
begin
|
||
Result := Max(Result, lElement.CalculateWidth(ADest));
|
||
lElement := GetNextElement;
|
||
end;
|
||
|
||
// Cache the result
|
||
Width := Result;
|
||
end;
|
||
|
||
procedure TvVerticalFormulaStack.PositionSubparts(constref ARenderInfo: TvRenderInfo;
|
||
ABaseX, ABaseY: Double);
|
||
var
|
||
lElement: TvFormulaElement;
|
||
lPosX: Double = 0;
|
||
lPosY: Double = 0;
|
||
begin
|
||
CalculateHeight(ARenderInfo.Canvas);
|
||
CalculateWidth(ARenderInfo.Canvas);
|
||
Left := ABaseX;
|
||
Top := ABaseY;
|
||
|
||
// Then calculate the position of each element
|
||
lElement := GetFirstElement();
|
||
while lElement <> nil do
|
||
begin
|
||
lElement.Left := Left;
|
||
lElement.Top := Top - lPosY;
|
||
lPosY := lPosY + lElement.Height + SpacingBetweenElementsY;
|
||
|
||
lElement.PositionSubparts(ARenderInfo, ABaseX, ABaseY);
|
||
|
||
lElement := GetNextElement();
|
||
end;
|
||
end;
|
||
|
||
{ TPathSegment }
|
||
|
||
function TPathSegment.GetLength: Double;
|
||
begin
|
||
Result := 0;
|
||
end;
|
||
|
||
function TPathSegment.GetPointAndTangentForDistance(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
|
||
begin
|
||
Result := False;
|
||
AX := 0;
|
||
AY := 0;
|
||
ATangentAngle := 0;
|
||
end;
|
||
|
||
function TPathSegment.GetStartPoint(out APoint: T3DPoint): Boolean;
|
||
begin
|
||
Result := False;
|
||
if Previous = nil then Exit;
|
||
if (Previous is T3DSegment) then
|
||
begin
|
||
Result := True;
|
||
APoint.X := T3DSegment(Previous).X;
|
||
APoint.Y := T3DSegment(Previous).Y;
|
||
APoint.Z := T3DSegment(Previous).Z;
|
||
Exit;
|
||
end;
|
||
if (Previous is T2DSegment) then
|
||
begin
|
||
Result := True;
|
||
APoint.X := T2DSegment(Previous).X;
|
||
APoint.Y := T2DSegment(Previous).Y;
|
||
APoint.Z := 0;
|
||
Exit;
|
||
end;
|
||
end;
|
||
|
||
procedure TPathSegment.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TPathSegment.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
begin
|
||
|
||
end;
|
||
|
||
function TPathSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr, lTypeStr: string;
|
||
begin
|
||
lTypeStr := GetEnumName(TypeInfo(TSegmentType), integer(SegmentType));
|
||
lStr := Format('[%s] Type=%s', [Self.ClassName, lTypeStr]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
procedure TPathSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
|
||
var Points: TPointsArray);
|
||
begin
|
||
// Override by descendants
|
||
end;
|
||
|
||
function TPathSegment.UseTopLeftCoordinates: Boolean;
|
||
begin
|
||
Result := (FPath <> nil) and FPath.FPage.UseTopLeftCoordinates;
|
||
end;
|
||
|
||
|
||
{ T2DSegment }
|
||
|
||
function T2DSegment.GetLength: Double;
|
||
var
|
||
lStartPoint: T3DPoint;
|
||
begin
|
||
Result := 0;
|
||
if not GetStartPoint(lStartPoint) then Exit;
|
||
Result := sqrt(sqr(X - lStartPoint.X) + sqr(Y + lStartPoint.Y));
|
||
end;
|
||
|
||
function T2DSegment.GetPointAndTangentForDistance(ADistance: Double; out AX,
|
||
AY, ATangentAngle: Double): Boolean;
|
||
var
|
||
lStartPoint: T3DPoint;
|
||
begin
|
||
Result:=inherited GetPointAndTangentForDistance(ADistance, AX, AY, ATangentAngle);
|
||
if not GetStartPoint(lStartPoint) then Exit;
|
||
Result := LineEquation_GetPointAndTangentForLength(lStartPoint, Make3DPoint(X, Y), ADistance, AX, AY, ATangentAngle);
|
||
end;
|
||
|
||
procedure T2DSegment.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
X := X + ADeltaX;
|
||
Y := Y + ADeltaY;
|
||
end;
|
||
|
||
procedure T2DSegment.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
lRes: T3DPoint;
|
||
begin
|
||
inherited Rotate(AAngle, ABase);
|
||
lRes := fpvutils.Rotate3DPointInXY(Make3DPoint(X, Y), ABase, -AAngle);
|
||
X := lRes.X;
|
||
Y := lRes.Y;
|
||
end;
|
||
|
||
function T2DSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr, lTypeStr: string;
|
||
begin
|
||
lTypeStr := GetEnumName(TypeInfo(TSegmentType), integer(SegmentType));
|
||
lStr := Format('[%s] Type=%s X=%f Y=%f', [Self.ClassName, lTypeStr, X, Y]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
procedure T2DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
|
||
var Points: TPointsArray);
|
||
var
|
||
n: Integer;
|
||
begin
|
||
n := Length(Points);
|
||
SetLength(Points, n + 1);
|
||
Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
|
||
Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
|
||
end;
|
||
|
||
{ T2DBezierSegment }
|
||
|
||
function T2DBezierSegment.GetLength: Double;
|
||
var
|
||
lStartPoint: T3DPoint;
|
||
begin
|
||
Result := 0;
|
||
if not GetStartPoint(lStartPoint) then Exit;
|
||
Result := BezierEquation_GetLength(lStartPoint, Make3DPoint(X2, Y2),
|
||
Make3DPoint(X3, Y3), Make3DPoint(X, Y), 0);
|
||
end;
|
||
|
||
function T2DBezierSegment.GetPointAndTangentForDistance(ADistance: Double; out
|
||
AX, AY, ATangentAngle: Double): Boolean;
|
||
var
|
||
lStartPoint: T3DPoint;
|
||
begin
|
||
Result:=inherited GetPointAndTangentForDistance(ADistance, AX, AY,
|
||
ATangentAngle);
|
||
if not GetStartPoint(lStartPoint) then Exit;
|
||
Result := BezierEquation_GetPointAndTangentForLength(lStartPoint, Make3DPoint(X2, Y2),
|
||
Make3DPoint(X3, Y3), Make3DPoint(X, Y), ADistance, AX, AY, ATangentAngle);
|
||
end;
|
||
|
||
procedure T2DBezierSegment.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
inherited Move(ADeltaX, ADeltaY);
|
||
X2 := X2 + ADeltaX;
|
||
Y2 := Y2 + ADeltaY;
|
||
X3 := X3 + ADeltaX;
|
||
Y3 := Y3 + ADeltaY;
|
||
end;
|
||
|
||
procedure T2DBezierSegment.Rotate(AAngle: Double; ABase: T3dPoint);
|
||
var
|
||
p: T3DPoint;
|
||
begin
|
||
inherited Rotate(AAngle, ABase);
|
||
|
||
p := fpvutils.Rotate3DPointInXY(Make3DPoint(X2, Y2), ABase, -AAngle);
|
||
X2 := p.X;
|
||
Y2 := p.Y;
|
||
|
||
p := fpvutils.Rotate3DPointInXY(Make3DPoint(X3, Y3), ABase, -AAngle);
|
||
X3 := p.X;
|
||
Y3 := p.Y;
|
||
end;
|
||
|
||
function T2DBezierSegment.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
lStr := Format('[%s] X=%f Y=%f CX2=%f CY2=%f CX3=%f CY3=%f', [Self.ClassName, X, Y, X2, Y2, X3, Y3]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
procedure T2DBezierSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
|
||
var Points: TPointsArray);
|
||
var
|
||
pts: TPointsArray;
|
||
coordX, coordY, coord2X, coord2Y, coord3X, coord3Y, coord4X, coord4Y: Integer;
|
||
i, n: Integer;
|
||
prev: TPoint;
|
||
begin
|
||
if not (Previous is T2DSegment) then
|
||
raise Exception.Create('T2DBezierSegment must follow a T2DSegment.');
|
||
|
||
coordX := CoordToCanvasX(T2DSegment(Previous).X, ADestX, AMulX); // start pt
|
||
coordY := CoordToCanvasY(T2DSegment(Previous).Y, ADestY, AMulY);
|
||
coord4X := CoordToCanvasX(X, ADestX, AMulX); // end pt
|
||
coord4Y := CoordToCanvasY(Y, ADestY, AMulY);
|
||
coord2X := CoordToCanvasX(X2, ADestX, AMulX); // ctrl pt 1
|
||
coord2Y := CoordToCanvasY(Y2, ADestY, AMulY);
|
||
coord3X := CoordToCanvasX(X3, ADestX, AMulX); // ctrl pt 2
|
||
coord3Y := CoordToCanvasY(Y3, ADestY, AMulY);
|
||
|
||
SetLength(pts, 0);
|
||
AddBezierToPoints(
|
||
Make3DPoint(coordX, coordY),
|
||
Make3DPoint(coord2X, coord2Y),
|
||
Make3DPoint(coord3X, coord3Y),
|
||
Make3DPoint(coord4X, coord4Y),
|
||
pts);
|
||
|
||
if Length(pts) = 0 then
|
||
exit;
|
||
|
||
n := Length(Points);
|
||
prev := Points[n-1];
|
||
SetLength(Points, n + Length(pts));
|
||
for i:=0 to High(pts) do
|
||
begin
|
||
if (pts[i].X = prev.X) and (pts[i].Y = prev.Y) then // skip subsequent coincident points
|
||
Continue;
|
||
Points[n] := pts[i];
|
||
prev := pts[i];
|
||
inc(n);
|
||
end;
|
||
SetLength(Points, n);
|
||
end;
|
||
|
||
{ T3DSegment }
|
||
|
||
procedure T3DSegment.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
X := X + ADeltaX;
|
||
Y := Y + ADeltaY;
|
||
end;
|
||
|
||
{ This is preliminary... }
|
||
procedure T3DSegment.AddToPoints(ADestX, ADestY: Integer; AMulX, AMulY: Double;
|
||
var Points: TPointsArray);
|
||
var
|
||
n: Integer;
|
||
begin
|
||
n := Length(Points);
|
||
SetLength(Points, n + 1);
|
||
Points[n].X := CoordToCanvasX(Points[n].X, ADestX, AMulX);
|
||
Points[n].Y := CoordToCanvasY(Points[n].Y, ADestY, AMulY);
|
||
end;
|
||
|
||
{ T3DBezierSegment }
|
||
|
||
procedure T3DBezierSegment.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
inherited Move(ADeltaX, ADeltaY);
|
||
X2 := X2 + ADeltaX;
|
||
Y2 := Y2 + ADeltaY;
|
||
X3 := X3 + ADeltaX;
|
||
Y3 := Y3 + ADeltaY;
|
||
end;
|
||
|
||
{ TvEntity }
|
||
|
||
constructor TvEntity.Create(APage: TvPage);
|
||
begin
|
||
end;
|
||
|
||
procedure TvEntity.Clear;
|
||
begin
|
||
X := 0.0;
|
||
Y := 0.0;
|
||
Z := 0.0;
|
||
end;
|
||
|
||
procedure TvEntity.SetPage(APage: TvPage);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvEntity.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
begin
|
||
ALeft := X;
|
||
ATop := Y;
|
||
ARight := X; //+1;
|
||
ABottom := Y; //+1;
|
||
end;
|
||
|
||
// returns false if the element is invisible
|
||
function TvEntity.CalculateSizeInCanvas(constref ARenderInfo: TvRenderInfo;
|
||
APageHeight: Integer; AZoom: Double;
|
||
out ALeft, ATop, AWidth, AHeight: Integer): Boolean;
|
||
var
|
||
lRenderInfo: TvRenderInfo;
|
||
lMulY: Double;
|
||
begin
|
||
Result := True;
|
||
CopyAndInitDocumentRenderInfo(lRenderInfo, ARenderInfo);
|
||
ARenderInfo.Page.GetNaturalRenderPos(APageHeight, lMulY);
|
||
AZoom := Abs(AZoom);
|
||
lRenderInfo.DestX := 0;
|
||
lRenderInfo.DestY := APageHeight;
|
||
lRenderInfo.MulX := AZoom;
|
||
lRenderInfo.MulY := AZoom * lMulY;
|
||
Render(lRenderInfo, False);
|
||
ALeft := lRenderInfo.EntityCanvasMinXY.X;
|
||
ATop := lRenderInfo.EntityCanvasMinXY.Y;
|
||
AWidth := lRenderInfo.EntityCanvasMaxXY.X - lRenderInfo.EntityCanvasMinXY.X;
|
||
AHeight := lRenderInfo.EntityCanvasMaxXY.Y - lRenderInfo.EntityCanvasMinXY.Y;
|
||
if (lRenderInfo.EntityCanvasMinXY.X = INVALID_RENDERINFO_CANVAS_XY) or
|
||
(lRenderInfo.EntityCanvasMinXY.Y = INVALID_RENDERINFO_CANVAS_XY) or
|
||
(lRenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY) or
|
||
(lRenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY) then
|
||
Result := False;
|
||
end;
|
||
|
||
procedure TvEntity.CalculateHeightInCanvas(constref ARenderInfo: TvRenderInfo; out AHeight: Integer);
|
||
var
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
lRenderInfo: TvRenderInfo;
|
||
begin
|
||
lRenderInfo.Canvas := ARenderInfo.Canvas;
|
||
lRenderInfo.DestX := 0;
|
||
lRenderInfo.DestY := 0;
|
||
lRenderInfo.MulX := AMulX;
|
||
lRenderInfo.MulY := AMulY;
|
||
Render(lRenderInfo, False);
|
||
AHeight := lRenderInfo.EntityCanvasMaxXY.Y - lRenderInfo.EntityCanvasMinXY.Y;
|
||
end;
|
||
|
||
procedure TvEntity.ExpandBoundingBox(constref ARenderInfo: TvRenderInfo; var ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
begin
|
||
CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
|
||
if lLeft < ALeft then
|
||
ALeft := lLeft;
|
||
if lRight > ARight then
|
||
ARight := lRight;
|
||
if ARenderInfo.Page.UseTopLeftCoordinates then
|
||
begin
|
||
if lTop < ATop then ATop := lTop;
|
||
if lBottom > ABottom then ABottom := lBottom;
|
||
end else
|
||
begin
|
||
if lTop > ATop then ATop := lTop;
|
||
if lBottom < ABottom then ABottom := lBottom;
|
||
end;
|
||
end;
|
||
|
||
class procedure TvEntity.CalcEntityCanvasMinMaxXY(
|
||
var ARenderInfo: TvRenderInfo; APointX, APointY: Integer);
|
||
begin
|
||
if ARenderInfo.EntityCanvasMinXY.X = INVALID_RENDERINFO_CANVAS_XY then
|
||
ARenderInfo.EntityCanvasMinXY.X := APointX
|
||
else
|
||
ARenderInfo.EntityCanvasMinXY.X := Min(ARenderInfo.EntityCanvasMinXY.X, APointX);
|
||
|
||
if ARenderInfo.EntityCanvasMinXY.Y = INVALID_RENDERINFO_CANVAS_XY then
|
||
ARenderInfo.EntityCanvasMinXY.Y := APointY
|
||
else
|
||
ARenderInfo.EntityCanvasMinXY.Y := Min(ARenderInfo.EntityCanvasMinXY.Y, APointY);
|
||
|
||
if ARenderInfo.EntityCanvasMaxXY.X = INVALID_RENDERINFO_CANVAS_XY then
|
||
ARenderInfo.EntityCanvasMaxXY.X := APointX
|
||
else
|
||
ARenderInfo.EntityCanvasMaxXY.X := Max(ARenderInfo.EntityCanvasMaxXY.X, APointX);
|
||
|
||
if ARenderInfo.EntityCanvasMaxXY.Y = INVALID_RENDERINFO_CANVAS_XY then
|
||
ARenderInfo.EntityCanvasMaxXY.Y := APointY
|
||
else
|
||
ARenderInfo.EntityCanvasMaxXY.Y := Max(ARenderInfo.EntityCanvasMaxXY.Y, APointY);
|
||
end;
|
||
|
||
class procedure TvEntity.CalcEntityCanvasMinMaxXY_With2Points(
|
||
var ARenderInfo: TvRenderInfo; AX1, AY1, AX2, AY2: Integer);
|
||
begin
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, AX1, AY1);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, AX2, AY2);
|
||
end;
|
||
|
||
procedure TvEntity.MergeRenderInfo(var AFrom, ATo: TvRenderInfo);
|
||
begin
|
||
CalcEntityCanvasMinMaxXY(ATo, AFrom.EntityCanvasMinXY.X, AFrom.EntityCanvasMinXY.Y);
|
||
CalcEntityCanvasMinMaxXY(ATo, AFrom.EntityCanvasMaxXY.X, AFrom.EntityCanvasMaxXY.Y);
|
||
end;
|
||
|
||
class procedure TvEntity.InitializeRenderInfo(var ARenderInfo: TvRenderInfo; ASelf: TvEntity; ACreateObjs: Boolean);
|
||
begin
|
||
// Don't change these because otherwise we lose the value set by the page
|
||
// See CopyAndInitDocumentRenderInfo
|
||
// ARenderInfo.BackgroundColor := colBlack;
|
||
// ARenderInfo.AdjustPenColorToBackground := True;
|
||
// ARenderInfo.Selected := nil;
|
||
// ATo.Parent := AFrom.Self;
|
||
|
||
ARenderInfo.EntityCanvasMinXY := Point(INVALID_RENDERINFO_CANVAS_XY, INVALID_RENDERINFO_CANVAS_XY);
|
||
ARenderInfo.EntityCanvasMaxXY := Point(INVALID_RENDERINFO_CANVAS_XY, INVALID_RENDERINFO_CANVAS_XY);
|
||
ARenderInfo.ForceRenderBlock := False;
|
||
|
||
ARenderInfo.SelfEntity := ASelf;
|
||
if ACreateObjs then
|
||
SetLength(ARenderInfo.Errors, 0);
|
||
//ARenderInfo.Errors := TStringList.Create;
|
||
// Avoid memory leak when RenderInfo is copied
|
||
end;
|
||
|
||
class procedure TvEntity.FinalizeRenderInfo(var ARenderInfo: TvRenderInfo);
|
||
begin
|
||
Finalize(ARenderInfo.Errors);
|
||
{
|
||
if ARenderInfo.Errors <> nil then
|
||
ARenderInfo.Errors.Free;
|
||
ARenderInfo.Errors := nil;
|
||
}
|
||
end;
|
||
|
||
class procedure TvEntity.CopyAndInitDocumentRenderInfo(out ATo: TvRenderInfo;
|
||
AFrom: TvRenderInfo; ACopyMinMax: Boolean = False; AAsChild: Boolean = True);
|
||
begin
|
||
InitializeRenderInfo(ATo, nil);
|
||
ATo.DestX := AFrom.DestX;
|
||
ATo.DestY := AFrom.DestY;
|
||
ATo.MulX := AFrom.MulX;
|
||
ATo.MulY := AFrom.MulY;
|
||
ATo.Page := AFrom.Page;
|
||
ATo.Canvas := AFrom.Canvas;
|
||
ATo.Renderer := AFrom.Renderer;
|
||
ATo.AdjustPenColorToBackground := AFrom.AdjustPenColorToBackground;
|
||
ATo.BackgroundColor := AFrom.BackgroundColor;
|
||
ATo.Selected := AFrom.Selected;
|
||
if AAsChild then
|
||
begin
|
||
ATo.Parent := AFrom.SelfEntity;
|
||
end
|
||
else
|
||
begin
|
||
ATo.SelfEntity := AFrom.SelfEntity;
|
||
ATo.Parent := AFrom.Parent;
|
||
end;
|
||
ATo.Errors := AFrom.Errors;
|
||
if ACopyMinMax then
|
||
begin
|
||
ATo.EntityCanvasMinXY := AFrom.EntityCanvasMinXY;
|
||
ATo.EntityCanvasMaxXY := AFrom.EntityCanvasMaxXY;
|
||
end;
|
||
end;
|
||
|
||
function TvEntity.RenderInfo_GenerateParentTree(constref ARenderInfo: TvRenderInfo): string;
|
||
var
|
||
lCurEntity: TvEntity;
|
||
begin
|
||
lCurEntity := Self;
|
||
Result := '';
|
||
while lCurEntity <> nil do
|
||
begin
|
||
if Result <> '' then
|
||
Result := '->' + Result;
|
||
Result := lCurEntity.ClassName + Result;
|
||
if lCurEntity is TvNamedEntity then
|
||
Result := TvNamedEntity(lCurEntity).Name + ':' + Result;
|
||
lCurEntity := ARenderInfo.Parent;
|
||
end;
|
||
end;
|
||
|
||
function TvEntity.CentralizeY_InHeight(constref ARenderInfo: TvRenderInfo; AHeight: Double): Double;
|
||
var
|
||
lHeight: Double;
|
||
begin
|
||
lHeight := GetHeight(ARenderInfo);
|
||
Result := Y + Abs(AHeight - lHeight) / 2;
|
||
end;
|
||
|
||
function TvEntity.GetHeight(constref ARenderInfo: TvRenderInfo): Double;
|
||
var
|
||
ALeft, ATop, ARight, ABottom: Double;
|
||
begin
|
||
CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
|
||
Result := Abs(ATop - ABottom);
|
||
end;
|
||
|
||
function TvEntity.GetWidth(constref ARenderInfo: TvRenderInfo): Double;
|
||
var
|
||
ALeft, ATop, ARight, ABottom: Double;
|
||
begin
|
||
CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
|
||
Result := Abs(ALeft - ARight);
|
||
end;
|
||
|
||
function TvEntity.GetLineIntersectionPoints(ACoord: Double;
|
||
ACoordIsX: Boolean): TDoubleDynArray;
|
||
begin
|
||
SetLength(Result, 0);
|
||
end;
|
||
|
||
function TvEntity.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
|
||
begin
|
||
Result := vfrNotFound;
|
||
end;
|
||
|
||
procedure TvEntity.Move(ADeltaX, ADeltaY: Double);
|
||
begin
|
||
X := X + ADeltaX;
|
||
Y := Y + ADeltaY;
|
||
end;
|
||
|
||
procedure TvEntity.MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal);
|
||
begin
|
||
|
||
end;
|
||
|
||
function TvEntity.GetSubpartCount: Integer;
|
||
begin
|
||
Result := 0;
|
||
end;
|
||
|
||
procedure TvEntity.PositionSubparts(constref ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvEntity.Scale(ADeltaScaleX, ADeltaScaleY: Double);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvEntity.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvEntity.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
begin
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
end;
|
||
|
||
function TvEntity.AdjustColorToBackground(AColor: TFPColor; ARenderInfo: TvRenderInfo): TFPColor;
|
||
begin
|
||
Result := AColor;
|
||
if not ARenderInfo.AdjustPenColorToBackground then Exit;
|
||
// Adjust only if the contranst is really low
|
||
if (Abs(AColor.Red - ARenderInfo.BackgroundColor.Red) <= $100) and
|
||
(Abs(AColor.Green - ARenderInfo.BackgroundColor.Green) <= $100) and
|
||
(Abs(AColor.Blue - ARenderInfo.BackgroundColor.Blue) <= $100) then
|
||
begin
|
||
if (ARenderInfo.BackgroundColor.Red <= $1000) and
|
||
(ARenderInfo.BackgroundColor.Green <= $1000) and
|
||
(ARenderInfo.BackgroundColor.Blue <= $1000) then
|
||
Result := colWhite
|
||
else Result := colBlack;
|
||
end;
|
||
end;
|
||
|
||
function TvEntity.GetNormalizedPos(APage: TvVectorialPage; ANewMin,
|
||
ANewMax: Double): T3DPoint;
|
||
begin
|
||
Result.X := (X - APage.MinX) * (ANewMax - ANewMin) / (APage.MaxX - APage.MinX) + ANewMin;
|
||
Result.Y := (Y - APage.MinY) * (ANewMax - ANewMin) / (APage.MaxY - APage.MinY) + ANewMin;
|
||
Result.Z := (Z - APage.MinZ) * (ANewMax - ANewMin) / (APage.MaxZ - APage.MinZ) + ANewMin;
|
||
end;
|
||
|
||
function TvEntity.GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures;
|
||
begin
|
||
Result.DrawsUpwards := False;
|
||
Result.DrawsUpwardHeightAdjustment := 0;
|
||
Result.FirstLineHeight := 0;
|
||
Result.TotalHeight := 0;
|
||
end;
|
||
|
||
function TvEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
lStr := Format('[%s] X=%f Y=%f', [Self.ClassName, X, Y]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
class function TvEntity.GenerateDebugStrForFPColor(AColor: TFPColor): string;
|
||
begin
|
||
Result := IntToHex(AColor.Red div $100, 2) + IntToHex(AColor.Green div $100, 2) + IntToHex(AColor.Blue div $100, 2) + IntToHex(AColor.Alpha div $100, 2);
|
||
end;
|
||
|
||
// modified c-style string quoting
|
||
class function TvEntity.GenerateDebugStrForString(AValue: string): string;
|
||
begin
|
||
Result := AValue;
|
||
Result := StringReplace(Result, '\', '\\', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$7, '\a', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$8, '\b', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$C, '\f', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$A, '\n', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$D, '\r', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$9, '\t', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #$B, '\v', [rfReplaceAll]);
|
||
end;
|
||
|
||
{ TvNamedEntity }
|
||
|
||
constructor TvNamedEntity.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
FPage := APage;
|
||
end;
|
||
|
||
procedure TvNamedEntity.SetPage(APage: TvPage);
|
||
begin
|
||
FPage := APage;
|
||
end;
|
||
|
||
function TvNamedEntity.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr, [Self.ClassName, Name, X, Y]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
{ TvEntityWithPen }
|
||
|
||
constructor TvEntityWithPen.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
Pen.Style := psSolid;
|
||
Pen.Color := colBlack;
|
||
Pen.Width := 1;
|
||
end;
|
||
|
||
procedure TvEntityWithPen.ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo);
|
||
begin
|
||
ApplyPenToCanvas(ARenderInfo, Pen);
|
||
end;
|
||
|
||
procedure TvEntityWithPen.ApplyPenToCanvas(constref ARenderInfo: TvRenderInfo; APen: TvPen);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
begin
|
||
if ADest = nil then
|
||
exit;
|
||
ADest.Pen.FPColor := AdjustColorToBackground(APen.Color, ARenderInfo);
|
||
ADest.Pen.Width := Max(1, FPVSizeToCanvas(APen.Width, Max(AMulX, abs(AMulY))));
|
||
ADest.Pen.Style := APen.Style;
|
||
{$ifdef USE_LCL_CANVAS}
|
||
if (APen.Style = psPattern) then
|
||
begin
|
||
TCanvas(ADest).Pen.SetPattern(APen.Pattern);
|
||
if APen.Width = 1 then TCanvas(ADest).Pen.Cosmetic := false;
|
||
end;
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvEntityWithPen.AssignPen(APen: TvPen);
|
||
begin
|
||
Pen.Style := APen.Style;
|
||
Pen.Color := APen.Color;
|
||
Pen.Width := APen.Width;
|
||
end;
|
||
|
||
function TvEntityWithPen.CreatePath: TPath;
|
||
begin
|
||
Result := nil;
|
||
end;
|
||
|
||
procedure TvEntityWithPen.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
ApplyPenToCanvas(ARenderInfo);
|
||
end;
|
||
|
||
{ TvEntityWithPenAndBrush }
|
||
|
||
constructor TvEntityWithPenAndBrush.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
Brush.Style := bsClear;
|
||
Brush.Color := colBlue;
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo);
|
||
begin
|
||
ApplyBrushToCanvas(ARenderInfo, @Brush);
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.ApplyBrushToCanvas(constref ARenderInfo: TvRenderInfo;
|
||
ABrush: PvBrush);
|
||
begin
|
||
if ARenderInfo.Canvas = nil then
|
||
exit;
|
||
ARenderInfo.Canvas.Brush.FPColor := ABrush^.Color;
|
||
ARenderInfo.Canvas.Brush.Style := ABrush^.Style;
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.AssignBrush(ABrush: PvBrush);
|
||
begin
|
||
Brush := ABrush^;
|
||
end;
|
||
|
||
{ Calculates the canvas coordinates of the gradient vector (i.e. x,y of start
|
||
and end of gradient.
|
||
ARect is the bounding box of the shape in which the gradient will be painted.
|
||
It must be in canvas coordinates (pixels).
|
||
Note that the gradient vector need not be along the edges of this rectangle. }
|
||
procedure TvEntityWithPenAndBrush.CalcGradientVector(
|
||
out AGradientStart, AGradientEnd: T2dPoint; const ARect: TRect;
|
||
ADestX: Integer = 0; ADestY: Integer = 0; AMulX: Double = 1.0; AMulY: Double = 1.0);
|
||
begin
|
||
AGradientStart := Point2D(Brush.Gradient_start.X, Brush.Gradient_start.Y);
|
||
AGradientEnd := Point2D(Brush.Gradient_end.X, Brush.Gradient_end.Y);
|
||
if (gfRelToUserSpace in Brush.Gradient_flags) then
|
||
begin
|
||
if (gfRelStartX in Brush.Gradient_flags) then
|
||
AGradientStart.X := AGradientStart.X * FPage.Width;
|
||
if (gfRelStartY in Brush.Gradient_flags) then
|
||
AGradientStart.Y := AGradientStart.Y * FPage.Height;
|
||
if (gfRelEndX in Brush.Gradient_flags) then
|
||
AGradientEnd.X := AGradientEnd.X * FPage.Width;
|
||
if (gfRelEndY in Brush.Gradient_flags) then
|
||
AGradientEnd.Y := AGradientEnd.Y * FPage.Height;
|
||
AGradientStart.X := CoordToCanvasX(AGradientStart.X, ADestX, AMulX);
|
||
AGradientStart.Y := CoordToCanvasY(AGradientStart.Y, ADestY, AMulY);
|
||
AGradientEnd.X := CoordToCanvasX(AGradientEnd.X, ADestX, AMulX);
|
||
AGradientEnd.Y := CoordToCanvasY(AGradientEnd.Y, ADestY, AMulY);
|
||
end else
|
||
begin
|
||
if (gfRelStartX in Brush.Gradient_flags) then
|
||
AGradientStart.X := ARect.Left + AGradientStart.X * (ARect.Right - ARect.Left)
|
||
else
|
||
AGradientStart.X := CoordToCanvasX(AGradientStart.X, ADestX, AMulX);
|
||
if (gfRelStartY in Brush.Gradient_flags) then
|
||
AGradientStart.Y := ARect.Top + AGradientStart.Y * (ARect.Bottom - ARect.Left)
|
||
else
|
||
AGradientStart.Y := CoordToCanvasY(AGradientStart.Y, ADestY, AMulY);
|
||
if (gfRelEndX in Brush.Gradient_flags) then
|
||
AGradientEnd.X := ARect.Left + AGradientEnd.X * (ARect.Right - ARect.Left) else
|
||
AGradientEnd.X := CoordToCanvasX(AGradientEnd.X, ADestX, AMulX);
|
||
if (gfRelEndY in Brush.Gradient_flags) then
|
||
AGradientEnd.Y := ARect.Top + AGradientEnd.Y * (ARect.Bottom - ARect.Top) else
|
||
AGradientEnd.Y := CoordToCanvasY(AGradientEnd.Y, ADestY, AMulY);
|
||
end;
|
||
end;
|
||
|
||
{ Fills a polygon with the color of the current brush. The routine can handle
|
||
non-contiguous polygons (holes!) correctly using the ScanLine algorithm and
|
||
the even-odd rule
|
||
http://www.tutorialspoint.com/computer_graphics/polygon_filling_algorithm.htm
|
||
|
||
The array APoints must be in canvas units.
|
||
|
||
NOTES:
|
||
- The method only performs a solid fill, i.e. Brush.Style is ignored
|
||
- The method modifies the current pen. }
|
||
procedure TvEntityWithPenAndBrush.DrawPolygon(var ARenderInfo: TvRenderInfo; const APoints: TPointsArray;
|
||
const APolyStarts: TIntegerDynArray; ARect: TRect);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
scanlineY, scanLineY1, scanLineY2: Integer;
|
||
lPoints, pts: T2DPointsArray;
|
||
j: Integer;
|
||
begin
|
||
if ARect.Top < ARect.Bottom then
|
||
begin
|
||
scanLineY1 := ARect.Top;
|
||
scanLineY2 := ARect.Bottom;
|
||
end else
|
||
begin
|
||
scanLineY1 := ARect.Bottom;
|
||
scanLineY2 := ARect.Top;
|
||
end;
|
||
|
||
// Prepare points as needed by the GetLinePolygonIntersectionPoints procedure
|
||
SetLength(pts, Length(APoints));
|
||
for j := 0 to High(APoints) do
|
||
pts[j] := Point2D(APoints[j].X, APoints[j].Y);
|
||
|
||
// Prepare parameters and polygon points
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Pen.Width := 1;
|
||
ADest.Pen.FPColor := Brush.Color;
|
||
|
||
// Fill polygon by drawing horizontal line segments
|
||
scanlineY := scanlineY1;
|
||
while (scanlineY <= scanlineY2) do begin
|
||
// Find intersection points of horizontal scan line with polygon
|
||
// with polygon
|
||
lPoints := GetLinePolygonIntersectionPoints(scanlineY, pts, APolyStarts, false);
|
||
if Length(lPoints) < 2 then begin
|
||
inc(scanlineY);
|
||
Continue;
|
||
end;
|
||
// Draw lines between intersection points, skip every second pair
|
||
j := 0;
|
||
while j < High(lPoints) do
|
||
begin
|
||
ADest.Line(round(lPoints[j].X), round(lPoints[j].Y), round(lPoints[j+1].X), round(lPoints[j+1].Y));
|
||
inc(j, 2);
|
||
end;
|
||
// Proceed to next scan line
|
||
inc(scanlineY);
|
||
end;
|
||
end;
|
||
|
||
{ Paints the border around the shape. Ignores the brush.
|
||
APoints must be in canvas units. }
|
||
procedure TvEntityWithPenAndBrush.DrawPolygonBorderOnly(
|
||
var ARenderInfo: TvRenderInfo; const APoints: TPointsArray);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
j: Integer;
|
||
begin
|
||
if Pen.Style <> psClear then
|
||
begin
|
||
ApplyPenToCanvas(ARenderInfo);
|
||
ADest.MoveTo(APoints[0].X, APoints[0].Y);
|
||
for j:=1 to High(APoints) do
|
||
ADest.LineTo(APoints[j].X, APoints[j].Y);
|
||
end;
|
||
end;
|
||
|
||
{ Fills the entity with a linear gradient.
|
||
Assumes that the boundary is already in canvas units and is specified by
|
||
polygon APoints.
|
||
NOTE: The method modifies the current pen. }
|
||
procedure TvEntityWithPenAndBrush.DrawPolygonBrushLinearGradient(
|
||
var ARenderInfo: TvRenderInfo;
|
||
const APoints: TPointsArray; const APolyStarts: TIntegerDynArray;
|
||
ARect: TRect; AGradientStart, AGradientEnd: T2DPoint);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
lPoints, pts: T2DPointsArray;
|
||
i, j: Integer;
|
||
pf: Double; // fraction of path travelled along gradient vector
|
||
px, py: Double;
|
||
phi: Double;
|
||
sinphi, cosphi: float;
|
||
coord, coord1, coord2, dcoord: Double;
|
||
coordIsX: Boolean;
|
||
p1, p2: T2dPoint;
|
||
gv: T2dPoint; // gradient vector
|
||
gvlen: Double; // length of gradient vector
|
||
gstart: Double; // Gradient start point (1-dim)
|
||
dir: Integer;
|
||
lStr: String;
|
||
begin
|
||
// Direction of gradient vector. The gradient vector begins at the first
|
||
// color position and ends at the last color position specified in the
|
||
// brush's Gradient_colors.
|
||
gv := Point2D(AGradientEnd.X-AGradientStart.X, AGradientEnd.Y-AGradientStart.Y);
|
||
gvlen := sqrt(sqr(gv.x) + sqr(gv.y));
|
||
if gvlen = 0 then
|
||
exit;
|
||
|
||
// Find boundary points where the gradient starts and ends. The gradient is
|
||
// always travered from 0% to 100% color fractions.
|
||
p1 := Point2D(
|
||
IfThen(AGradientEnd.x > AGradientStart.x, ARect.Left, ARect.Right),
|
||
IfThen(AGradientEnd.Y > AGradientStart.y, ARect.Top, ARect.Bottom)
|
||
);
|
||
p2 := Point2D(
|
||
IfThen(AGradientEnd.x > AGradientStart.x, ARect.Right, ARect.Left),
|
||
IfThen(AGradientEnd.Y > AGradientStart.y, ARect.Bottom, ARect.Top)
|
||
);
|
||
|
||
// Prepare parameters and polygon points
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Pen.Width := 1;
|
||
|
||
SetLength(pts, Length(APoints));
|
||
case Brush.Kind of
|
||
bkVerticalGradient:
|
||
begin // Run vertically, horizontal lines have same color
|
||
coord1 := p1.y;
|
||
coord2 := p2.y;
|
||
dcoord := IfThen(AGradientEnd.Y > AGradientStart.Y, 1.0, -1.0);
|
||
gstart := coord1;
|
||
dir := round(dcoord);
|
||
for i := 0 to High(APoints) do
|
||
pts[i] := Point2D(APoints[i].X, APoints[i].Y);
|
||
coordIsX := false;
|
||
gstart := coord1;
|
||
end;
|
||
bkHorizontalGradient:
|
||
begin // Run horizontally, vertical lines have same color
|
||
coord1 := p1.x;
|
||
coord2 := p2.x;
|
||
dcoord := IfThen(AGradientEnd.X > AGradientStart.X, 1.0, -1.0);
|
||
gstart := coord1;
|
||
dir := round(dcoord);
|
||
for i := 0 to High(APoints) do
|
||
pts[i] := Point2D(APoints[i].X, APoints[i].Y);
|
||
coordIsX := true;
|
||
end;
|
||
bkOtherLinearGradient:
|
||
begin // Run along gradient vector, lines perpendicular to gradient vector
|
||
phi := arctan2(gv.y, gv.x);
|
||
Sincos(phi, sinphi, cosphi);
|
||
coordIsX := (abs(sinphi) <= sin(pi/4));
|
||
if not coordIsX then begin
|
||
phi := -(pi/2 - phi);
|
||
Sincos(phi, sinphi, cosphi);
|
||
end;
|
||
// p1 is the boundary point around which the shape is rotated in order to
|
||
// to get the gradient vector in horizontal or vertical direction for
|
||
// easier finding of intersection points.
|
||
// Projection of vector from GradientStart to p1 onto gradient vector
|
||
coord1 := (((p1.x - AGradientStart.X)*gv.x) + (p1.y - AGradientStart.Y)*gv.y) / gvlen;
|
||
// dto for p2.
|
||
coord2 := (((p2.x - AGradientStart.X)*gv.x) + (p2.y - AGradientStart.Y)*gv.Y) / gvlen;
|
||
// Steps for walking along the gradient vector. Note: too-wide steps
|
||
// could result in painting gaps, but this is avoided by using a
|
||
// 2-pixel wide pen below.
|
||
dcoord := 1.0; // --- some gaps with 1.0 / abs(cosphi);
|
||
gstart := -coord1;
|
||
dir := +1;
|
||
// Rotate polygon point such that gradient axis is parallel to x axis
|
||
// (if angle < 45°) or y axis (if angle > 45°)
|
||
// Rotation center is the projection of the corner of the bounding box
|
||
// onto the gradient vector
|
||
p1 := Point2D(
|
||
AGradientStart.X + coord1 * gv.x / gvlen,
|
||
AGradientStart.Y + coord1 * gv.y / gvlen
|
||
);
|
||
for j := 0 to High(APoints) do
|
||
begin
|
||
px := APoints[j].X - p1.x;
|
||
py := APoints[j].Y - p1.y;
|
||
pts[j] := Point2D(px*cosPhi + py*sinPhi, -px*sinPhi + py*cosPhi);
|
||
end;
|
||
// Begin painting at corner
|
||
coord2 := coord2 - coord1;
|
||
coord1 := 0;
|
||
ADest.Pen.Width := 2; // make sure that there are no gaps due to rounding errors
|
||
end;
|
||
end;
|
||
|
||
// Draw gradient
|
||
coord := coord1;
|
||
while ((dcoord > 0) and (coord <= coord2)) or (dcoord < 0) and (coord >= coord2) do
|
||
begin
|
||
// Find intersection points of gradient line (normal to gradient vector)
|
||
// with polygon
|
||
lPoints := GetLinePolygonIntersectionPoints(coord, pts, APolyStarts, coordIsX);
|
||
if Length(lPoints) < 2 then begin
|
||
coord := coord + dcoord;
|
||
Continue;
|
||
end;
|
||
|
||
// Prepare intersection points for painting
|
||
case Brush.Kind of
|
||
bkVerticalGradient:
|
||
// Add loop variable as mssing y coordinate of intersection points
|
||
for j := 0 to High(lPoints) do lPoints[j].Y := coord;
|
||
bkHorizontalGradient:
|
||
// Add loop variable as mssing x coordinate of intersection points
|
||
for j := 0 to High(lPoints) do lPoints[j].X := coord;
|
||
bkOtherLinearGradient:
|
||
// Rotate back
|
||
for j := 0 to High(lPoints) do
|
||
lPoints[j] := Point2D(
|
||
lPoints[j].X * cosPhi - lPoints[j].Y * sinPhi + p1.x,
|
||
lPoints[j].X * sinPhi + lPoints[j].Y * cosPhi + p1.y
|
||
);
|
||
end;
|
||
|
||
// Determine color from fraction (pf) of path travelled along gradient vector
|
||
pf := (coord - gstart) * dir / gvlen;
|
||
if Length(Brush.Gradient_colors) > 0 then
|
||
begin
|
||
ADest.Pen.FPColor := GradientColor(Brush.Gradient_colors, pf);
|
||
end
|
||
else
|
||
begin
|
||
lStr := RenderInfo_GenerateParentTree(ARenderInfo);
|
||
if ARenderInfo.Errors <> nil then
|
||
AddStringToArray(ARenderInfo.Errors, Format('[%s] Empty Brush.Gradient_colors', [lStr]));
|
||
//was: ARenderInfo.Errors.Add(Format('[%s] Empty Brush.Gradient_colors', [lStr]));
|
||
ADest.Pen.FPColor := colBlack;
|
||
end;
|
||
|
||
// Draw gradient lines between intersection points
|
||
j := 0;
|
||
while j < High(lPoints) do
|
||
begin
|
||
ADest.Line(round(lPoints[j].X), round(lPoints[j].Y), round(lPoints[j+1].X), round(lPoints[j+1].Y));
|
||
inc(j, 2);
|
||
end;
|
||
|
||
// Proceed to next line
|
||
coord := coord + dcoord;
|
||
end;
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.DrawPolygonBrushRadialGradient(
|
||
var ARenderInfo: TvRenderInfo;
|
||
const APoints: TPointsArray; ARect: TRect);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
i, j: Integer;
|
||
lx, ly: Integer;
|
||
lGradient_cx_px, lGradient_cy_px, lGradient_r_px{, lGradient_fx_px, lGradient_fy_px}: Integer;
|
||
lWidth, lHeight: Integer;
|
||
lAspectRatio: Double;
|
||
lDist: Double;
|
||
lColor: TFPColor;
|
||
|
||
function GradientValue_to_px(AValue: Double; AUnit: TvCoordinateUnit; ASideLen: Integer; AIsY: Boolean): Integer;
|
||
begin
|
||
Result := 0;
|
||
case AUnit of
|
||
vcuDocumentUnit:
|
||
if AIsY then
|
||
Result := CoordToCanvasY(AValue, ARenderInfo.DestY, ARenderInfo.MulY)
|
||
else
|
||
Result := CoordToCanvasX(AValue, ARenderInfo.DestX, ARenderInfo.MulX);
|
||
vcuPercentage:
|
||
Result := Round(ASideLen * AValue);
|
||
end;
|
||
end;
|
||
|
||
function Distance_To_RadialGradientColor(ADist: Double): TFPColor;
|
||
var
|
||
k, kmax: Integer;
|
||
begin
|
||
Result := colTransparent;
|
||
kmax := Length(Brush.Gradient_colors) - 1;
|
||
for k := 0 to kmax do
|
||
begin
|
||
if k = 0 then
|
||
begin
|
||
Result := Brush.Gradient_colors[k].Color;
|
||
Continue;
|
||
end;
|
||
|
||
if ADist < Brush.Gradient_colors[k].Position then
|
||
begin
|
||
Result := MixColors(
|
||
Brush.Gradient_colors[k-1].Color, Brush.Gradient_colors[k].Color,
|
||
ADist - Brush.Gradient_colors[k-1].Position,
|
||
Brush.Gradient_colors[k].Position - Brush.Gradient_colors[k-1].Position);
|
||
Exit;
|
||
end;
|
||
|
||
if (k = kmax) and (ADist >= Brush.Gradient_colors[k].Position) then
|
||
Result := Brush.Gradient_Colors[k].Color;
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
lWidth := (ARect.Right-ARect.Left);
|
||
lHeight := (ARect.Bottom-ARect.Top);
|
||
lAspectRatio := lHeight/lWidth;
|
||
|
||
// Calculate center of outer-most gradient circle
|
||
lGradient_cx_px := GradientValue_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, lWidth, False);
|
||
lGradient_cy_px := GradientValue_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, lHeight, True);
|
||
// Calculate radius of outer-most gradient circle, relative the width
|
||
lGradient_r_px := GradientValue_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, lWidth, false);
|
||
{ -- not implemented, yet
|
||
lGradient_fx_px := GradientValue_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, False);
|
||
lGradient_fy_px := GradientValue_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, True);
|
||
}
|
||
|
||
// pixel-by-pixel version
|
||
for i := 0 to lWidth-1 do
|
||
begin
|
||
for j := 0 to lHeight-1 do
|
||
begin
|
||
lx := ARect.Left + i;
|
||
ly := ARect.Top + j;
|
||
if not IsPointInPolygon(lx, ly, APoints) then Continue;
|
||
|
||
// distance of current point (i, j) to gradient center, correct for aspect ratio
|
||
lDist := sqrt(sqr(i - lGradient_cx_px) + sqr((j - lGradient_cy_px)/lAspectRatio));
|
||
// lDist := sqrt(sqr(i-lGradient_cx_px)+sqr(j-lGradient_cy_px));
|
||
lDist := lDist / lGradient_r_px;
|
||
lDist := Min(Max(0, lDist), 1);
|
||
lColor := Distance_To_RadialGradientColor(lDist);
|
||
|
||
ADest.Colors[lx, ly] := AlphaBlendColor(ADest.Colors[lx, ly], lColor);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.DrawNativePolygonBrushRadialGradient(
|
||
var ARenderInfo: TvRenderInfo; const APoints: TPointsArray; ARect: TRect);
|
||
{$ifndef FPVECTORIAL_SUPPORT_LAZARUS_1_6}
|
||
{$ifdef USE_LCL_CANVAS}
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
lLogRadGrad: TLogRadialGradient;
|
||
lBrush, lOldBrush: HBRUSH;
|
||
i: Integer;
|
||
|
||
function Gradient_value_to_px(AValue: Double; AUnit: TvCoordinateUnit; AIsY: Boolean): Integer;
|
||
var
|
||
lSideLen: Integer;
|
||
begin
|
||
Result := 0;
|
||
if AIsY then
|
||
lSideLen := (ARect.Bottom-ARect.Top)
|
||
else
|
||
lSideLen := (ARect.Right-ARect.Left);
|
||
case AUnit of
|
||
vcuDocumentUnit:
|
||
if AIsY then
|
||
Result := CoordToCanvasY(AValue, ARenderInfo.DestY, ARenderInfo.MulY)
|
||
else
|
||
Result := CoordToCanvasX(AValue, ARenderInfo.DestX, ARenderInfo.MulX);
|
||
vcuPercentage:
|
||
Result := Round(lSideLen * AValue);
|
||
end;
|
||
end;
|
||
|
||
{$endif}
|
||
{$endif}
|
||
begin
|
||
{$ifndef FPVECTORIAL_SUPPORT_LAZARUS_1_6}
|
||
{$ifdef USE_LCL_CANVAS}
|
||
lLogRadGrad.radCenterX := Gradient_value_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, False);
|
||
lLogRadGrad.radCenterY := Gradient_value_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, False);
|
||
lLogRadGrad.radRadius := Gradient_value_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, True);
|
||
lLogRadGrad.radFocalX := Gradient_value_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, True);
|
||
lLogRadGrad.radFocalY := Gradient_value_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, False);
|
||
|
||
SetLength(lLogRadGrad.radStops, Length(Brush.Gradient_colors));
|
||
for i := 0 to Length(Brush.Gradient_colors)-1 do
|
||
begin
|
||
lLogRadGrad.radStops[i].radColorA := Brush.Gradient_colors[i].Color.alpha;
|
||
lLogRadGrad.radStops[i].radColorR := Brush.Gradient_colors[i].Color.red;
|
||
lLogRadGrad.radStops[i].radColorG := Brush.Gradient_colors[i].Color.green;
|
||
lLogRadGrad.radStops[i].radColorB := Brush.Gradient_colors[i].Color.blue;
|
||
lLogRadGrad.radStops[i].radPosition := Brush.Gradient_colors[i].Position;
|
||
end;
|
||
|
||
lBrush := LCLIntf.CreateBrushWithRadialGradient(lLogRadGrad);
|
||
lOldBrush := TCanvas(ADest).Brush.Handle;
|
||
TCanvas(ADest).Brush.Handle := lBrush;
|
||
TCanvas(ADest).Polygon(APoints);
|
||
TCanvas(ADest).Brush.Handle := lOldBrush;
|
||
{$endif}
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.DrawBrushGradient(
|
||
var ARenderInfo: TvRenderInfo; x1, y1, x2, y2: Integer);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
tmpPath: TPath;
|
||
polypoints: TPointsArray;
|
||
polystarts: TIntegerDynArray;
|
||
lRect: TRect;
|
||
gv1, gv2: T2dPoint;
|
||
j: Integer;
|
||
begin
|
||
tmpPath := CreatePath;
|
||
if tmpPath = nil then
|
||
exit;
|
||
try
|
||
ConvertPathToPolygons(tmpPath, ADestX, ADestY, AMulX, AMulY, polypoints, polystarts);
|
||
|
||
// Boundary rect of shape filled with a gradient
|
||
lRect := Rect(x1, y1, x2, y2);
|
||
NormalizeRect(lRect);
|
||
|
||
case Brush.Kind of
|
||
bkHorizontalGradient,
|
||
bkVerticalGradient,
|
||
bkOtherLinearGradient:
|
||
begin
|
||
// Calculate gradient vector
|
||
CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
|
||
// Draw the gradient
|
||
DrawPolygonBrushLinearGradient(ARenderInfo, polyPoints, polystarts, lRect, gv1, gv2);
|
||
end;
|
||
bkRadialGradient:
|
||
{$ifdef USE_LCL_CANVAS}
|
||
if Widgetset.GetLCLCapability(lcRadialGradientBrush) = LCL_CAPABILITY_YES then
|
||
DrawNativePolygonBrushRadialGradient(ARenderInfo, polypoints, Bounds(0, 0, 1, 1))
|
||
else
|
||
{$endif}
|
||
DrawPolygonBrushRadialGradient(ARenderInfo, polypoints, lRect);
|
||
end;
|
||
|
||
// Paint outline
|
||
DrawPolygonBorderOnly(ARenderInfo, polyPoints);
|
||
|
||
finally
|
||
tmpPath.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.DrawBrush(var ARenderInfo: TvRenderInfo);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
tmpPath: TPath;
|
||
polypoints: TPointsArray = nil;
|
||
polystarts: TIntegerDynArray = nil;
|
||
begin
|
||
tmpPath := CreatePath;
|
||
if tmpPath = nil then
|
||
exit;
|
||
try
|
||
ConvertPathToPolygons(tmpPath, ADestX, ADestY, AMulX, AMulY, polypoints, polystarts);
|
||
{$IFDEF USE_LCL_CANVAS}
|
||
TCanvas(ADest).Polygon(polypoints, WindingRule = vcmNonZeroWindingRule);
|
||
{$ELSE}
|
||
ADest.Polygon(polypoints);
|
||
{$ENDIF}
|
||
finally
|
||
tmpPath.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvEntityWithPenAndBrush.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
ApplyBrushToCanvas(ARenderInfo);
|
||
end;
|
||
|
||
function TvEntityWithPenAndBrush.GenerateDebugTree(
|
||
ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
lStr := Format('[%s] Name=%s X=%f Y=%f Pen=[Color=%s Style=%s] Brush=[Color=%s Style=%s Kind=%s] %s',
|
||
[Self.ClassName, Self.Name, X, Y,
|
||
GenerateDebugStrForFPColor(Pen.Color),
|
||
GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)),
|
||
GenerateDebugStrForFPColor(Brush.Color),
|
||
GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)),
|
||
GetEnumName(TypeInfo(TvBrushKind), integer(Brush.Kind)),
|
||
FExtraDebugStr]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
end;
|
||
|
||
|
||
{ TvEntityWithPenBrushAndFont }
|
||
|
||
constructor TvEntityWithPenBrushAndFont.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
Font.Color := colBlack;
|
||
Font.Size := 10;
|
||
end;
|
||
|
||
procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(ARenderInfo: TvRenderInfo);
|
||
begin
|
||
ApplyFontToCanvas(ARenderInfo, Font);
|
||
end;
|
||
|
||
procedure TvEntityWithPenBrushAndFont.ApplyFontToCanvas(
|
||
ARenderInfo: TvRenderInfo; AFont: TvFont);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ALCLDest: TCanvas absolute ARenderInfo.Canvas;
|
||
{$endif}
|
||
lFPColor: TFPColor;
|
||
begin
|
||
if ADest = nil then
|
||
exit;
|
||
ADest.Font.Name := AFont.Name;
|
||
if AFont.Size = 0 then AFont.Size := 10;
|
||
ADest.Font.Size := Round(AmulX * AFont.Size);
|
||
ADest.Font.Bold := AFont.Bold;
|
||
ADest.Font.Italic := AFont.Italic;
|
||
ADest.Font.Underline := AFont.Underline;
|
||
{$IF (FPC_FULLVERSION<=20600) or (FPC_FULLVERSION=20602)}
|
||
ADest.Font.StrikeTrough := AFont.StrikeThrough; //old version with typo
|
||
{$ELSE}
|
||
ADest.Font.StrikeThrough := AFont.StrikeThrough;
|
||
{$ENDIF}
|
||
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ALCLDest.Font.Orientation := Round(AFont.Orientation * 10); // wp: was * 16
|
||
{$endif}
|
||
lFPColor := AdjustColorToBackground(AFont.Color, ARenderInfo);
|
||
ADest.Font.FPColor := lFPColor;
|
||
end;
|
||
|
||
procedure TvEntityWithPenBrushAndFont.AssignFont(AFont: TvFont);
|
||
begin
|
||
Font.Color := AFont.Color;
|
||
Font.Size := AFont.Size;
|
||
Font.Name := AFont.Name;
|
||
Font.Orientation := AFont.Orientation;
|
||
Font.Bold := AFont.Bold;
|
||
Font.Italic := AFont.Italic;
|
||
Font.Underline := AFont.Underline;
|
||
Font.StrikeThrough := AFont.StrikeThrough;
|
||
end;
|
||
|
||
procedure TvEntityWithPenBrushAndFont.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
begin
|
||
inherited Rotate(AAngle, ABase);
|
||
Font.Orientation := -RadToDeg(AAngle); // wp: - added for svg text rotation which has CW orientation. Maybe wrong for others???
|
||
end;
|
||
|
||
procedure TvEntityWithPenBrushAndFont.Scale(ADeltaScaleX, ADeltaScaleY: Double);
|
||
begin
|
||
inherited Scale(ADeltaScaleX, ADeltaScaleY);
|
||
Font.Size := Font.Size * ADeltaScaleX;
|
||
end;
|
||
|
||
procedure TvEntityWithPenBrushAndFont.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
ApplyFontToCanvas(ARenderInfo);
|
||
end;
|
||
|
||
function TvEntityWithPenBrushAndFont.GenerateDebugTree(
|
||
ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
// Add the font debug info in a sub-item
|
||
lStr := Format('[Font] Color=%s Size=%f Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s',
|
||
[GenerateDebugStrForFPColor(Font.Color),
|
||
Font.Size, Font.Name, Font.Orientation,
|
||
BoolToStr(Font.Bold),
|
||
BoolToStr(Font.Italic),
|
||
BoolToStr(Font.Underline),
|
||
BoolToStr(Font.StrikeThrough)
|
||
]);
|
||
ADestRoutine(lStr, Result);
|
||
end;
|
||
|
||
{ TvEntityWithStyle }
|
||
|
||
constructor TvEntityWithStyle.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
end;
|
||
|
||
destructor TvEntityWithStyle.Destroy;
|
||
begin
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvEntityWithStyle.GetCombinedStyle(AParent: TvEntityWithStyle): TvStyle;
|
||
begin
|
||
if (AParent <> nil) and (Style = nil) then Result := AParent.Style
|
||
else Result := Style;
|
||
end;
|
||
|
||
procedure TvEntityWithStyle.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
if (Style <> nil) then
|
||
begin
|
||
ApplyPenToCanvas(ARenderInfo, Style.Pen);
|
||
ApplyBrushToCanvas(ARenderInfo, @Style.Brush);
|
||
ApplyFontToCanvas(ARenderInfo, Style.Font);
|
||
end;
|
||
end;
|
||
|
||
{ TPath }
|
||
|
||
constructor TPath.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
FCurMoveSubPartIndex := -1;
|
||
end;
|
||
|
||
//GM: Follow the path to cleanly release the chained list!
|
||
destructor TPath.Destroy;
|
||
begin
|
||
Clear;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TPath.Clear;
|
||
var
|
||
p, pp, np: TPathSegment;
|
||
begin
|
||
p:=PointsEnd;
|
||
if (p<>nil) then
|
||
begin
|
||
np:=p.Next;
|
||
while (p<>nil) do
|
||
begin
|
||
pp:=p.Previous;
|
||
p.Next:=nil;
|
||
p.Previous:=nil;
|
||
FreeAndNil(p);
|
||
p:=pp;
|
||
end;
|
||
p:=np;
|
||
while (p<>nil) do
|
||
begin
|
||
np:=p.Next;
|
||
p.Next:=nil;
|
||
p.Previous:=nil;
|
||
FreeAndNil(p);
|
||
p:=np;
|
||
end;
|
||
end;
|
||
PointsEnd:=nil;
|
||
Points:=nil;
|
||
|
||
inherited Clear;
|
||
end;
|
||
|
||
procedure TPath.Assign(ASource: TPath);
|
||
begin
|
||
Len := ASource.Len;
|
||
Points := ASource.Points;
|
||
PointsEnd := ASource.PointsEnd;
|
||
CurPoint := ASource.CurPoint;
|
||
Pen := ASource.Pen;
|
||
Brush := ASource.Brush;
|
||
ClipPath := ASource.ClipPath;
|
||
ClipMode := ASource.ClipMode;
|
||
end;
|
||
|
||
procedure TPath.PrepareForSequentialReading;
|
||
begin
|
||
CurPoint := nil;
|
||
end;
|
||
|
||
procedure TPath.PrepareForWalking;
|
||
begin
|
||
PrepareForSequentialReading();
|
||
CurWalkDistanceInCurSegment := 0;
|
||
Next();
|
||
end;
|
||
|
||
function TPath.Next(): TPathSegment;
|
||
begin
|
||
if CurPoint = nil then Result := Points
|
||
else Result := CurPoint.Next;
|
||
|
||
CurPoint := Result;
|
||
end;
|
||
|
||
// Walk is walking a distance in the path and obtaining the point where we land and the current tangent
|
||
// Returns true if successful, false otherwise
|
||
// ATangentAngle - In radians
|
||
function TPath.NextWalk(ADistance: Double; out AX, AY, ATangentAngle: Double): Boolean;
|
||
var
|
||
lCurPoint: TPathSegment;
|
||
lCurPointLen: Double;
|
||
begin
|
||
Result := False;
|
||
lCurPoint := CurPoint;
|
||
CurWalkDistanceInCurSegment := ADistance + CurWalkDistanceInCurSegment;
|
||
if lCurPoint = nil then Exit;
|
||
lCurPointLen := lCurPoint.GetLength();
|
||
|
||
// get the current segment
|
||
while CurWalkDistanceInCurSegment >= lCurPointLen do
|
||
begin
|
||
CurWalkDistanceInCurSegment := CurWalkDistanceInCurSegment - lCurPointLen;
|
||
lCurPoint := Next();
|
||
if lCurPoint = nil then Exit;
|
||
lCurPointLen := lCurPoint.GetLength();
|
||
end;
|
||
|
||
Result := lCurPoint.GetPointAndTangentForDistance(CurWalkDistanceInCurSegment, AX, AY, ATangentAngle);
|
||
end;
|
||
|
||
procedure TPath.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
lSegment: TPathSegment;
|
||
l2DSegment: T2DSegment;
|
||
lFirstValue: Boolean = True;
|
||
begin
|
||
inherited CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
|
||
|
||
PrepareForSequentialReading();
|
||
lSegment := Next();
|
||
while lSegment <> nil do
|
||
begin
|
||
if lSegment is T2DSegment then
|
||
begin
|
||
l2DSegment := T2DSegment(lSegment);
|
||
if lFirstValue then
|
||
begin
|
||
ALeft := l2DSegment.X;
|
||
ATop := l2DSegment.Y;
|
||
ARight := l2DSegment.X;
|
||
ABottom := l2DSegment.Y;
|
||
lFirstValue := False;
|
||
end
|
||
else
|
||
begin
|
||
if l2DSegment.X < ALeft then ALeft := l2DSegment.X;
|
||
if l2DSegment.X > ARight then ARight := l2DSegment.X;
|
||
if ARenderInfo.Page.UseTopLeftCoordinates then
|
||
begin
|
||
if l2DSegment.Y < ATop then ATop := l2DSegment.Y;
|
||
if l2DSegment.Y > ABottom then ABottom := l2DSegment.Y;
|
||
end else
|
||
begin
|
||
if l2DSegment.Y > ATop then ATop := l2DSegment.Y;
|
||
if l2DSegment.Y < ABottom then ABottom := l2DSegment.Y;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
lSegment := Next();
|
||
end;
|
||
end;
|
||
|
||
procedure TPath.AppendSegment(ASegment: TPathSegment);
|
||
var
|
||
L: Integer;
|
||
begin
|
||
ASegment.FPath := self;
|
||
|
||
// Check if we are the first segment in the tmp path
|
||
if PointsEnd = nil then
|
||
begin
|
||
if Len <> 0 then
|
||
Exception.Create('[TPath.AppendSegment] Assertion failed Len <> 0 with PointsEnd = nil');
|
||
|
||
Points := ASegment;
|
||
PointsEnd := ASegment;
|
||
Len := 1;
|
||
Exit;
|
||
end;
|
||
|
||
L := Len;
|
||
Inc(Len);
|
||
|
||
// Adds the element to the end of the list
|
||
PointsEnd.Next := ASegment;
|
||
ASegment.Previous := PointsEnd;
|
||
PointsEnd := ASegment;
|
||
end;
|
||
|
||
procedure TPath.AppendMoveToSegment(AX, AY: Double);
|
||
var
|
||
segment: T2DSegment;
|
||
begin
|
||
segment := T2DSegment.Create;
|
||
segment.SegmentType := stMoveTo;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
AppendSegment(segment);
|
||
end;
|
||
|
||
procedure TPath.AppendLineToSegment(AX, AY: Double);
|
||
var
|
||
segment: T2DSegment;
|
||
begin
|
||
segment := T2DSegment.Create;
|
||
segment.SegmentType := st2DLine;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
AppendSegment(segment);
|
||
end;
|
||
|
||
procedure TPath.AppendEllipticalArc(ARadX, ARadY, AXAxisRotation, ADestX,
|
||
ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean);
|
||
var
|
||
segment: T2DEllipticalArcSegment;
|
||
begin
|
||
segment := T2DEllipticalArcSegment.Create;
|
||
segment.SegmentType := st2DEllipticalArc;
|
||
segment.X := ADestX;
|
||
segment.Y := ADestY;
|
||
segment.RX := ARadX;
|
||
segment.RY := ARadY;
|
||
segment.XRotation := AXAxisRotation;
|
||
segment.LeftmostEllipse := ALeftmostEllipse;
|
||
segment.ClockwiseArcFlag := AClockwiseArcFlag;
|
||
|
||
AppendSegment(segment);
|
||
end;
|
||
|
||
procedure TPath.AppendEllipticalArcWithCenter(ARadX, ARadY, AXAxisRotation,
|
||
ADestX, ADestY, ACenterX, ACenterY: Double; AClockwiseArcFlag: Boolean);
|
||
var
|
||
segment: T2DEllipticalArcSegment;
|
||
begin
|
||
segment := T2DEllipticalArcSegment.Create;
|
||
segment.SegmentType := st2DEllipticalArc;
|
||
segment.X := ADestX;
|
||
segment.Y := ADestY;
|
||
segment.RX := ARadX;
|
||
segment.RY := ARadY;
|
||
segment.CX := ACenterX;
|
||
segment.CY := ACenterY;
|
||
segment.XRotation := AXAxisRotation;
|
||
segment.LeftmostEllipse := False; // which value would it have?
|
||
segment.ClockwiseArcFlag := AClockwiseArcFlag;
|
||
segment.CenterSetByUser := True;
|
||
|
||
AppendSegment(segment);
|
||
end;
|
||
|
||
procedure TPath.Move(ADeltaX, ADeltaY: Double);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
inherited Move(ADeltaX, ADeltaY);
|
||
for i := 0 to GetSubpartCount()-1 do
|
||
begin
|
||
MoveSubpart(ADeltaX, ADeltaY, i);
|
||
end;
|
||
end;
|
||
|
||
procedure TPath.MoveSubpart(ADeltaX, ADeltaY: Double; ASubpart: Cardinal);
|
||
var
|
||
lCurPart: TPathSegment;
|
||
begin
|
||
if (ASubPart < 0) or (ASubPart > Len) then
|
||
raise Exception.Create(Format('[TPath.MoveSubpart] Invalid index %d', [ASubpart]));
|
||
|
||
// Move to the subpart
|
||
lCurPart := MoveToSubpart(ASubpart);
|
||
|
||
// Do the change
|
||
lCurPart.Move(ADeltaX, ADeltaY);
|
||
end;
|
||
|
||
function TPath.MoveToSubpart(ASubpart: Cardinal): TPathSegment;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
if (ASubPart < 0) or (ASubPart > Len) then
|
||
raise Exception.Create(Format('[TPath.MoveToSubpart] Invalid index %d', [ASubpart]));
|
||
|
||
// Move to the subpart
|
||
if (ASubPart = FCurMoveSubPartIndex) then
|
||
begin
|
||
Result := FCurMoveSubPartSegment;
|
||
end
|
||
else if (FCurMoveSubPartSegment <> nil) and (ASubPart = FCurMoveSubPartIndex + 1) then
|
||
begin
|
||
Result := FCurMoveSubPartSegment.Next;
|
||
FCurMoveSubPartIndex := FCurMoveSubPartIndex + 1;
|
||
FCurMoveSubPartSegment := Result;
|
||
end
|
||
else if (FCurMoveSubPartSegment <> nil) and (ASubPart = FCurMoveSubPartIndex - 1) then
|
||
begin
|
||
Result := FCurMoveSubPartSegment.Previous;
|
||
FCurMoveSubPartIndex := FCurMoveSubPartIndex - 1;
|
||
FCurMoveSubPartSegment := Result;
|
||
end
|
||
else
|
||
begin
|
||
Result := Points;
|
||
|
||
for i := 0 to ASubpart-1 do
|
||
Result := Result.Next;
|
||
|
||
FCurMoveSubPartIndex := ASubpart;
|
||
FCurMoveSubPartSegment := Result;
|
||
end;
|
||
end;
|
||
|
||
function TPath.GetSubpartCount: Integer;
|
||
begin
|
||
Result := Len;
|
||
end;
|
||
|
||
{ Rotates all points of the path by the given angle (in radians) around the
|
||
point ABase. }
|
||
procedure TPath.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
i: Integer;
|
||
lCurPart: TPathSegment;
|
||
begin
|
||
inherited Rotate(AAngle, ABase);
|
||
for i := 0 to GetSubpartCount()-1 do
|
||
begin
|
||
// Move to the subpart
|
||
lCurPart := MoveToSubpart(i);
|
||
// Rotate it
|
||
lCurPart.Rotate(AAngle, ABase);
|
||
end;
|
||
end;
|
||
|
||
{ Only correct for straight segments. This must have been checked before! }
|
||
function TPath.GetLineIntersectionPoints(ACoord: Double;
|
||
ACoordIsX: Boolean): TDoubleDynArray;
|
||
const
|
||
COUNT = 100;
|
||
var
|
||
seg: TPathSegment;
|
||
seg2D: T2DSegment; // absolute seg;
|
||
j: Integer;
|
||
p, p1, p2: T3DPoint;
|
||
n: Integer;
|
||
begin
|
||
SetLength(Result, COUNT);
|
||
PrepareForSequentialReading;
|
||
n := 0;
|
||
if ACoordIsX then
|
||
for j:=0 to Len-1 do
|
||
begin
|
||
seg := TPathSegment(Next);
|
||
if seg.GetStartPoint(p) and (seg is T2DSegment) then
|
||
begin
|
||
seg2D := T2DSegment(seg);
|
||
if p.X < seg2D.X then begin
|
||
p1 := Make3DPoint(p.X, p.Y);
|
||
p2 := Make3DPoint(seg2D.X, seg2D.Y);
|
||
end else
|
||
begin
|
||
p1 := Make3DPoint(seg2D.X, seg2D.Y);
|
||
p2 := Make3DPoint(p.X, p.Y);
|
||
end;
|
||
if (p1.X < ACoord) and (ACoord <= p2.X) then
|
||
begin
|
||
if n >= Length(Result) then
|
||
SetLength(Result, Length(Result) + COUNT);
|
||
if (p1.X = p2.X) then
|
||
Result[n] := p1.Y else
|
||
Result[n] := p1.Y + (ACoord - p1.X) * (p2.Y - p1.Y) / (p2.X - p1.X);
|
||
inc(n);
|
||
end;
|
||
end;
|
||
end
|
||
else
|
||
for j := 0 to Len-1 do
|
||
begin
|
||
seg := TPathSegment(Next);
|
||
if seg.GetStartPoint(p) and (seg is T2DSegment) then
|
||
begin
|
||
seg2D := T2DSegment(seg);
|
||
if p.Y < seg2D.Y then
|
||
begin
|
||
p1 := Make3DPoint(p.X, p.Y);
|
||
p2 := Make3DPoint(seg2D.X, seg2D.Y);
|
||
end else
|
||
begin
|
||
p1 := Make3DPoint(seg2D.X, seg2D.Y);
|
||
p2 := Make3DPoint(p.X, p.Y);
|
||
end;
|
||
if (p1.Y < ACoord) and (ACoord <= p2.Y) then
|
||
begin
|
||
if n >= Length(Result) then
|
||
SetLength(Result, Length(Result) + COUNT);
|
||
if (p1.Y = p2.Y) then
|
||
Result[n] := p1.X else
|
||
Result[n] := p1.X + (ACoord - p1.Y) * (p2.X - p1.x) / (p2.Y - p1.Y);
|
||
inc(n);
|
||
end;
|
||
end;
|
||
end;
|
||
SetLength(Result, n);
|
||
end;
|
||
|
||
procedure TPath.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
ARenderInfo.Renderer.TPath_Render(ARenderInfo, ADoDraw, Self);
|
||
end;
|
||
|
||
|
||
(*
|
||
procedure TPath.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
|
||
ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
|
||
|
||
function CanFill: Boolean;
|
||
var
|
||
seg: TPathSegment;
|
||
j: Integer;
|
||
begin
|
||
Result := true;
|
||
PrepareForSequentialReading;
|
||
for j := 0 to Len - 1 do
|
||
begin
|
||
seg := TPathSegment(Next());
|
||
if seg.SegmentType in [st2DBezier, st3dBezier, st2DEllipticalArc] then
|
||
begin
|
||
Result := false;
|
||
exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
const
|
||
POINT_BUFFER = 100;
|
||
var
|
||
i, j: Integer;
|
||
PosX, PosY: Double; // Not modified by ADestX, etc
|
||
CoordX, CoordY: Integer;
|
||
CurSegment: TPathSegment;
|
||
Cur2DSegment: T2DSegment absolute CurSegment;
|
||
Cur2DBSegment: T2DBezierSegment absolute CurSegment;
|
||
Cur2DArcSegment: T2DEllipticalArcSegment absolute CurSegment;
|
||
x1, y1, x2, y2: Integer;
|
||
// For bezier
|
||
CoordX2, CoordY2, CoordX3, CoordY3, CoordX4, CoordY4, CoordX5, CoordY5: Integer;
|
||
// For polygons
|
||
lPoints, pts: array of TPoint;
|
||
NumPoints: Integer;
|
||
pts3d: T3dPointsArray = nil;
|
||
// for elliptical arcs
|
||
BoxLeft, BoxTop, BoxRight, BoxBottom: Double;
|
||
EllipseRect: TRect;
|
||
// Clipping Region
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ClipRegion, OldClipRegion: HRGN;
|
||
ACanvas: TCanvas absolute ADest;
|
||
{$endif}
|
||
begin
|
||
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
|
||
PosX := 0;
|
||
PosY := 0;
|
||
// ADest.Brush.Style := bsClear;
|
||
|
||
ADest.MoveTo(ADestX, ADestY);
|
||
{
|
||
// Set the path Pen and Brush options
|
||
ADest.Pen.Style := Pen.Style;
|
||
ADest.Pen.Width := Round(Pen.Width * AMulX);
|
||
if ADest.Pen.Width < 1 then ADest.Pen.Width := 1;
|
||
if (Pen.Width <= 2) and (ADest.Pen.Width > 2) then ADest.Pen.Width := 2;
|
||
if (Pen.Width <= 5) and (ADest.Pen.Width > 5) then ADest.Pen.Width := 5;
|
||
ADest.Pen.FPColor := AdjustColorToBackground(Pen.Color, ARenderInfo);
|
||
{$ifdef USE_LCL_CANVAS}
|
||
if (Pen.Style = psPattern) then
|
||
ACanvas.Pen.SetPattern(Pen.Pattern);
|
||
{$endif}
|
||
ADest.Brush.FPColor := Brush.Color;
|
||
}
|
||
// Prepare the Clipping Region, if any
|
||
{$ifdef USE_CANVAS_CLIP_REGION}
|
||
if ClipPath <> nil then
|
||
begin
|
||
OldClipRegion := LCLIntf.CreateEmptyRegion();
|
||
GetClipRgn(ACanvas.Handle, OldClipRegion);
|
||
ClipRegion := ConvertPathToRegion(ClipPath, ADestX, ADestY, AMulX, AMulY);
|
||
SelectClipRgn(ACanvas.Handle, ClipRegion);
|
||
DeleteObject(ClipRegion);
|
||
// debug info
|
||
{$ifdef DEBUG_CANVAS_CLIP_REGION}
|
||
ConvertPathToPoints(CurPath.ClipPath, ADestX, ADestY, AMulX, AMulY);
|
||
ACanvas.Polygon(lPoints);
|
||
{$endif}
|
||
end;
|
||
{$endif}
|
||
|
||
// useful in some paths, like stars!
|
||
{ -- wp: causes artifacts in case of concave path
|
||
if ADoDraw then
|
||
RenderInternalPolygon(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY);
|
||
}
|
||
|
||
if CanFill then
|
||
begin
|
||
// Manually fill polygon with gradient
|
||
{$IFDEF USE_LCL_CANVAS}
|
||
if ADoDraw and (Brush.Kind in [bkHorizontalGradient, bkVerticalGradient]) then
|
||
begin
|
||
x1 := MaxInt;
|
||
y1 := MaxInt;
|
||
x2 := -MaxInt;
|
||
y2 := -MaxInt;
|
||
PrepareForSequentialReading;
|
||
for j := 0 to Len - 1 do
|
||
begin
|
||
CurSegment := TPathSegment(Next);
|
||
CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
|
||
CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
|
||
x1 := Min(x1, CoordX);
|
||
y1 := Min(y1, CoordY);
|
||
x2 := Max(x2, CoordX);
|
||
y2 := Max(y2, CoordY);
|
||
end;
|
||
DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
//
|
||
// For other paths, draw more carefully
|
||
//
|
||
ApplyPenToCanvas(ADest, ARenderInfo, Pen); // Restore pen
|
||
PrepareForSequentialReading;
|
||
|
||
SetLength(lPoints, POINT_BUFFER);
|
||
NumPoints := 0;
|
||
|
||
for j := 0 to Len - 1 do
|
||
begin
|
||
//WriteLn('j = ', j);
|
||
CurSegment := TPathSegment(Next());
|
||
|
||
case CurSegment.SegmentType of
|
||
stMoveTo:
|
||
begin
|
||
CoordX := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
|
||
CoordY := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
// Draw previous polygon
|
||
if NumPoints > 0 then
|
||
begin
|
||
SetLength(lPoints, NumPoints);
|
||
if Length(lPoints) = 2 then
|
||
ADest.Line(lPoints[0].X, lPoints[0].Y, lPoints[1].X, lPoints[1].Y)
|
||
else
|
||
ADest.Polygon(lPoints);
|
||
// Start new polygon
|
||
SetLength(lPoints, POINT_BUFFER);
|
||
NumPoints := 0;
|
||
end;
|
||
|
||
lPoints[0].X := CoordX;
|
||
lPoints[0].Y := CoordY;
|
||
NumPoints := 1;
|
||
end;
|
||
|
||
|
||
{
|
||
if ADoDraw then
|
||
ADest.MoveTo(CoordX, CoordY);
|
||
}
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, CoordX, CoordY);
|
||
PosX := Cur2DSegment.X;
|
||
PosY := Cur2DSegment.Y;
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format(' M%d,%d', [CoordX, CoordY]));
|
||
{$endif}
|
||
end;
|
||
|
||
// This element can override temporarely the Pen
|
||
|
||
// TO DO: Paint these segments with correct pen at end !!!!
|
||
|
||
|
||
st2DLineWithPen:
|
||
begin
|
||
ADest.Pen.FPColor := AdjustColorToBackground(T2DSegmentWithPen(Cur2DSegment).Pen.Color, ARenderInfo);
|
||
CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
|
||
CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
|
||
CoordX2 := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
|
||
CoordY2 := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
|
||
if ADoDraw then
|
||
begin
|
||
if NumPoints >= Length(lPoints) then
|
||
SetLength(lPoints, Length(lPoints) + POINT_BUFFER);
|
||
lPoints[NumPoints].X := CoordX2;
|
||
lPoints[NumPoints].Y := CoordY2;
|
||
inc(NumPoints);
|
||
// ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
|
||
end;
|
||
|
||
PosX := Cur2DSegment.X;
|
||
PosY := Cur2DSegment.Y;
|
||
|
||
ADest.Pen.FPColor := Pen.Color;
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format(' L%d,%d', [CoordX2, CoordY2]));
|
||
{$endif}
|
||
end;
|
||
|
||
st2DLine, st3DLine:
|
||
begin
|
||
CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
|
||
CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
|
||
CoordX2 := CoordToCanvasX(Cur2DSegment.X, ADestX, AMulX);
|
||
CoordY2 := CoordToCanvasY(Cur2DSegment.Y, ADestY, AMulY);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
|
||
if ADoDraw then
|
||
begin
|
||
if NumPoints >= Length(lPoints) then
|
||
SetLength(lPoints, Length(lPoints) + POINT_BUFFER);
|
||
lPoints[NumPoints].X := CoordX2;
|
||
lPoints[NumPoints].Y := CoordY2;
|
||
inc(NumPoints);
|
||
// ADest.Line(CoordX, CoordY, CoordX2, CoordY2);
|
||
end;
|
||
PosX := Cur2DSegment.X;
|
||
PosY := Cur2DSegment.Y;
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format(' L%d,%d', [CoordX2, CoordY2]));
|
||
{$endif}
|
||
end;
|
||
|
||
{ To draw a bezier we need to divide the interval in parts and make
|
||
lines between this parts }
|
||
st2DBezier, st3DBezier:
|
||
begin
|
||
CoordX := CoordToCanvasX(PosX, ADestX, AMulX);
|
||
CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
|
||
CoordX2 := CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX);
|
||
CoordY2 := CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY);
|
||
CoordX3 := CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX);
|
||
CoordY3 := CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY);
|
||
CoordX4 := CoordToCanvasX(Cur2DBSegment.X, ADestX, AMulX);
|
||
CoordY4 := CoordToCanvasY(Cur2DBSegment.Y, ADestY, AMulY);
|
||
// SetLength(lPoints, 0);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX, CoordY, CoordX2, CoordY2);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, CoordX3, CoordY3, CoordX4, CoordY4);
|
||
SetLength(pts, 0);
|
||
AddBezierToPoints(
|
||
Make2DPoint(CoordX, CoordY),
|
||
Make2DPoint(CoordX2, CoordY2),
|
||
Make2DPoint(CoordX3, CoordY3),
|
||
Make2DPoint(CoordX4, CoordY4),
|
||
pts //lPoints
|
||
);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
if NumPoints + Length(pts) >= POINT_BUFFER then
|
||
SetLength(lPoints, NumPoints + Length(pts));
|
||
for i:=0 to High(pts) do
|
||
begin
|
||
lPoints[NumPoints].X := pts[i].X;
|
||
lPoints[NumPoints].Y := pts[i].Y;
|
||
inc(numPoints);
|
||
end;
|
||
end;
|
||
|
||
ADest.Brush.Style := Brush.Style;
|
||
{
|
||
if (Length(lPoints) >= 3) and ADoDraw then
|
||
ADest.Polygon(lPoints);
|
||
}
|
||
PosX := Cur2DSegment.X;
|
||
PosY := Cur2DSegment.Y;
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
|
||
[CoordToCanvasX(PosX, ADestX, AMulX), CoordToCanvasY(PosY, ADestY, AMulY),
|
||
CoordToCanvasX(Cur2DBSegment.X2, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y2, ADestY, AMulY),
|
||
CoordToCanvasX(Cur2DBSegment.X3, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y3, ADestY, AMulY),
|
||
CoordToCanvasX(Cur2DBSegment.X, ADestX, AMulX), CoordToCanvasY(Cur2DBSegment.Y, ADestY, AMulY)]));
|
||
{$endif}
|
||
end;
|
||
|
||
st2DEllipticalArc:
|
||
begin
|
||
CoordX := CoordToCanvasX(PosX, ADestX, AMulX); // start point of segment
|
||
CoordY := CoordToCanvasY(PosY, ADestY, AMulY);
|
||
CoordX2 := CoordToCanvasX(Cur2DArcSegment.RX, ADestX, AMulX); // major axis radius
|
||
CoordY2 := CoordToCanvasY(Cur2DArcSegment.RY, ADestY, AMulY); // minor axis radius
|
||
CoordX3 := CoordToCanvasX(Cur2DArcSegment.XRotation, 0, sign(AMulX)); // axis rotation angle
|
||
CoordX4 := CoordToCanvasX(Cur2DArcSegment.X, ADestX, AMulX); // end point of segment
|
||
CoordY4 := CoordToCanvasY(Cur2DArcSegment.Y, ADestY, AMulY);
|
||
CoordX5 := CoordToCanvasX(Cur2DArcSegment.Cx, ADestX, AMulX); // Ellipse center
|
||
CoordY5 := CoordToCanvasY(Cur2DArcSegment.Cy, ADestY, AMulY);
|
||
// SetLength(lPoints, 0);
|
||
|
||
Cur2DArcSegment.CalculateEllipseBoundingBox(nil, BoxLeft, BoxTop, BoxRight, BoxBottom);
|
||
|
||
EllipseRect.Left := CoordToCanvasX(BoxLeft, ADestX, AMulX);
|
||
EllipseRect.Top := CoordToCanvasY(BoxTop, ADestY, AMulY);
|
||
EllipseRect.Right := CoordToCanvasX(BoxRight, ADestX, AMulX);
|
||
EllipseRect.Bottom := CoordToCanvasY(BoxBottom, ADestY, AMulY);
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_ELLIPSE_VISUALDEBUG}
|
||
ACanvas.Pen.Color := clRed;
|
||
ACanvas.Brush.Style := bsClear;
|
||
ACanvas.Rectangle( // Ellipse bounding box
|
||
EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
|
||
ACanvas.Line(CoordX5-5, CoordY5, CoordX5+5, CoordY5); // Ellipse center
|
||
ACanvas.Line(CoordX5, CoordY5-5, CoordX5, CoordY5+5);
|
||
ACanvas.Pen.Color := clBlue;
|
||
ACanvas.Line(CoordX-5, CoordY, CoordX+5, CoordY); // Start point
|
||
ACanvas.Line(CoordX, CoordY-5, CoordX, CoordY+5);
|
||
ACanvas.Line(CoordX4-5, CoordY4, CoordX4+5, CoordY4); // End point
|
||
ACanvas.Line(CoordX4, CoordY4-5, CoordX4, CoordY4+5);
|
||
|
||
{$endif}
|
||
|
||
// ADest.Brush.Style := Brush.Style;
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
|
||
EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
Cur2DArcSegment.PolyApproximate(pts3D);
|
||
// Cur2DArcSegment.BezierApproximate(pts3D);
|
||
if NumPoints + Length(pts3D) >= POINT_BUFFER then
|
||
SetLength(lPoints, NumPoints + Length(pts3D));
|
||
for i:=1 to High(pts3D) do // i=0 is end point of prev segment -> we can skip it.
|
||
begin
|
||
lPoints[NumPoints].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
|
||
lPoints[NumPoints].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
|
||
inc(numPoints);
|
||
end;
|
||
{
|
||
SetLength(lPoints, Length(pts3D));
|
||
for i:=0 to High(pts3D) do
|
||
begin
|
||
lPoints[i].X := CoordToCanvasX(pts3D[i].X, ADestX, AMulX);
|
||
lPoints[i].Y := CoordToCanvasY(pts3D[i].Y, ADestY, AMulY);
|
||
end;
|
||
ADest.Polygon(lPoints);
|
||
}
|
||
{
|
||
i := 0;
|
||
while i < Length(lPoints) do
|
||
begin
|
||
ADest.Polygon([lPoints[i], lPoints[i+1], lPoints[i+2], lPoints[i+3]]);
|
||
inc(i, 4);
|
||
end;
|
||
}
|
||
{
|
||
// Arc draws counterclockwise
|
||
if Cur2DArcSegment.ClockwiseArcFlag then
|
||
ACanvas.Arc(
|
||
EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom,
|
||
CoordX4, CoordY4, CoordX, CoordY)
|
||
else
|
||
ACanvas.Arc(
|
||
EllipseRect.Left, EllipseRect.Top, EllipseRect.Right, EllipseRect.Bottom,
|
||
CoordX, CoordY, CoordX4, CoordY4);
|
||
end;
|
||
}
|
||
end;
|
||
PosX := Cur2DArcSegment.X;
|
||
PosY := Cur2DArcSegment.Y;
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
{Write(Format(' ***C%d,%d %d,%d %d,%d %d,%d',
|
||
[CoordToCanvasX(PosX), CoordToCanvasY(PosY),
|
||
CoordToCanvasX(Cur2DBSegment.X2), CoordToCanvasY(Cur2DBSegment.Y2),
|
||
CoordToCanvasX(Cur2DBSegment.X3), CoordToCanvasY(Cur2DBSegment.Y3),
|
||
CoordToCanvasX(Cur2DBSegment.X), CoordToCanvasY(Cur2DBSegment.Y)]));}
|
||
{$endif}
|
||
end;
|
||
end;
|
||
end;
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
WriteLn('');
|
||
{$endif}
|
||
|
||
// Draw polygon
|
||
if ADoDraw then begin
|
||
SetLength(lPoints, NumPoints);
|
||
if Length(lPoints) = 2 then
|
||
ADest.Line(lPoints[0].X, lPoints[0].Y, lPoints[1].X, lPoints[1].Y)
|
||
else
|
||
ADest.Polygon(lPoints);
|
||
end;
|
||
|
||
// Restores the previous Clip Region
|
||
{$ifdef USE_CANVAS_CLIP_REGION}
|
||
if ClipPath <> nil then
|
||
begin
|
||
SelectClipRgn(ACanvas.Handle, OldClipRegion); //Using OldClipRegion crashes in Qt
|
||
end;
|
||
{$endif}
|
||
end;
|
||
*)
|
||
|
||
procedure TPath.RenderInternalPolygon(constref ARenderInfo: TvRenderInfo);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
j: Integer;
|
||
CoordX, CoordY: Integer;
|
||
CurSegment: TPathSegment;
|
||
Cur2DSegment: T2DSegment absolute CurSegment;
|
||
Cur2DBSegment: T2DBezierSegment absolute CurSegment;
|
||
Cur2DArcSegment: T2DEllipticalArcSegment absolute CurSegment;
|
||
// For bezier
|
||
// For polygons
|
||
MultiPoints: array of array of TPoint;
|
||
lCurPoligon, lCurPoligonStartIndex: Integer;
|
||
begin
|
||
//
|
||
// For solid paths, draw a polygon for the main internal area
|
||
//
|
||
// If there is a move-to in the middle of the path, we should
|
||
// draw then multiple poligons
|
||
//
|
||
if Brush.Style <> bsClear then
|
||
begin
|
||
PrepareForSequentialReading;
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(' Solid Path Internal Area');
|
||
{$endif}
|
||
ADest.Brush.Style := Brush.Style;
|
||
ADest.Pen.Style := psClear;
|
||
|
||
SetLength(MultiPoints, 1);
|
||
SetLength(MultiPoints[0], Len);
|
||
lCurPoligon := 0;
|
||
lCurPoligonStartIndex := 0;
|
||
|
||
for j := 0 to Len - 1 do
|
||
begin
|
||
//WriteLn('j = ', j);
|
||
CurSegment := TPathSegment(Next());
|
||
|
||
if (j > 0) and (CurSegment.SegmentType = stMoveTo) then
|
||
begin
|
||
SetLength(MultiPoints[lCurPoligon], j-lCurPoligonStartIndex);
|
||
Inc(lCurPoligon);
|
||
SetLength(MultiPoints, lCurPoligon+1);
|
||
SetLength(MultiPoints[lCurPoligon], Len);
|
||
lCurPoligonStartIndex := j;
|
||
end;
|
||
|
||
CoordX := CoordToCanvasX(Cur2DSegment.X);
|
||
CoordY := CoordToCanvasY(Cur2DSegment.Y);
|
||
|
||
MultiPoints[lCurPoligon][j-lCurPoligonStartIndex].X := CoordX;
|
||
MultiPoints[lCurPoligon][j-lCurPoligonStartIndex].Y := CoordY;
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format(' P%d,%d', [CoordY, CoordY]));
|
||
{$endif}
|
||
end;
|
||
|
||
// Cut off excess from the last poligon
|
||
SetLength(MultiPoints[lCurPoligon], Len-lCurPoligonStartIndex);
|
||
|
||
// Draw each polygon now
|
||
for j := 0 to lCurPoligon do
|
||
begin
|
||
ADest.Polygon(MultiPoints[j]);
|
||
end;
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(' Now the details ');
|
||
{$endif}
|
||
end;
|
||
end;
|
||
|
||
function TPath.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
lCurPathSeg: TPathSegment;
|
||
begin
|
||
lStr := Format('[%s] Name=%s Pen.Color=%s Pen.Style=%s Brush.Color=%s Brush.Style=%s'
|
||
+ ' Brush.Kind=%s',
|
||
[Self.ClassName, Self.Name,
|
||
GenerateDebugStrForFPColor(Pen.Color),
|
||
GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style)),
|
||
GenerateDebugStrForFPColor(Brush.Color),
|
||
GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style)),
|
||
GetEnumName(TypeInfo(TvBrushKind), integer(Brush.Kind))
|
||
]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
// Add sub-entities
|
||
PrepareForSequentialReading();
|
||
lCurPathSeg := Next();
|
||
while lCurPathSeg <> nil do
|
||
begin
|
||
lCurPathSeg.GenerateDebugTree(ADestRoutine, Result);
|
||
lCurPathSeg := Next();
|
||
end;
|
||
end;
|
||
|
||
{ TvText }
|
||
|
||
function TvText.GetTextMetric_Descender_px(constref ARenderInfo: TvRenderInfo): Integer;
|
||
var
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ACanvas: TCanvas absolute ARenderInfo.Canvas;
|
||
tm: TLCLTextMetric;
|
||
{$else}
|
||
lFontSizePx: Double;
|
||
lTextSize: TSize;
|
||
{$endif}
|
||
begin
|
||
Result := 0;
|
||
|
||
{$IFDEF USE_LCL_CANVAS}
|
||
if ACanvas.GetTextMetrics(tm) then
|
||
Result := tm.Descender;
|
||
{$ELSE}
|
||
lFontSizePx := Font.Size; // is without multiplier!
|
||
if lFontSizePx = 0 then lFontSizePx := 10;
|
||
lTextSize := ARenderInfo.Canvas.TextExtent(Str_Line_Height_Tester);
|
||
Result := Round((lTextSize.CY*1.0 - lFontSizePx) * 0.5); // rough estimate only
|
||
{$ENDIF}
|
||
end;
|
||
|
||
constructor TvText.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
Value := TStringList.Create;
|
||
Value.Options := Value.Options - [soTrailingLineBreak];
|
||
Font.Color := colBlack;
|
||
end;
|
||
|
||
destructor TvText.Destroy;
|
||
begin
|
||
Value.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvText.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
|
||
var
|
||
lProximityFactor: Integer;
|
||
begin
|
||
lProximityFactor := ASnapFlexibility;
|
||
if (APos.X > X - lProximityFactor) and (APos.X < X + lProximityFactor)
|
||
and (APos.Y > Y - lProximityFactor) and (APos.Y < Y + lProximityFactor) then
|
||
Result := vfrFound
|
||
else Result := vfrNotFound;
|
||
end;
|
||
|
||
procedure TvText.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
i: Integer;
|
||
lSize: TSize;
|
||
lWidth, lHeight: Integer;
|
||
lRenderInfo: TvRenderInfo;
|
||
lText: String;
|
||
begin
|
||
//lText := Value.Text; // For debugging
|
||
lRenderInfo := Default(TvRenderInfo);
|
||
InitializeRenderInfo(lRenderInfo, Self);
|
||
lRenderInfo.Canvas := ARenderInfo.Canvas;
|
||
lRenderInfo.DestX := ARenderInfo.DestX;
|
||
lRenderInfo.DestY := ARenderInfo.DestY;
|
||
lRenderInfo.MulX := ARenderInfo.MulX;
|
||
lRenderInfo.MulY := ARenderInfo.MulY;
|
||
inherited Render(lRenderInfo, False);
|
||
|
||
ALeft := X;
|
||
ATop := Y;
|
||
lWidth := 0;
|
||
lHeight := 0;
|
||
ARight := ALeft;
|
||
ABottom := ATop;
|
||
if (ARenderInfo.Canvas = nil) then
|
||
Exit;
|
||
|
||
for i := 0 to Value.Count-1 do
|
||
begin
|
||
lText := Value.Strings[i];
|
||
lSize := lRenderInfo.Canvas.TextExtent(lText);
|
||
lWidth := Max(lWidth, lSize.cx);
|
||
lSize := lRenderInfo.Canvas.TextExtent(Str_Line_Height_Tester);
|
||
lHeight := lHeight + lSize.cy + 2;
|
||
end;
|
||
|
||
ALeft := X;
|
||
ATop := Y - lHeight;
|
||
ARight := ALeft + lWidth;
|
||
ABottom := Y;
|
||
end;
|
||
|
||
{ (X, Y) are the fpvectorial coordinatex of the left edge of the BASELINE (!)
|
||
of the first character box.
|
||
The character is painted, however, relative to the TOP/left corner of the
|
||
character box, in pixels. }
|
||
procedure TvText.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
const
|
||
LINE_SPACING = 0.2; // fraction of font height for line spacing
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
i: Integer;
|
||
//
|
||
pt, refPt: TPoint;
|
||
LowerDimY, UpperDimY, CurDimY: Double;
|
||
XAnchorAdjustment: Integer;
|
||
lLongestLine, lLineWidth, lFontDescenderPx: Integer;
|
||
lFontSizePx: Double;
|
||
lText: string;
|
||
lDescender: Integer;
|
||
phi: Double;
|
||
lTextSize: TSize;
|
||
lTextWidth: Integer;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
|
||
// Don't draw anything if we have alpha=zero
|
||
if Font.Color.Alpha = 0 then Exit;
|
||
ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
|
||
|
||
// Font metric
|
||
lFontSizePx := Font.Size; // is without multiplier!
|
||
if lFontSizePx = 0 then lFontSizePx := 10;
|
||
lTextSize := ADest.TextExtent(Str_Line_Height_Tester);
|
||
lDescender := GetTextMetric_Descender_px(ARenderInfo);
|
||
|
||
// Angle of text rotation
|
||
phi := -DegToRad(Font.Orientation);
|
||
|
||
// Reference point of the entity (X,Y) in pixels
|
||
// rotation center in case of rotated text
|
||
refPt := Point(
|
||
round(CoordToCanvasX(X, ADestX, AMulX)),
|
||
round(CoordToCanvasY(Y, ADestY, AMulY))
|
||
);
|
||
|
||
// if an anchor is set, use it
|
||
// to do this, first search for the longest line
|
||
XAnchorAdjustment := 0;
|
||
if TextAnchor <> vtaStart then
|
||
begin
|
||
lLongestLine := 0;
|
||
for i := 0 to Value.Count - 1 do
|
||
begin
|
||
lLineWidth := ARenderInfo.Canvas.TextWidth(Value.Strings[i]); // contains multiplier
|
||
if lLineWidth > lLongestLine then
|
||
lLongestLine := lLineWidth;
|
||
end;
|
||
case TextAnchor of
|
||
vtaMiddle : XAnchorAdjustment := -lLongestLine div 2;
|
||
vtaEnd : XAnchorAdjustment := -lLongestLine;
|
||
end;
|
||
end;
|
||
|
||
// Begin first line at reference point and grow downwards.
|
||
// ...
|
||
// We need to keep the order of lines drawing correct regardless of
|
||
// the drawing direction
|
||
// Since we have pixels now we need not take care about whether
|
||
// Page.TopLeftCoordinates is active or not!
|
||
curDimY := refPt.Y - (lTextSize.CY - lDescender);
|
||
|
||
// TvText supports multiple lines
|
||
for i := 0 to Value.Count - 1 do
|
||
begin
|
||
lText := Value.Strings[i];
|
||
if not Render_Use_NextText_X then
|
||
Render_NextText_X := refPt.X + XAnchorAdjustment;
|
||
|
||
// Start point of text, rotated around the reference point
|
||
pt := Point(round(Render_NextText_X), round(curDimY)); // before rotation
|
||
pt := Rotate2dPoint(pt, refPt, -Phi); // after rotation
|
||
|
||
// Paint line
|
||
if ADoDraw then
|
||
begin
|
||
ADest.TextOut(pt.x, pt.y, lText);
|
||
end;
|
||
|
||
// Calc text boundaries respecting text rotation.
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
|
||
lTextSize := ARenderInfo.Canvas.TextExtent(lText);
|
||
lTextWidth := lTextSize.cx;
|
||
// Reserve vertical space for </br> and similar line ending constructs
|
||
if (lText = '') then
|
||
lTextSize.cy := ARenderInfo.Canvas.TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE);
|
||
// other end of the text
|
||
pt := Point(round(Render_NextText_X) + lTextWidth, round(curDimY) + lTextSize.cy );
|
||
pt := Rotate2dPoint(pt, refPt, -Phi);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
|
||
|
||
// Prepare next line
|
||
Render_NextText_X := Render_NextText_X + lTextWidth;
|
||
curDimY := IfThen(AMulY < 0,
|
||
curDimY - (lFontSizePx * (1 + LINE_SPACING) * AMulY),
|
||
curDimY + (lFontSizePx * (1 + LINE_SPACING) * AMulY));
|
||
// wp: isn't this the same as
|
||
// curDimY := curDimY + (lFontSizePx * (1 + LINE_SPACING) * abs(AMulY);
|
||
end;
|
||
end;
|
||
|
||
function TvText.GetEntityFeatures(constref ARenderInfo: TvRenderInfo): TvEntityFeatures;
|
||
var
|
||
ActualText: String;
|
||
lHeight_px: Integer = 0;
|
||
begin
|
||
// Calculate the total height
|
||
CalculateHeightInCanvas(ARenderInfo, lHeight_px);
|
||
Result.TotalHeight := lHeight_px;
|
||
|
||
Result.DrawsUpwardHeightAdjustment := 0;
|
||
if (not FPage.UseTopLeftCoordinates) then
|
||
Result.DrawsUpwardHeightAdjustment := lHeight_px;
|
||
|
||
Result.FirstLineHeight := 0;
|
||
if (Value.Count > 0) then
|
||
begin
|
||
ActualText := Value.Text;
|
||
Value.Text := Value.Strings[0];
|
||
CalculateHeightInCanvas(ARenderInfo, lHeight_px);
|
||
Result.FirstLineHeight := lHeight_px - GetTextMetric_Descender_px(ARenderInfo);
|
||
|
||
Value.Text := ActualText;
|
||
end;
|
||
Result.DrawsUpwards := True;
|
||
end;
|
||
|
||
function TvText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr, lValueStr: string;
|
||
begin
|
||
lValueStr := GenerateDebugStrForString(Value.Text);
|
||
lStr := Format('[%s] Name=%s X=%f Y=%f Text="%s" [.Font=>] Color=%s Size=%f Name=%s Orientation=%f Bold=%s Italic=%s Underline=%s StrikeThrough=%s TextAnchor=%s',
|
||
[
|
||
Self.ClassName, Name, X, Y, lValueStr,
|
||
GenerateDebugStrForFPColor(Font.Color),
|
||
Font.Size, Font.Name, Font.Orientation,
|
||
BoolToStr(Font.Bold),
|
||
BoolToStr(Font.Italic),
|
||
BoolToStr(Font.Underline),
|
||
BoolToStr(Font.StrikeThrough),
|
||
GetEnumName(TypeInfo(TvTextAnchor), integer(TextAnchor))
|
||
]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
// Add the style as a sub-item
|
||
if Style <> nil then
|
||
begin
|
||
Style.GenerateDebugTree(ADestRoutine, Result);
|
||
end;
|
||
end;
|
||
|
||
{ TvCurvedText }
|
||
|
||
procedure TvCurvedText.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
i, lCharLen: Integer;
|
||
lText, lUTF8Char: string;
|
||
lX, lY, lTangentAngle, lTextHeight: Double;
|
||
pt: TPoint;
|
||
//lLeft, lTop, lWidth, lHeight: Integer;
|
||
begin
|
||
inherited Render(ARenderInfo, False);
|
||
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
(*
|
||
if not ADoDraw then
|
||
begin
|
||
//Path.CalculateSizeInCanvas(ADest, lLeft, lTop, lWidth, lHeight);
|
||
Exit;
|
||
end; *)
|
||
|
||
// Don't draw anything if we have alpha=zero
|
||
if Font.Color.Alpha = 0 then Exit;
|
||
if Path = nil then Exit;
|
||
|
||
ADest.Font.FPColor := AdjustColorToBackground(Font.Color, ARenderInfo);
|
||
if Value.Count = 0 then Exit;
|
||
lText := Value.Strings[0];
|
||
Render_NextText_X := CoordToCanvasX(X, ADestX, AMulX);
|
||
|
||
Path.PrepareForWalking();
|
||
Path.NextWalk(0, lX, lY, lTangentAngle);
|
||
|
||
// render each character separately
|
||
for i := 0 to UTF8Length(lText)-1 do
|
||
begin
|
||
lUTF8Char := UTF8Copy(lText, i+1, 1);
|
||
ADest.Font.Orientation := Round(Math.radtodeg(lTangentAngle)*10);
|
||
|
||
// Without adjustment the text is down bellow the path, but we want it on top of it
|
||
{lTextHeight := Abs(AMulY) * ADest.TextHeight(lUTF8Char);
|
||
lX := lX - Sin(Pi / 2 - lTangentAngle) * lTextHeight;
|
||
lY := lY + Cos(Pi / 2 - lTangentAngle) * lTextHeight;}
|
||
|
||
pt := Point(CoordToCanvasX(lX, ADestX, AMulX), CoordToCanvasY(lY, ADestY, AMulY));
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, pt.x, pt.y);
|
||
|
||
if ADoDraw then
|
||
ADest.TextOut(pt.X, pt.Y, lUTF8Char);
|
||
|
||
lCharLen := ADest.TextWidth(lUTF8Char);
|
||
Path.NextWalk(lCharLen, lX, lY, lTangentAngle);
|
||
end;
|
||
end;
|
||
|
||
function TvCurvedText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
begin
|
||
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
if Path <> nil then
|
||
Path.GenerateDebugTree(ADestRoutine, Result);
|
||
end;
|
||
|
||
{ TvField }
|
||
|
||
constructor TvField.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
|
||
DateFormat := 'dd/MM/yyyy hh:mm:ss';
|
||
NumberFormat := vnfDecimal;
|
||
end;
|
||
|
||
{ TvCircle }
|
||
|
||
procedure TvCircle.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
begin
|
||
ALeft := X - Radius;
|
||
ARight := X + Radius;
|
||
ATop := Y - Radius * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
|
||
ABottom := Y + Radius * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
|
||
end;
|
||
|
||
function TvCircle.CreatePath: TPath;
|
||
begin
|
||
Result := TPath.Create(FPage);
|
||
Result.AppendMoveToSegment(X + Radius, Y);
|
||
Result.AppendEllipticalArcWithCenter(Radius, Radius, 0, X - Radius, Y, X, Y, true);
|
||
Result.AppendEllipticalArcWithCenter(Radius, Radius, 0, X + Radius, Y, X, Y, true);
|
||
end;
|
||
|
||
procedure TvCircle.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
x1, y1, x2, y2: Integer;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
x1 := CoordToCanvasX(X - Radius, ADestX, AMulX);
|
||
y1 := CoordToCanvasY(Y - Radius, ADestY, AMulY);
|
||
x2 := CoordToCanvasX(X + Radius, ADestX, AMulX);
|
||
y2 := CoordToCanvasY(Y + Radius, ADestY, AMulY);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
if Brush.Kind <> bkSimpleBrush then
|
||
// Draw gradient and border
|
||
DrawBrushGradient(ARenderInfo, x1, y1, x2, y2)
|
||
else
|
||
// Draw uniform fill and border
|
||
DrawBrush(ARenderInfo);
|
||
end;
|
||
end;
|
||
|
||
procedure TvCircle.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
ctr: T3dPoint;
|
||
begin
|
||
ctr := Rotate3dPointInXY(Make3dPoint(X,Y), ABase, -AAngle);
|
||
// use inverted angle due to sign convention in Rotate3DPointInXY
|
||
X := ctr.X;
|
||
Y := ctr.Y;
|
||
end;
|
||
|
||
{ TvCircularArc }
|
||
|
||
procedure TvCircularArc.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
FinalStartAngle, FinalEndAngle: double;
|
||
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
|
||
IntStartAngle, IntAngleLength, IntTmp: Integer;
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ALCLDest: TCanvas absolute ADest;
|
||
{$endif}
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
{$ifdef USE_LCL_CANVAS}
|
||
// ToDo: Consider a X axis inversion
|
||
// If the Y axis is inverted, then we need to mirror our angles as well
|
||
BoundsLeft := CoordToCanvasX(X - Radius);
|
||
BoundsTop := CoordToCanvasY(Y - Radius);
|
||
BoundsRight := CoordToCanvasX(X + Radius);
|
||
BoundsBottom := CoordToCanvasY(Y + Radius);
|
||
{if AMulY > 0 then
|
||
begin}
|
||
FinalStartAngle := StartAngle;
|
||
FinalEndAngle := EndAngle;
|
||
{end
|
||
else // AMulY is negative
|
||
begin
|
||
// Inverting the angles generates the correct result for Y axis inversion
|
||
if CurArc.EndAngle = 0 then FinalStartAngle := 0
|
||
else FinalStartAngle := 360 - 1* CurArc.EndAngle;
|
||
if CurArc.StartAngle = 0 then FinalEndAngle := 0
|
||
else FinalEndAngle := 360 - 1* CurArc.StartAngle;
|
||
end;}
|
||
IntStartAngle := Round(16*FinalStartAngle);
|
||
IntAngleLength := Round(16*(FinalEndAngle - FinalStartAngle));
|
||
// On Gtk2 and Carbon, the Left really needs to be to the Left of the Right position
|
||
// The same for the Top and Bottom
|
||
// On Windows it works fine either way
|
||
// On Gtk2 if the positions are inverted then the arcs are screwed up
|
||
// In Carbon if the positions are inverted, then the arc is inverted
|
||
if BoundsLeft > BoundsRight then
|
||
begin
|
||
IntTmp := BoundsLeft;
|
||
BoundsLeft := BoundsRight;
|
||
BoundsRight := IntTmp;
|
||
end;
|
||
if BoundsTop > BoundsBottom then
|
||
begin
|
||
IntTmp := BoundsTop;
|
||
BoundsTop := BoundsBottom;
|
||
BoundsBottom := IntTmp;
|
||
end;
|
||
// Arc(ALeft, ATop, ARight, ABottom, Angle16Deg, Angle16DegLength: Integer);
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
// WriteLn(Format('Drawing Arc Center=%f,%f Radius=%f StartAngle=%f AngleLength=%f',
|
||
// [CurArc.CenterX, CurArc.CenterY, CurArc.Radius, IntStartAngle/16, IntAngleLength/16]));
|
||
{$endif}
|
||
ALCLDest.Arc(
|
||
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom,
|
||
IntStartAngle, IntAngleLength
|
||
);
|
||
// Debug info
|
||
// {$define FPVECTORIALDEBUG}
|
||
// {$ifdef FPVECTORIALDEBUG}
|
||
// WriteLn(Format('Drawing Arc x1y1=%d,%d x2y2=%d,%d start=%d end=%d',
|
||
// [BoundsLeft, BoundsTop, BoundsRight, BoundsBottom, IntStartAngle, IntAngleLength]));
|
||
// {$endif}
|
||
{ ADest.TextOut(CoordToCanvasX(CurArc.CenterX), CoordToCanvasY(CurArc.CenterY),
|
||
Format('R=%d S=%d L=%d', [Round(CurArc.Radius*AMulX), Round(FinalStartAngle),
|
||
Abs(Round((FinalEndAngle - FinalStartAngle)))]));
|
||
ADest.Pen.Color := TColor($DDDDDD);
|
||
ADest.Rectangle(
|
||
BoundsLeft, BoundsTop, BoundsRight, BoundsBottom);
|
||
ADest.Pen.Color := clBlack;}
|
||
{$endif}
|
||
end;
|
||
|
||
{ TvEllipse }
|
||
|
||
function TvEllipse.CreatePath: TPath;
|
||
var
|
||
p1, p2: T2dPoint;
|
||
begin
|
||
Result := TPath.Create(FPage);
|
||
|
||
CalcEllipsePoint(0, HorzHalfAxis,VertHalfAxis, X,Y, Angle, p1.x, p1.y);
|
||
CalcEllipsePoint(pi, HorzHalfAxis,VertHalfAxis, X,Y, Angle, p2.x, p2.y);
|
||
|
||
Result.AppendMoveToSegment(p1.x, p1.y);
|
||
Result.AppendEllipticalArcWithCenter(HorzHalfAxis, VertHalfAxis, Angle, p2.x, p2.y, X, Y, false);
|
||
Result.AppendEllipticalArcWithCenter(HorzHalfAxis, VertHalfAxis, Angle, p1.x, p1.y, X, Y, false);
|
||
end;
|
||
|
||
// wp: no longer needed
|
||
function TvEllipse.GetLineIntersectionPoints(ACoord: Double; ACoordIsX: Boolean): TDoubleDynArray;
|
||
begin
|
||
SetLength(Result, 2);
|
||
// this is for axis-aligned ellipses
|
||
// (X-Xcenter)^2 / Rx^2 + (Y-Ycenter)^2 / Ry^2 <= 1
|
||
if ACoordIsX then
|
||
begin
|
||
// Y = sqrt( 1 - (X-Xcenter)^2 / Rx^2 ) * Ry + Ycenter
|
||
Result[0] := Max(0, 1-sqr(ACoord-X) / sqr(HorzHalfAxis));
|
||
Result[0] := sqrt(Result[0]) * VertHalfAxis + Y;
|
||
Result[1] := Max(0, 1-sqr(ACoord-X) / sqr(HorzHalfAxis));
|
||
Result[1] := -1 * sqrt(Result[1]) * VertHalfAxis + Y;
|
||
end
|
||
else
|
||
begin
|
||
Result[0] := Max(0, 1-sqr(ACoord-Y) / sqr(VertHalfAxis));
|
||
Result[0] := sqrt(Result[0]) * HorzHalfAxis + X;
|
||
Result[1] := Max(0, 1-sqr(ACoord-Y) / sqr(VertHalfAxis));
|
||
Result[1] := -1 * sqrt(Result[1]) * HorzHalfAxis + X;
|
||
end;
|
||
end;
|
||
|
||
function TvEllipse.TryToSelect(APos: TPoint; var ASubpart: Cardinal;
|
||
ASnapFlexibility: Integer): TvFindEntityResult;
|
||
begin
|
||
// this is for axis-aligned ellipses
|
||
// (X-Xcenter)^2 / Rx^2 + (Y-Ycenter)^2 / Ry^2 <= 1
|
||
Result := vfrNotFound;
|
||
//Result := vfrFound;
|
||
end;
|
||
|
||
procedure TvEllipse.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
t, tmp: Double;
|
||
begin
|
||
{ To calculate the bounding rectangle we can do this:
|
||
|
||
Ellipse equations:
|
||
You could try using the parametrized equations for an ellipse rotated by
|
||
an arbitrary angle:
|
||
|
||
x = cx + a*cos(t)*cos(Angle) - b*sin(t)*sin(Angle)
|
||
y = cy + b*sin(t)*cos(Angle) + a*cos(t)*sin(Angle)
|
||
|
||
You can then differentiate and solve for gradient = 0:
|
||
0 = dx/dt = -a*sin(t)*cos(Angle) - b*cos(t)*sin(Angle)
|
||
==> tan(t) = -b*tan(Angle)/a
|
||
==> t = arctan(-b*tan(Angle)/a)
|
||
==> left and right corner of bounding box
|
||
|
||
On the other axis:
|
||
0 = dy/dt = b*cos(t)*cos(Angle) - a*sin(t)*sin(Angle)
|
||
==> tan(t) = b*cot(Angle)/a
|
||
==> t = arctan(b*cot(Angle)/a)
|
||
==> top and bottom corner of bounding box
|
||
}
|
||
if Angle <> 0.0 then
|
||
begin
|
||
t := arctan(-VertHalfAxis*tan(Angle)/HorzHalfAxis);
|
||
tmp := abs(HorzHalfAxis*cos(t)*cos(Angle) - VertHalfAxis*sin(t)*sin(Angle));
|
||
ALeft := X - Round(tmp);
|
||
ARight := X + Round(tmp);
|
||
t := arctan(VertHalfAxis*cot(Angle) / HorzHalfAxis);
|
||
tmp := abs(VertHalfAxis*sin(t)*cos(Angle) + HorzHalfAxis*cos(t)*sin(Angle));
|
||
tmp := tmp * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
|
||
ATop := Y - Round(tmp);
|
||
ABottom := Y + Round(tmp);
|
||
end else
|
||
begin
|
||
ALeft := X - HorzHalfAxis;
|
||
ARight := X + HorzHalfAxis;
|
||
ATop := Y - VertHalfAxis * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
|
||
ABottom := Y + VertHalfAxis * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
|
||
end;
|
||
end;
|
||
|
||
procedure TvEllipse.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
x1, y1, x2, y2: Integer;
|
||
fx1, fx2, fy1, fy2: Double;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
CalculateBoundingBox(ARenderInfo, fx1, fy1, fx2, fy2);
|
||
x1 := CoordToCanvasX(fx1, ADestX, AMulX);
|
||
x2 := CoordToCanvasX(fx2, ADestX, AMulX);
|
||
y1 := CoordToCanvasY(fy1, ADestY, AMulY);
|
||
y2 := CoordToCanvasY(fy2, ADestY, AMulY);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
if Brush.Kind <> bkSimpleBrush then
|
||
// Draw gradient and border
|
||
DrawBrushGradient(ARenderInfo, x1, y1, x2, y2)
|
||
else
|
||
// Draw uniform fill and border
|
||
DrawBrush(ARenderInfo);
|
||
// ADest.Ellipse(x1, y1, x2, y2);
|
||
end;
|
||
end;
|
||
(*
|
||
procedure TvEllipse.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
|
||
ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
PointList: array[0..6] of TPoint;
|
||
f: TPoint;
|
||
dk, x1, x2, y1, y2: Integer;
|
||
fx1, fy1, fx2, fy2: Double;
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ALCLDest: TCanvas absolute ADest;
|
||
{$endif}
|
||
begin
|
||
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
|
||
CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
|
||
x1 := CoordToCanvasX(fx1);
|
||
x2 := CoordToCanvasX(fx2);
|
||
y1 := CoordToCanvasY(fy1);
|
||
y2 := CoordToCanvasY(fy2);
|
||
|
||
{$ifdef USE_LCL_CANVAS}
|
||
if Angle <> 0 then
|
||
begin
|
||
dk := Round(0.654 * Abs(y2-y1));
|
||
f.x := Round(X);
|
||
f.y := Round(Y - 1);
|
||
PointList[0] := Rotate2DPoint(Point(x1, f.y), f, Angle) ; // Startpoint
|
||
PointList[1] := Rotate2DPoint(Point(x1, f.y - dk), f, Angle);
|
||
//Controlpoint of Startpoint first part
|
||
PointList[2] := Rotate2DPoint(Point(x2- 1, f.y - dk), f, Angle);
|
||
//Controlpoint of secondpoint first part
|
||
PointList[3] := Rotate2DPoint(Point(x2 -1 , f.y), f, Angle);
|
||
// Firstpoint of secondpart
|
||
PointList[4] := Rotate2DPoint(Point(x2-1 , f.y + dk), f, Angle);
|
||
// Controllpoint of secondpart firstpoint
|
||
PointList[5] := Rotate2DPoint(Point(x1, f.y + dk), f, Angle);
|
||
// Conrollpoint of secondpart endpoint
|
||
PointList[6] := PointList[0]; // Endpoint of
|
||
// Back to the startpoint
|
||
if ADoDraw then
|
||
ALCLDest.PolyBezier(Pointlist[0]);
|
||
end
|
||
else
|
||
{$endif}
|
||
begin
|
||
if ADoDraw then ADest.Ellipse(x1, y1, x2, y2);
|
||
end;
|
||
// Apply brush gradient
|
||
if x1 > x2 then
|
||
begin
|
||
dk := x1;
|
||
x1 := x2;
|
||
x2 := dk;
|
||
end;
|
||
if y1 > y2 then
|
||
begin
|
||
dk := y1;
|
||
y1 := y2;
|
||
y2 := dk;
|
||
end;
|
||
DrawBrushGradient(ADest, ARenderInfo, x1, y1, x2, y2, ADestX, ADestY, AMulX, AMulY);
|
||
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
|
||
end; *)
|
||
|
||
procedure TvEllipse.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
ctr: T3dPoint;
|
||
begin
|
||
ctr := Rotate3dPointInXY(Make3dPoint(X,Y), ABase, -AAngle);
|
||
// use inverted angle due to sign convention in Rotate3DPointInXY
|
||
X := ctr.X;
|
||
Y := ctr.Y;
|
||
Angle := AAngle + Angle;
|
||
end;
|
||
|
||
|
||
{ TvRectangle }
|
||
|
||
procedure TvRectangle.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
pts: Array[0..3] of T3DPoint;
|
||
mx, mn: Double;
|
||
j: Integer;
|
||
begin
|
||
if Angle <> 0 then
|
||
begin
|
||
pts[0] := Make3dPoint(X, Y); // corner points, ignoring rounded corner!
|
||
pts[1] := Make3dPoint(X+CX, Y);
|
||
pts[2] := Make3dPoint(X+CX, Y-CY);
|
||
pts[3] := Make3dPoint(X, Y-CY);
|
||
for j:=0 to High(pts) do
|
||
pts[j] := Rotate3DPointInXY(pts[j], pts[0], -Angle); // left/top is rot center!
|
||
// Use inverted angle due to sign convention in Rotate3DPointInXY
|
||
ALeft := pts[0].x;
|
||
ARight := Pts[0].x;
|
||
mx := pts[0].y;
|
||
mn := pts[0].y;
|
||
for j:=1 to High(pts) do
|
||
begin
|
||
ALeft := Min(ALeft, pts[j].x);
|
||
ARight := Max(ARight, pts[j].x);
|
||
mx := Max(mx, pts[j].y);
|
||
mn := Min(mn, pts[j].y);
|
||
end;
|
||
if ARenderInfo.Page.UseTopLeftCoordinates then
|
||
begin
|
||
ATop := mn;
|
||
ABottom := mx;
|
||
end else
|
||
begin
|
||
ATop := mx;
|
||
ABottom := mn;
|
||
end;
|
||
end else
|
||
begin
|
||
ALeft := X;
|
||
ARight := X + CX;
|
||
ATop := Y;
|
||
ABottom := Y + CY * ARenderInfo.Page.GetTopLeftCoords_Adjustment;
|
||
end;
|
||
end;
|
||
|
||
function TvRectangle.CreatePath: TPath;
|
||
var
|
||
pts: T3dPointsArray = nil;
|
||
cc: T3dPointsArray = nil;
|
||
ctr: T3dPoint;
|
||
refPt: T3dPoint;
|
||
refPtRot: T3dPoint;
|
||
shift: T3dPoint;
|
||
j: Integer;
|
||
phi, lYAdj: Double;
|
||
begin
|
||
lYAdj := FPage.GetTopLeftCoords_Adjustment(); // top/left: +1, bottom/left: -1
|
||
|
||
if (RX > 0) and (RY > 0) then
|
||
begin
|
||
SetLength(pts, 9);
|
||
pts[0] := Make3dPoint(X, Y+lYAdj*RY); { 1 2 }
|
||
pts[1] := Make3dPoint(X+RX, Y); { 0,8 3 }
|
||
pts[2] := Make3dPoint(X+CX-RX, Y); { }
|
||
pts[3] := Make3dPoint(X+CX, Y+lYAdj*RY); { }
|
||
pts[4] := Make3dPoint(X+CX, Y+lYAdj*(CY-RY)); { 7 4 }
|
||
pts[5] := Make3dPoint(X+CX-RX, Y+lYAdj*CY); { 6 5 }
|
||
pts[6] := Make3dPoint(X+RX, Y+lYAdj*CY);
|
||
pts[7] := Make3dPoint(X, Y+lYAdj*(CY-RY));
|
||
pts[8] := Make3dPoint(X, Y+lYAdj*RY);
|
||
SetLength(cc, 4); // centers of the corner circles
|
||
cc[0] := Make3dPoint(pts[1].x, pts[0].y);
|
||
cc[1] := Make3dPoint(pts[2].x, pts[3].y);
|
||
cc[2] := Make3dPoint(pts[5].x, pts[4].y);
|
||
cc[3] := Make3dPoint(pts[6].x, pts[7].y);
|
||
end
|
||
else
|
||
begin
|
||
SetLength(pts, 5); { 0,4 1 }
|
||
pts[0] := Make3dPoint(X, Y); { }
|
||
pts[1] := Make3dPoint(X+CX, Y); { }
|
||
pts[2] := Make3dPoint(X+CX, Y+lYAdj*CY); { }
|
||
pts[3] := Make3dPoint(X, Y+lYAdj*CY); { }
|
||
pts[4] := Make3dPoint(X, Y); { 3 2 }
|
||
end;
|
||
|
||
// We first rotate around the center of the rectangle and then move the
|
||
// rectangle points by the difference vector between the new and old top/left
|
||
// corner point.
|
||
|
||
refPt := Make3dPoint(X, Y); // Top/left point
|
||
ctr := Make3DPoint(X+CX/2, Y+CY/2*lYAdj); // Rotation center = center of rect
|
||
phi := -Angle; // Angle must be inverted due to sign convention in Rotate3DPointInXY
|
||
|
||
// Perform the rotation
|
||
for j:=0 to High(pts) do
|
||
pts[j] := Rotate3DPointInXY(pts[j], ctr, phi);
|
||
for j := 0 to High(cc) do
|
||
cc[j] := Rotate3DPointInXY(cc[j], ctr, phi);
|
||
refPtRot := Rotate3DPointInXY(refPt, ctr, phi); // refPt after rotation
|
||
|
||
// Perform the translation so that the refPt is back at its original position.
|
||
shift := Make3dPoint(refPt.x - refPtRot.x, refPt.y - refPtRot.y);
|
||
for j := 0 to High(pts) do
|
||
pts[j] := Offset3dPoint(pts[j], shift);
|
||
for j := 0 to High(cc) do
|
||
cc[j] := Offset3dPoint(cc[j], shift);
|
||
|
||
// Now create the path from the rotated points
|
||
Result := TPath.Create(FPage);
|
||
if (RX > 0) and (RY > 0) then
|
||
begin
|
||
Result.AppendMoveToSegment(pts[0].x, pts[0].y);
|
||
Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[1].x, pts[1].y,
|
||
cc[0].x, cc[0].y, true);
|
||
// pts[1].x, pts[0].y, true);
|
||
Result.AppendLineToSegment(pts[2].x, pts[2].y);
|
||
Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[3].x, pts[3].y,
|
||
cc[1].x, cc[1].y, true);
|
||
// pts[2].x, pts[3].y, true);
|
||
Result.AppendLineToSegment(pts[4].x, pts[4].y);
|
||
Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[5].x, pts[5].y,
|
||
cc[2].x, cc[2].y, true);
|
||
//pts[5].x, pts[4].y, true);
|
||
Result.AppendLineToSegment(pts[6].x, pts[6].y);
|
||
Result.AppendEllipticalArcWithCenter(RX, RY, phi, pts[7].x, pts[7].y,
|
||
cc[3].x, cc[3].y, true);
|
||
// pts[6].x, pts[7].y, true);
|
||
Result.AppendLineToSegment(pts[8].x, pts[8].y);
|
||
end else
|
||
begin
|
||
Result.AppendMoveToSegment(pts[0].x, pts[0].y);
|
||
Result.AppendLineToSegment(pts[1].x, pts[1].y);
|
||
Result.AppendLineToSegment(pts[2].x, pts[2].y);
|
||
Result.AppendLineToSegment(pts[3].x, pts[3].y);
|
||
Result.AppendLineToSegment(pts[4].x, pts[4].y);
|
||
end;
|
||
end;
|
||
|
||
procedure TvRectangle.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
x1, y1, x2, y2: Integer;
|
||
fx1, fy1, fx2, fy2: Double; // left, top, right, bottom
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
CalculateBoundingBox(ARenderInfo, fx1, fy1, fx2, fy2);
|
||
x1 := CoordToCanvasX(fx1, ADestX, AMulX);
|
||
x2 := CoordToCanvasX(fx2, ADestX, AMulX);
|
||
y1 := CoordToCanvasY(fy1, ADestY, AMulY);
|
||
y2 := CoordToCanvasY(fy2, ADestY, AMulY);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
if Brush.Kind <> bkSimpleBrush then
|
||
// Draw gradient and border
|
||
DrawBrushGradient(ARenderInfo, x1, y1, x2, y2)
|
||
else
|
||
// Draw uniform fill and border
|
||
DrawBrush(ARenderInfo);
|
||
end;
|
||
end;
|
||
(*
|
||
procedure TvRectangle.Render(ADest: TFPCustomCanvas; var ARenderInfo: TvRenderInfo; ADestX: Integer;
|
||
ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean);
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
x1, x2, y1, y2: Integer;
|
||
fx1, fy1, fx2, fy2: Double;
|
||
begin
|
||
inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
|
||
CalculateBoundingBox(ADest, fx1, fy1, fx2, fy2);
|
||
x1 := CoordToCanvasX(fx1);
|
||
x2 := CoordToCanvasX(fx2);
|
||
y1 := CoordToCanvasY(fy1);
|
||
y2 := CoordToCanvasY(fy2);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
{$ifdef USE_LCL_CANVAS}
|
||
if (RX = 0) and (RY = 0) then
|
||
ADest.Rectangle(x1, y1, x2, y2)
|
||
else
|
||
LCLIntf.RoundRect(TCanvas(ADest).Handle, x1, y1, x2, y2, Round(rx), Round(ry));
|
||
{$else}
|
||
ADest.Rectangle(x1, y1, x2, y2)
|
||
{$endif}
|
||
end;
|
||
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
|
||
end; *)
|
||
|
||
procedure TvRectangle.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
ref: T3dPoint; // reference point of rectangle
|
||
begin
|
||
ref := Rotate3dPointInXY(Make3dPoint(X, Y), ABase, -AAngle);
|
||
X := ref.X;
|
||
Y := ref.Y;
|
||
Angle := AAngle + Angle;
|
||
end;
|
||
|
||
function TvRectangle.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
// Add the font debug info in a sub-item
|
||
lStr := Format('[TvRectangle] Text=%s CX=%f CY=%f CZ=%f RX=%f RY=%f',
|
||
[Text,
|
||
CX, CY, CZ,
|
||
RX, RY
|
||
]);
|
||
ADestRoutine(lStr, Result);
|
||
end;
|
||
|
||
{ TvPolygon }
|
||
|
||
procedure TvPolygon.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
inherited CalculateBoundingBox(ARenderInfo, ALeft, ATop, ARight, ABottom);
|
||
for i := 0 to Length(Points)-1 do
|
||
begin
|
||
ALeft := Min(ALeft, Points[i].X);
|
||
ARight := Max(ARight, Points[i].X);
|
||
if ARenderInfo.Page.UseTopLeftCoordinates then
|
||
begin
|
||
ATop := Min(ATop, Points[i].Y);
|
||
ABottom := Max(ABottom, Points[i].Y);
|
||
end else
|
||
begin
|
||
ATop := Max(ATop, Points[i].Y);
|
||
ABottom := Min(ABottom, Points[i].Y);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvPolygon.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
lPoints: array of TPoint = nil;
|
||
i: Integer;
|
||
x1, x2, y1, y2: Integer;
|
||
polystarts: TIntegerDynArray = nil;
|
||
lRect: TRect;
|
||
gv1, gv2: T2DPoint;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
x1 := MaxInt;
|
||
y1 := MaxInt;
|
||
x2 := -MaxInt;
|
||
y2 := -MaxInt;
|
||
SetLength(lPoints, Length(Points));
|
||
for i := 0 to High(Points) do
|
||
begin
|
||
lPoints[i].X := CoordToCanvasX(Points[i].X, ADestX, AMulX);
|
||
lPoints[i].Y := CoordToCanvasY(Points[i].Y, ADestY, AMulY);
|
||
x1 := min(x1, lPoints[i].X);
|
||
y1 := min(y1, lPoints[i].Y);
|
||
x2 := max(x2, lPoints[i].X);
|
||
y2 := max(y2, lPoints[i].Y);
|
||
end;
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo, x1, y1, x2, y2);
|
||
|
||
if ADoDraw then
|
||
if (Length(lPoints) > 2) then
|
||
begin
|
||
case Brush.Kind of
|
||
bkSimpleBrush:
|
||
// Fills the polygon and paints the border
|
||
{$IFDEF USE_LCL_CANVAS} // Respects winding rule
|
||
TCanvas(ADest).Polygon(lPoints, WindingRule = vcmNonZeroWindingRule);
|
||
{$ELSE}
|
||
ADest.Polygon(lPoints); // Winding rule not supported
|
||
{$ENDIF}
|
||
|
||
bkHorizontalGradient,
|
||
bkVerticalGradient,
|
||
bkOtherLinearGradient:
|
||
begin
|
||
// Border will be drawn later (gradient painting needs its own pen)
|
||
ADest.Pen.Style := psClear;
|
||
// Boundary rect of shape to be filled by a gradient
|
||
lRect := Rect(x1, y1, x2, y2);
|
||
// Calculate gradient vector
|
||
CalcGradientVector(gv1, gv2, lRect, ADestX, ADestY, AMulX, AMulY);
|
||
// Indexes where polygon starts: no multiple polygons here
|
||
SetLength(polyStarts, 1);
|
||
polyStarts[0] := 0;
|
||
// Draw the gradient
|
||
DrawPolygonBrushLinearGradient(ARenderInfo, lPoints, polyStarts, lRect, gv1, gv2);
|
||
// Draw border
|
||
DrawPolygonBorderOnly(ARenderInfo, lPoints);
|
||
end;
|
||
|
||
bkRadialGradient:
|
||
begin
|
||
// Boundary rect of shape to be filled by a gradient
|
||
lRect := Rect(x1, y1, x2, y2);
|
||
// Border will be drawn later (gradient painting needs its own pen)
|
||
ADest.Pen.Style := psClear;
|
||
// Draw the gradient
|
||
DrawPolygonBrushRadialGradient(ARenderInfo, lPoints, lRect);
|
||
// Draw border
|
||
DrawPolygonBorderOnly(ARenderInfo, lPoints);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvPolygon.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
ref: T3dPoint;
|
||
i: Integer;
|
||
begin
|
||
ref := Rotate3dPointInXY(Make3dPoint(X, Y), ABase, -AAngle);
|
||
X := ref.X;
|
||
Y := ref.Y;
|
||
for i := 0 to High(Points) do
|
||
Points[i] := Rotate3dPointInXY(Points[i], ABase, -AAngle);
|
||
end;
|
||
|
||
{ TvAlignedDimension }
|
||
|
||
procedure TvAlignedDimension.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
Points: array of TPoint;
|
||
UpperDim, LowerDim: T3DPoint;
|
||
txt: String;
|
||
begin
|
||
ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Pen.Width := 1;
|
||
ADest.Pen.Style := psSolid;
|
||
//
|
||
// Draws this shape:
|
||
// horizontal vertical
|
||
// ___
|
||
// | | or ---| X cm
|
||
// | --|
|
||
// Which marks the dimension
|
||
ADest.MoveTo(CoordToCanvasX(BaseRight.X), CoordToCanvasY(BaseRight.Y));
|
||
ADest.LineTo(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
|
||
ADest.LineTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
|
||
ADest.LineTo(CoordToCanvasX(BaseLeft.X), CoordToCanvasY(BaseLeft.Y));
|
||
// Now the arrows
|
||
// horizontal
|
||
SetLength(Points, 3);
|
||
if DimensionRight.Y = DimensionLeft.Y then
|
||
begin
|
||
ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Brush.Style := bsSolid;
|
||
// Left arrow
|
||
Points[0] := Point(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
|
||
Points[1] := Point(Points[0].X + 7, Points[0].Y - 3);
|
||
Points[2] := Point(Points[0].X + 7, Points[0].Y + 3);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, Points[0].X, Points[1].Y);
|
||
if ADoDraw then ADest.Polygon(Points);
|
||
// Right arrow
|
||
Points[0] := Point(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
|
||
Points[1] := Point(Points[0].X - 7, Points[0].Y - 3);
|
||
Points[2] := Point(Points[0].X - 7, Points[0].Y + 3);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, Points[0].X, Points[2].Y);
|
||
if ADoDraw then ADest.Polygon(Points);
|
||
ADest.Brush.Style := bsClear;
|
||
// Dimension text
|
||
LowerDim.X := DimensionRight.X-DimensionLeft.X;
|
||
ADest.Font.Size := 10;
|
||
ADest.Font.Orientation := 0;
|
||
ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
txt := Format('%.1f', [LowerDim.X]);
|
||
Points[0].X := CoordToCanvasX((DimensionLeft.X+DimensionRight.X)/2)-ADest.TextWidth(txt) div 2;
|
||
Points[0].Y := CoordToCanvasY(DimensionLeft.Y);
|
||
if ADoDraw then
|
||
ADest.TextOut(Points[0].X, Points[0].Y-Round(ADest.Font.Size*1.5), txt);
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
|
||
Points[0].X, Points[0].Y - round(ADest.Font.Size*1.5),
|
||
Points[0].X + ADest.TextWidth(txt), Points[0].Y);
|
||
end
|
||
else
|
||
begin
|
||
ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Brush.Style := bsSolid;
|
||
// There is no upper/lower preference for DimensionLeft/Right, so we need to check
|
||
if DimensionLeft.Y > DimensionRight.Y then
|
||
begin
|
||
UpperDim := DimensionLeft;
|
||
LowerDim := DimensionRight;
|
||
end
|
||
else
|
||
begin
|
||
UpperDim := DimensionRight;
|
||
LowerDim := DimensionLeft;
|
||
end;
|
||
// Upper arrow
|
||
Points[0] := Point(CoordToCanvasX(UpperDim.X), CoordToCanvasY(UpperDim.Y));
|
||
Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y - Round(AMulY*3));
|
||
Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y - Round(AMulY*3));
|
||
if ADoDraw then ADest.Polygon(Points);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, Points[1].X, Points[0].Y);
|
||
// Lower arrow
|
||
Points[0] := Point(CoordToCanvasX(LowerDim.X), CoordToCanvasY(LowerDim.Y));
|
||
Points[1] := Point(Points[0].X + Round(AMulX), Points[0].Y + Round(AMulY*3));
|
||
Points[2] := Point(Points[0].X - Round(AMulX), Points[0].Y + Round(AMulY*3));
|
||
if ADoDraw then ADest.Polygon(Points);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, Points[2].X, Points[0].Y);
|
||
ADest.Brush.Style := bsClear;
|
||
// Dimension text
|
||
LowerDim.Y := DimensionRight.Y-DimensionLeft.Y;
|
||
if LowerDim.Y < 0 then LowerDim.Y := -1 * LowerDim.Y;
|
||
ADest.Font.Size := 10;
|
||
ADest.Font.Orientation := 900;
|
||
ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
txt := Format('%.1f', [LowerDim.Y]);
|
||
Points[0].X := CoordToCanvasX(DimensionLeft.X);
|
||
Points[0].Y := CoordToCanvasY((DimensionLeft.Y+DimensionRight.Y)/2)
|
||
- sign(AMulY) * ADest.TextWidth(txt) div 2;
|
||
if ADoDraw then
|
||
ADest.TextOut(Points[0].X-Round(ADest.Font.Size*1.5), Points[0].Y, txt);
|
||
ADest.Font.Orientation := 0;
|
||
CalcEntityCanvasMinMaxXY_With2Points(ARenderInfo,
|
||
Points[0].X - Round(ADest.Font.Size*1.5), Points[0].Y,
|
||
Points[0].X, Points[0].Y + ADest.TextWidth(txt)
|
||
);
|
||
end;
|
||
SetLength(Points, 0);
|
||
|
||
{$IFDEF FPVECTORIAL_DEBUG_DIMENSIONS}
|
||
WriteLn(Format('[TvAlignedDimension.Render] BaseRightXY=%f | %f DimensionRightXY=%f | %f DimensionLeftXY=%f | %f',
|
||
[BaseRight.X, BaseRight.Y, DimensionRight.X, DimensionRight.Y, DimensionLeft.X, DimensionLeft.Y]));
|
||
{$ENDIF}
|
||
|
||
{ // Debug info
|
||
ADest.TextOut(CoordToCanvasX(CurDim.BaseRight.X), CoordToCanvasY(CurDim.BaseRight.Y), 'BR');
|
||
ADest.TextOut(CoordToCanvasX(CurDim.DimensionRight.X), CoordToCanvasY(CurDim.DimensionRight.Y), 'DR');
|
||
ADest.TextOut(CoordToCanvasX(CurDim.DimensionLeft.X), CoordToCanvasY(CurDim.DimensionLeft.Y), 'DL');
|
||
ADest.TextOut(CoordToCanvasX(CurDim.BaseLeft.X), CoordToCanvasY(CurDim.BaseLeft.Y), 'BL');}
|
||
end;
|
||
|
||
function TvAlignedDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
// Add the font debug info in a sub-item
|
||
lStr := Format('[TvAlignedDimension] BaseLeft=%f %f BaseRight=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
|
||
[BaseLeft.X, BaseLeft.Y,
|
||
BaseRight.X, BaseRight.Y,
|
||
DimensionLeft.X, DimensionLeft.Y,
|
||
DimensionRight.X, DimensionRight.Y
|
||
]);
|
||
ADestRoutine(lStr, Result);
|
||
end;
|
||
|
||
{ TvRadialDimension }
|
||
|
||
procedure TvRadialDimension.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
Points: array of TPoint;
|
||
lAngle, lRadius: Double;
|
||
begin
|
||
ADest.Pen.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Pen.Width := 1;
|
||
ADest.Pen.Style := psSolid;
|
||
|
||
// The size of the radius of the circle
|
||
lRadius := sqrt(sqr(Center.X - DimensionLeft.X) + sqr(Center.Y - DimensionLeft.Y));
|
||
// The angle to the first dimension
|
||
lAngle := arctan((DimensionLeft.Y - Center.Y) / (DimensionLeft.X - Center.X));
|
||
|
||
// Get an arrow in the right part of the circle
|
||
SetLength(Points, 3);
|
||
ADest.Brush.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Brush.Style := bsSolid;
|
||
Points[0] := Point(CoordToCanvasX(Center.X + lRadius), CoordToCanvasY(Center.Y));
|
||
Points[1] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y - lRadius*0.1));
|
||
Points[2] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y + lRadius*0.1));
|
||
// Now rotate it to the actual position
|
||
Points[0] := Rotate2DPoint(Points[0], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)), lAngle);
|
||
Points[1] := Rotate2DPoint(Points[1], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)), lAngle);
|
||
Points[2] := Rotate2DPoint(Points[2], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)), lAngle);
|
||
|
||
if ADoDraw then
|
||
begin
|
||
if not IsDiameter then
|
||
begin
|
||
// Basic line
|
||
ADest.MoveTo(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y));
|
||
ADest.LineTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
|
||
|
||
// Draw the arrow
|
||
ADest.Polygon(Points);
|
||
ADest.Brush.Style := bsClear;
|
||
|
||
// Dimension text
|
||
Points[0].X := CoordToCanvasX(Center.X);
|
||
Points[0].Y := CoordToCanvasY(Center.Y);
|
||
ADest.Font.Size := 10;
|
||
ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [lRadius]));
|
||
end
|
||
else
|
||
begin
|
||
// Basic line
|
||
ADest.MoveTo(CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
|
||
ADest.LineTo(CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
|
||
|
||
// Draw the first arrow
|
||
ADest.Polygon(Points);
|
||
ADest.Brush.Style := bsClear;
|
||
|
||
// And the second
|
||
Points[0] := Point(CoordToCanvasX(Center.X + lRadius), CoordToCanvasY(Center.Y));
|
||
Points[1] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y - lRadius*0.1));
|
||
Points[2] := Point(CoordToCanvasX(Center.X + lRadius*0.8), CoordToCanvasY(Center.Y + lRadius*0.1));
|
||
// Now rotate it to the actual position
|
||
Points[0] := Rotate2DPoint(Points[0], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)), lAngle + Pi);
|
||
Points[1] := Rotate2DPoint(Points[1], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)), lAngle + Pi);
|
||
Points[2] := Rotate2DPoint(Points[2], Point(CoordToCanvasX(Center.X), CoordToCanvasY(Center.Y)), lAngle + Pi);
|
||
//
|
||
ADest.Polygon(Points);
|
||
ADest.Brush.Style := bsClear;
|
||
|
||
// Dimension text
|
||
Points[0].X := CoordToCanvasX(Center.X);
|
||
Points[0].Y := CoordToCanvasY(Center.Y);
|
||
ADest.Font.Size := 10;
|
||
ADest.Font.FPColor := AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.TextOut(Points[0].X, Points[0].Y, Format('%.1f', [lRadius * 2]));
|
||
end;
|
||
end;
|
||
|
||
SetLength(Points, 0);
|
||
end;
|
||
|
||
function TvRadialDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr, lIsDiameterStr: string;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
// Add the font debug info in a sub-item
|
||
if IsDiameter then lIsDiameterStr := 'true' else lIsDiameterStr := 'false';
|
||
lStr := Format('[TvAlignedDimension] IsDiameter=%s Center=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
|
||
[lIsDiameterStr,
|
||
Center.X, Center.Y,
|
||
DimensionLeft.X, DimensionLeft.Y,
|
||
DimensionRight.X, DimensionRight.Y
|
||
]);
|
||
ADestRoutine(lStr, Result);
|
||
end;
|
||
|
||
{ TvArcDimension }
|
||
|
||
procedure TvArcDimension.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
Points: array of TPoint = nil;
|
||
lTriangleCenter, lTriangleCorner: T3DPoint;
|
||
txt: String;
|
||
begin
|
||
ADest.Pen.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Pen.Width := 1;
|
||
ADest.Pen.Style := psSolid;
|
||
|
||
// Debug lines
|
||
//ADest.Line(CoordToCanvasX(BaseLeft.X), CoordToCanvasY(BaseLeft.Y), CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
|
||
//ADest.Line(CoordToCanvasX(BaseRight.X), CoordToCanvasY(BaseRight.Y), CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y));
|
||
|
||
// Now the arc
|
||
if ADoDraw then
|
||
ARenderInfo.Canvas.Arc(
|
||
CoordToCanvasX(BaseLeft.X - ArcRadius), CoordToCanvasY(BaseLeft.Y - ArcRadius),
|
||
CoordToCanvasX(BaseLeft.X + ArcRadius), CoordToCanvasY(BaseLeft.Y + ArcRadius),
|
||
CoordToCanvasX(DimensionRight.X), CoordToCanvasY(DimensionRight.Y),
|
||
CoordToCanvasX(DimensionLeft.X), CoordToCanvasY(DimensionLeft.Y));
|
||
|
||
// Now the arrows
|
||
SetLength(Points, 3);
|
||
CalculateExtraArcInfo();
|
||
ADest.Brush.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
|
||
ADest.Brush.Style := bsSolid;
|
||
|
||
// Left Arrow
|
||
Points[0] := Point(CoordToCanvasX(ArcLeft.X), CoordToCanvasY(ArcLeft.Y));
|
||
lTriangleCenter.X := Cos(AngleLeft+Pi/2) * -(ArcRadius/10) + ArcLeft.X;
|
||
lTriangleCenter.Y := Sin(AngleLeft+Pi/2) * -(ArcRadius/10) + ArcLeft.Y;
|
||
lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcLeft, Pi * 10 / 180);
|
||
Points[1] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
|
||
lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcLeft, - Pi * 10 / 180);
|
||
Points[2] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
|
||
if ADoDraw then
|
||
ADest.Polygon(Points);
|
||
|
||
// Right Arrow
|
||
Points[0] := Point(CoordToCanvasX(ArcRight.X), CoordToCanvasY(ArcRight.Y));
|
||
lTriangleCenter.X := Cos(AngleRight+Pi/2) * (ArcRadius/10) + ArcRight.X;
|
||
lTriangleCenter.Y := Sin(AngleRight+Pi/2) * (ArcRadius/10) + ArcRight.Y;
|
||
lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcRight, Pi * 10 / 180);
|
||
Points[1] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
|
||
lTriangleCorner := Rotate3DPointInXY(lTriangleCenter, ArcRight, - Pi * 10 / 180);
|
||
Points[2] := Point(CoordToCanvasX(lTriangleCorner.X), CoordToCanvasY(lTriangleCorner.Y));
|
||
ADest.Polygon(Points);
|
||
if ADoDraw then
|
||
ADest.Brush.Style := bsClear;
|
||
|
||
// Dimension text
|
||
Points[0].X := CoordToCanvasX(TextPos.X);
|
||
Points[0].Y := CoordToCanvasY(TextPos.Y);
|
||
ADest.Font.Size := 10;
|
||
ADest.Font.Orientation := 0;
|
||
ADest.Font.FPColor := colYellow;//AdjustColorToBackground(colBlack, ARenderInfo);
|
||
txt := Format('%.1fº', [ArcValue]);
|
||
if ADoDraw then
|
||
ADest.TextOut(Points[0].X, Points[0].Y-Round(ADest.Font.Size*1.5), txt);
|
||
end;
|
||
|
||
procedure TvArcDimension.CalculateExtraArcInfo;
|
||
begin
|
||
// Line equation of the Left line
|
||
AngleLeft := arctan(Abs(BaseLeft.Y-DimensionLeft.Y)/Abs(BaseLeft.X-DimensionLeft.X));
|
||
if DimensionLeft.X<BaseLeft.X then AngleLeft := Pi-AngleLeft;
|
||
al := Tan(AngleLeft);
|
||
bl := BaseLeft.Y - al * BaseLeft.X;
|
||
|
||
// Line equation of the Right line
|
||
AngleRight := arctan(Abs(BaseRight.Y-DimensionRight.Y)/Abs(BaseRight.X-DimensionRight.X));
|
||
if DimensionRight.X<BaseRight.X then AngleRight := Pi-AngleRight;
|
||
ar := Tan(AngleRight);
|
||
br := BaseRight.Y - ar * BaseRight.X;
|
||
|
||
// The lines meet at the AngleBase
|
||
AngleBase.X := (bl - br) / (ar - al);
|
||
AngleBase.Y := al * AngleBase.X + bl;
|
||
|
||
// And also now the left and right points of the arc
|
||
ArcLeft.X := Cos(AngleLeft) * ArcRadius + AngleBase.X;
|
||
ArcLeft.Y := Sin(AngleLeft) * ArcRadius + AngleBase.Y;
|
||
ArcRight.X := Cos(AngleRight) * ArcRadius + AngleBase.X;
|
||
ArcRight.Y := Sin(AngleRight) * ArcRadius + AngleBase.Y;
|
||
end;
|
||
|
||
function TvArcDimension.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
// Add the font debug info in a sub-item
|
||
lStr := Format('[TvArcDimension] ArcValue=%f ArcRadius=%f TextPos=%f %f BaseLeft=%f %f BaseRight=%f %f DimensionLeft=%f %f DimensionRight=%f %f',
|
||
[ArcValue, ArcRadius,
|
||
TextPos.X, TextPos.Y,
|
||
BaseLeft.X, BaseLeft.Y,
|
||
BaseRight.X, BaseRight.Y,
|
||
DimensionLeft.X, DimensionLeft.Y,
|
||
DimensionRight.X, DimensionRight.Y
|
||
]);
|
||
ADestRoutine(lStr, Result);
|
||
end;
|
||
|
||
{ TvRasterImage }
|
||
|
||
destructor TvRasterImage.Destroy;
|
||
begin
|
||
if Assigned(RasterImage) then RasterImage.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvRasterImage.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
begin
|
||
ALeft := X;
|
||
ATop := Y;
|
||
ARight := X + Width;
|
||
ABottom := Y + Height;
|
||
end;
|
||
|
||
procedure TvRasterImage.CreateRGB888Image(AWidth, AHeight: Cardinal);
|
||
{$ifdef USE_LCL_CANVAS}
|
||
var
|
||
AImage: TLazIntfImage;
|
||
lRawImage: TRawImage;
|
||
{$endif}
|
||
begin
|
||
{$ifdef USE_LCL_CANVAS}
|
||
lRawImage.Init;
|
||
lRawImage.Description.Init_BPP24_R8G8B8_BIO_TTB(AWidth, AHeight);
|
||
lRawImage.CreateData(True);
|
||
AImage := TLazIntfImage.Create(AWidth, AHeight);
|
||
AImage.SetRawImage(lRawImage);
|
||
|
||
RasterImage := AImage;
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvRasterImage.CreateImageFromFile(AFilename: string);
|
||
{$ifdef USE_LCL_CANVAS}
|
||
var
|
||
AImage: TLazIntfImage;
|
||
lRawImage: TRawImage;
|
||
{$endif}
|
||
begin
|
||
{$ifdef USE_LCL_CANVAS}
|
||
lRawImage.Init;
|
||
lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
|
||
lRawImage.CreateData(false);
|
||
AImage := TLazIntfImage.Create(0,0);
|
||
AImage.SetRawImage(lRawImage);
|
||
AImage.LoadFromFile(AFilename);
|
||
|
||
RasterImage := AImage;
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvRasterImage.CreateImageFromStream(AStream: TStream; Handler:TFPCustomImageReader);
|
||
{$ifdef USE_LCL_CANVAS}
|
||
var
|
||
AImage: TLazIntfImage;
|
||
lRawImage: TRawImage;
|
||
{$endif}
|
||
begin
|
||
{$ifdef USE_LCL_CANVAS}
|
||
lRawImage.Init;
|
||
lRawImage.Description.Init_BPP32_A8R8G8B8_BIO_TTB(0,0);
|
||
lRawImage.CreateData(false);
|
||
AImage := TLazIntfImage.Create(0,0);
|
||
AImage.SetRawImage(lRawImage);
|
||
AImage.LoadFromStream(AStream, Handler);
|
||
|
||
RasterImage := AImage;
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvRasterImage.InitializeWithConvertionOf3DPointsToHeightMap(APage: TvVectorialPage; AWidth, AHeight: Integer);
|
||
var
|
||
lEntity: TvEntity;
|
||
i: Integer;
|
||
lPos: TPoint;
|
||
lValue: TFPColor;
|
||
PreviousValue: Word;
|
||
PreviousCount: Integer;
|
||
begin
|
||
lValue := colBlack;
|
||
|
||
// First setup the map and initialize it
|
||
if RasterImage <> nil then RasterImage.Free;
|
||
RasterImage := TFPMemoryImage.create(AWidth, AHeight);
|
||
|
||
// Now go through all points and attempt to fit them to our grid
|
||
for i := 0 to APage.GetEntitiesCount - 1 do
|
||
begin
|
||
lEntity := APage.GetEntity(i);
|
||
if lEntity is TvPoint then
|
||
begin
|
||
lPos.X := Round((lEntity.X - APage.MinX) * AWidth / (APage.MaxX - APage.MinX));
|
||
lPos.Y := Round((lEntity.Y - APage.MinY) * AHeight / (APage.MaxY - APage.MinY));
|
||
|
||
if lPos.X >= AWidth then lPos.X := AWidth-1;
|
||
if lPos.Y >= AHeight then lPos.Y := AHeight-1;
|
||
if lPos.X < 0 then lPos.X := 0;
|
||
if lPos.Y < 0 then lPos.Y := 0;
|
||
|
||
// Calculate the height of this point
|
||
PreviousValue := lValue.Red;
|
||
lValue.Red := Round((lEntity.Z - APage.MinZ) * $FFFF / (APage.MaxZ - APage.MinZ));
|
||
|
||
// And apply it as a fraction of the total number of points which fall in this square
|
||
// we store the number of points in the Alpha channel
|
||
PreviousCount := lValue.Alpha div $100;
|
||
lValue.Red := Round((PreviousCount * PreviousValue + lValue.Red) / (PreviousCount + 1));
|
||
|
||
lValue.Green := lValue.Red;
|
||
lValue.Blue := lValue.Red;
|
||
lValue.Alpha := lValue.Alpha + $100;
|
||
//lValue.alpha:=;
|
||
RasterImage.Colors[lPos.X, lPos.Y] := lValue;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvRasterImage.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
lFinalX, lFinalY, lFinalW, lFinalH: Integer;
|
||
{$ifdef USE_LCL_CANVAS}
|
||
lBitmap: TBitmap;
|
||
lMemoryStream: TMemoryStream;
|
||
lImageWriter: TFPWriterBMP;
|
||
{$endif}
|
||
begin
|
||
if (RasterImage = nil) then Exit;
|
||
if (RasterImage.Width = 0) or (RasterImage.Height = 0) then Exit;
|
||
|
||
lFinalX := CoordToCanvasX(X);
|
||
lFinalY := CoordToCanvasY(Y);
|
||
|
||
{$ifdef USE_LCL_CANVAS}
|
||
lBitmap := TBitmap.Create;
|
||
lMemoryStream := TMemoryStream.Create;
|
||
lImageWriter := TFPWriterBMP.Create;
|
||
try
|
||
// Previous try, but didn't work for some particular PNG images =(
|
||
// For example: qr_www_lazarus_freepascal_org.svg
|
||
// The image appeared corrupted in Qt, as if with wrong pixel format =(
|
||
// It also didn't work in Gtk at all due to not matching Gdk format =(
|
||
// But if it worked it would have been faster =)
|
||
// Old code:
|
||
// lBitmap.LoadFromIntfImage(TLazIntfImage(RasterImage));
|
||
// New code:
|
||
RasterImage.SaveToStream(lMemoryStream, lImageWriter);
|
||
lMemoryStream.Position := 0;
|
||
lBitmap.LoadFromStream(lMemoryStream);
|
||
|
||
// without stretch support
|
||
//TCanvas(ADest).Draw(lFinalX, lFinalY, lBitmap);
|
||
|
||
// with stretch support
|
||
lFinalW := Round(Width * AMulX);
|
||
if lFinalW < 0 then lFinalW := lFinalW * -1;
|
||
lFinalH := Round(Height * AMulY);
|
||
if lFinalH < 0 then lFinalH := lFinalH * -1;
|
||
if ADoDraw then
|
||
TCanvas(ADest).StretchDraw(Bounds(lFinalX, lFinalY, lFinalW, lFinalH), lBitmap);
|
||
finally
|
||
lImageWriter.Free;
|
||
lMemoryStream.Free;
|
||
lBitmap.Free;
|
||
end;
|
||
{$endif}
|
||
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, lFinalX, lFinalY);
|
||
CalcEntityCanvasMinMaxXY(ARenderInfo, lFinalX+lFinalW, lFinalY+lFinalH);
|
||
|
||
//ADest.Draw(lFinalX, lFinalY, RasterImage); doesnt work
|
||
end;
|
||
|
||
function TvRasterImage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
begin
|
||
Result := inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
// Add the debug info in a sub-item
|
||
if RasterImage <> nil then
|
||
begin
|
||
lStr := Format('[TvRasterImage] Width=%f Height=%f RasterImage.Width=%d RasterImage.Height=%d AltText=%s',
|
||
[Width, Height, RasterImage.Width, RasterImage.Height, AltText]);
|
||
ADestRoutine(lStr, Result);
|
||
end;
|
||
end;
|
||
|
||
{ TvArrow }
|
||
|
||
procedure TvArrow.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo; out
|
||
ALeft, ATop, ARight, ABottom: Double);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvArrow.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
lArrow, lBase, lExtraBase: TPoint;
|
||
lPointD, lPointE, lPointF: T3DPoint;
|
||
lPoints: array[0..2] of TPoint;
|
||
AlfaAngle: Double;
|
||
begin
|
||
ApplyPenToCanvas(ARenderInfo);
|
||
ApplyBrushToCanvas(ARenderInfo);
|
||
|
||
lArrow.X := CoordToCanvasX(X);
|
||
lArrow.Y := CoordToCanvasY(Y);
|
||
lBase.X := CoordToCanvasX(Base.X);
|
||
lBase.Y := CoordToCanvasY(Base.Y);
|
||
lExtraBase.X := CoordToCanvasX(ExtraLineBase.X);
|
||
lExtraBase.Y := CoordToCanvasY(ExtraLineBase.Y);
|
||
|
||
// Start with the lines
|
||
|
||
ADest.Line(lArrow, lBase);
|
||
|
||
if HasExtraLine then
|
||
ADest.Line(lBase, lExtraBase);
|
||
|
||
// Now draw the arrow head
|
||
lPoints[0].X := CoordToCanvasX(X);
|
||
lPoints[0].Y := CoordToCanvasY(Y);
|
||
//
|
||
// Here a lot of trigonometry comes to play, it is hard to explain in text, but in essence
|
||
//
|
||
// A line L is formed by the points A (Arrow head) and B (Base)
|
||
// Our smaller triangle starts at a point D in this line which has length ArrowLength counting from A
|
||
// This forms a rectangle triangle with a line paralel to the X axis
|
||
// Alfa is the angle between A and the line parallel to the X axis
|
||
//
|
||
// This brings this equations:
|
||
// AlfaAngle := arctg((B.Y - A.Y) / (B.X - A.X));
|
||
// Sin(Alfa) := (D.Y - A.Y) / ArrowLength
|
||
// Cos(Alfa) := (D.X - A.X) / ArrowLength
|
||
//
|
||
// Then at this point D we start a line perpendicular to the line L
|
||
// And with this line we progress a length of ArrowBaseLength/2
|
||
// This line, the D point and a line parallel to the Y axis for another
|
||
// rectangle triangle with the same Alfa angle at the point D
|
||
// The point at the end of the hipotenuse of this triangle is our point E
|
||
// So we have more equations:
|
||
//
|
||
// Sin(Alfa) := (E.x - D.X) / (ArrowBaseLength/2)
|
||
// Cos(Alfa) := (E.Y - D.Y) / (ArrowBaseLength/2)
|
||
//
|
||
// And the same in the opposite direction for our point F:
|
||
//
|
||
// Sin(Alfa) := (D.X - F.X) / (ArrowBaseLength/2)
|
||
// Cos(Alfa) := (D.Y - F.Y) / (ArrowBaseLength/2)
|
||
//
|
||
if (Base.X - X) = 0 then
|
||
AlfaAngle := 0
|
||
else
|
||
AlfaAngle := ArcTan((Base.Y - Y) / (Base.X - X));
|
||
lPointD.Y := Sin(AlfaAngle) * ArrowLength + Y;
|
||
lPointD.X := Cos(AlfaAngle) * ArrowLength + X;
|
||
lPointE.X := Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
|
||
lPointE.Y := Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
|
||
lPointF.X := - Sin(AlfaAngle) * (ArrowBaseLength/2) + lPointD.X;
|
||
lPointF.Y := - Cos(AlfaAngle) * (ArrowBaseLength/2) + lPointD.Y;
|
||
lPoints[1].X := CoordToCanvasX(lPointE.X);
|
||
lPoints[1].Y := CoordToCanvasY(lPointE.Y);
|
||
lPoints[2].X := CoordToCanvasX(lPointF.X);
|
||
lPoints[2].Y := CoordToCanvasY(lPointF.Y);
|
||
if ADoDraw then ADest.Polygon(lPoints);
|
||
end;
|
||
|
||
{ TvFormulaElement }
|
||
|
||
function TvFormulaElement.CalculateHeight(ADest: TFPCustomCanvas): Double;
|
||
var
|
||
lLineHeight: Integer;
|
||
begin
|
||
if ADest <> nil then
|
||
lLineHeight := ADest.TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE) + 2
|
||
else
|
||
lLineHeight := 15;
|
||
|
||
case Kind of
|
||
//fekVariable, // Text is the text of the variable
|
||
//fekEqual, // = symbol
|
||
//fekSubtraction, // - symbol
|
||
//fekMultiplication, // either a point . or a small x
|
||
//fekSum, // + symbol
|
||
//fekPlusMinus, // The +/- symbol
|
||
fekHorizontalLine: Result := 5;
|
||
fekFraction:
|
||
begin
|
||
Formula.CalculateHeight(ADest);
|
||
AdjacentFormula.CalculateHeight(ADest);
|
||
Result := Formula.Height + AdjacentFormula.Height * 1.2;
|
||
end;
|
||
fekRoot: Result := Formula.CalculateHeight(ADest) * 1.2;
|
||
fekPower: Result := lLineHeight * 1.2;
|
||
fekSummation: Result := lLineHeight * 1.5;
|
||
fekFormula: Result := Formula.CalculateHeight(ADest);
|
||
else
|
||
Result := lLineHeight;
|
||
end;
|
||
|
||
Height := Result;
|
||
end;
|
||
|
||
function TvFormulaElement.CalculateWidth(ADest: TFPCustomCanvas): Double;
|
||
var
|
||
lText: String;
|
||
begin
|
||
Result := 0;
|
||
|
||
lText := AsText;
|
||
if lText <> '' then
|
||
begin
|
||
if ADest = nil then Result := 10 * UTF8Length(lText)
|
||
else Result := ADest.TextWidth(lText);
|
||
end;
|
||
|
||
case Kind of
|
||
fekMultiplication: Result := 0;
|
||
fekHorizontalLine: Result := 25;
|
||
//
|
||
fekFraction:
|
||
begin
|
||
Formula.CalculateWidth(ADest);
|
||
AdjacentFormula.CalculateWidth(ADest);
|
||
Result := Max(Formula.Width, AdjacentFormula.Width);
|
||
end;
|
||
fekRoot: Result := Formula.CalculateWidth(ADest) + 10;
|
||
fekPower, fekSubscript:
|
||
begin
|
||
Result := Formula.CalculateWidth(ADest) +
|
||
AdjacentFormula.CalculateWidth(ADest) / 2;
|
||
end;
|
||
fekSummation: Result := 8;
|
||
fekFormula: Result := Formula.CalculateWidth(ADest);
|
||
else
|
||
end;
|
||
|
||
Width := Result;
|
||
end;
|
||
|
||
function TvFormulaElement.AsText: string;
|
||
begin
|
||
case Kind of
|
||
fekVariable: Result := Text;
|
||
fekEqual: Result := '=';
|
||
fekSubtraction: Result := '-';
|
||
fekMultiplication: Result := 'x';
|
||
fekSum: Result := '+';
|
||
fekPlusMinus: Result := '+/-';
|
||
fekLessThan: Result := '<';
|
||
fekLessOrEqualThan: Result := '<=';
|
||
fekGreaterThan: Result := '>';
|
||
fekGreaterOrEqualThan: Result := '>=';
|
||
fekHorizontalLine: Result := '=';
|
||
// More complex elements
|
||
else
|
||
Result := Format('[%s]', [GetEnumName(TypeInfo(TvFormulaElementKind), integer(Kind))]);
|
||
end;
|
||
end;
|
||
|
||
procedure TvFormulaElement.PositionSubparts(constref ARenderInfo: TvRenderInfo;
|
||
ABaseX, ABaseY: Double);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
lCentralizeFactor: Double = 0;
|
||
lCentralizeFactorAdj: Double = 0;
|
||
begin
|
||
case Self.Kind of
|
||
fekFraction:
|
||
begin
|
||
// Check which fraction is the largest and centralize the other one
|
||
Self.Formula.CalculateWidth(ADest);
|
||
Self.AdjacentFormula.CalculateWidth(ADest);
|
||
if Self.Formula.Width > Self.AdjacentFormula.Width then
|
||
begin
|
||
lCentralizeFactor := 0;
|
||
lCentralizeFactorAdj := Self.Formula.Width / 2 - Self.AdjacentFormula.Width / 2;
|
||
end
|
||
else
|
||
begin
|
||
lCentralizeFactor := Self.AdjacentFormula.Width / 2 - Self.Formula.Width / 2;
|
||
lCentralizeFactorAdj := 0;
|
||
end;
|
||
|
||
Self.Formula.PositionSubparts(ARenderInfo, Self.Left + lCentralizeFactor, Self.Top);
|
||
Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left + lCentralizeFactorAdj, Self.Top - Self.Formula.Height - 3);
|
||
end;
|
||
fekRoot:
|
||
begin
|
||
// Give a factor for the root drawing
|
||
Self.Formula.PositionSubparts(ARenderInfo, Self.Left + 10, Self.Top);
|
||
end;
|
||
fekPower:
|
||
begin
|
||
Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
|
||
Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left + Self.Formula.Width, Self.Top);
|
||
end;
|
||
fekSubscript:
|
||
begin
|
||
Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
|
||
Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left + Self.Formula.Width, Self.Top - Self.Formula.Height / 2);
|
||
end;
|
||
fekSummation:
|
||
begin
|
||
// main/bottom formula
|
||
Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top - 30);
|
||
// top formula
|
||
Self.AdjacentFormula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
|
||
end;
|
||
fekFormula:
|
||
begin
|
||
Self.Formula.PositionSubparts(ARenderInfo, Self.Left, Self.Top);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvFormulaElement.Render(var ARenderInfo: TvRenderInfo;
|
||
ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
LeftC, TopC: Integer;
|
||
lPt: array[0..3] of TPoint;
|
||
lOldFontSize: Double;
|
||
lStr: string;
|
||
begin
|
||
LeftC := CoordToCanvasX(Left);
|
||
TopC := CoordToCanvasY(Top);
|
||
|
||
if ADoDraw then
|
||
case Kind of
|
||
fekVariable: ADest.TextOut(LeftC, TopC, Text);
|
||
fekEqual: ADest.TextOut(LeftC, TopC, '=');
|
||
fekSubtraction: ADest.TextOut(LeftC, TopC, '-');
|
||
fekMultiplication:
|
||
begin
|
||
// Don't draw anything, leave an empty space, it looks better
|
||
//ADest.TextOut(LeftC, TopC, 'x'); // × -> Unicode times symbol
|
||
end;
|
||
fekSum: ADest.TextOut(LeftC, TopC, '+');
|
||
fekPlusMinus:ADest.TextOut(LeftC, TopC, '±');
|
||
fekLessThan: ADest.TextOut(LeftC, TopC, '<');
|
||
fekLessOrEqualThan: ADest.TextOut(LeftC, TopC, '≤');
|
||
fekGreaterThan: ADest.TextOut(LeftC, TopC, '>');
|
||
fekGreaterOrEqualThan: ADest.TextOut(LeftC, TopC, '≥');
|
||
fekHorizontalLine: ADest.Line(LeftC, TopC, CoordToCanvasX(Left+Width), TopC);
|
||
// Complex ones
|
||
fekFraction:
|
||
begin
|
||
Formula.Render(ARenderInfo, ADoDraw);
|
||
AdjacentFormula.Render(ARenderInfo, ADoDraw);
|
||
|
||
// Division line
|
||
lPt[0].X := CoordToCanvasX(Formula.Left);
|
||
lPt[1].X := CoordToCanvasX(Formula.Left + Formula.Width);
|
||
lPt[0].Y := CoordToCanvasY(Formula.Top - Formula.Height);
|
||
lPt[1].Y := CoordToCanvasY(Formula.Top - Formula.Height);
|
||
ADest.Line(lPt[0].X, lPt[0].Y, lPt[1].X, lPt[1].Y);
|
||
end;
|
||
fekRoot:
|
||
begin
|
||
Formula.Render(ARenderInfo, ADoDraw);
|
||
|
||
// Root drawing
|
||
lPt[0].X := CoordToCanvasX(Left);
|
||
lPt[0].Y := CoordToCanvasY(Top - Formula.Height * 0.7 + 5);
|
||
// diagonal down
|
||
lPt[1].X := CoordToCanvasX(Left + 5);
|
||
lPt[1].Y := CoordToCanvasY(Top - Formula.Height * 0.7);
|
||
// up
|
||
lPt[2].X := CoordToCanvasX(Left + 5);
|
||
lPt[2].Y := CoordToCanvasY(Top);
|
||
// straight right
|
||
lPt[3].X := CoordToCanvasX(Left + Formula.Width);
|
||
lPt[3].Y := CoordToCanvasY(Top);
|
||
//
|
||
ADest.Polyline(lPt);
|
||
end;
|
||
fekPower:
|
||
begin
|
||
Formula.Render(ARenderInfo, ADoDraw);
|
||
// The superscripted power
|
||
lOldFontSize := ADest.Font.Size;
|
||
if lOldFontSize = 0 then ADest.Font.Size := 5
|
||
else ADest.Font.Size := Round(lOldFontSize * 0.5);
|
||
AdjacentFormula.Render(ARenderInfo, ADoDraw);
|
||
ADest.Font.Size := Round(lOldFontSize);
|
||
end;
|
||
fekSubscript:
|
||
begin
|
||
Formula.Render(ARenderInfo, ADoDraw);
|
||
// The subscripted item
|
||
lOldFontSize := ADest.Font.Size;
|
||
if lOldFontSize = 0 then ADest.Font.Size := 5
|
||
else ADest.Font.Size := Round(lOldFontSize * 0.5);
|
||
AdjacentFormula.Render(ARenderInfo, ADoDraw);
|
||
ADest.Font.Size := Round(lOldFontSize);
|
||
end;
|
||
fekSummation:
|
||
begin
|
||
// Draw the summation symbol
|
||
lOldFontSize := ADest.Font.Size;
|
||
ADest.Font.Size := 15;
|
||
lStr := #$E2#$88#$91; // Unicode Character 'N-ARY SUMMATION' (U+2211)
|
||
ADest.TextOut(LeftC, TopC, lStr);
|
||
ADest.Font.Size := Round(lOldFontSize);
|
||
|
||
// Draw the bottom/main formula
|
||
Formula.Render(ARenderInfo, ADoDraw);
|
||
|
||
// Draw the top formula
|
||
AdjacentFormula.Render(ARenderInfo, ADoDraw);
|
||
end;
|
||
fekFormula:
|
||
begin
|
||
// Draw the formula
|
||
Formula.Render(ARenderInfo, ADoDraw);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvFormulaElement.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer);
|
||
var
|
||
lDBGItem, lDBGFormula, lDBGFormulaBottom: Pointer;
|
||
lStr: string;
|
||
begin
|
||
lStr := Format('%s [%s]', [Self.AsText(), GetEnumName(TypeInfo(TvFormulaElementKind), integer(Kind))]);
|
||
lStr := lStr + Format(' Left=%f Top=%f Width=%f Height=%f', [Left, Top, Width, Height]);
|
||
lDBGItem := ADestRoutine(lStr, APageItem);
|
||
|
||
case Kind of
|
||
fekFraction, fekPower, fekSubscript, fekSummation:
|
||
begin
|
||
lDBGFormula := ADestRoutine('Main Formula', lDBGItem);
|
||
Formula.GenerateDebugTree(ADestRoutine, lDBGFormula);
|
||
if Kind in [fekPower, fekSummation] then
|
||
lDBGFormulaBottom := ADestRoutine('Top Formula', lDBGItem)
|
||
else
|
||
lDBGFormulaBottom := ADestRoutine('Bottom Formula', lDBGItem);
|
||
AdjacentFormula.GenerateDebugTree(ADestRoutine, lDBGFormulaBottom);
|
||
end;
|
||
fekRoot: Formula.GenerateDebugTree(ADestRoutine, lDBGItem);
|
||
//fekSomatory: Result := 1.5;
|
||
fekFormula: Formula.GenerateDebugTree(ADestRoutine, lDBGItem);
|
||
end;
|
||
end;
|
||
|
||
// http://en.wikipedia.org/wiki/Shunting-yard_algorithm
|
||
class function TvFormulaElement.GetPrecedenceFromKind(
|
||
AKind: TvFormulaElementKind): Byte;
|
||
begin
|
||
Result := 0;
|
||
case AKind of
|
||
fekSubtraction, fekSum: Result := 2;
|
||
fekMultiplication, fekFraction: Result := 3;
|
||
//fekRoot, // A root. For example sqrt(something). Number gives the root, usually 2, and inside it goes a Formula
|
||
fekPower: Result := 4;
|
||
end;
|
||
end;
|
||
|
||
// See http://en.wikipedia.org/wiki/Shunting-yard_algorithm
|
||
class function TvFormulaElement.IsLeftAssociativeFromKind(
|
||
AKind: TvFormulaElementKind): Boolean;
|
||
begin
|
||
Result := True;
|
||
case AKind of
|
||
fekPower: Result := False;
|
||
end;
|
||
end;
|
||
|
||
{ TvFormula }
|
||
|
||
procedure TvFormula.CallbackDeleteElement(data, arg: pointer);
|
||
begin
|
||
TvFormulaElement(data).Free;
|
||
end;
|
||
|
||
constructor TvFormula.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
FElements := TFPList.Create;
|
||
SpacingBetweenElementsX := 5;
|
||
SpacingBetweenElementsY := 1; // elements already give a fair amount of vertical spacing in their own area
|
||
end;
|
||
|
||
destructor TvFormula.Destroy;
|
||
begin
|
||
FElements.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvFormula.GetFirstElement: TvFormulaElement;
|
||
begin
|
||
if FElements.Count = 0 then Exit(nil);
|
||
Result := TvFormulaElement(FElements.Items[0]);
|
||
FCurIndex := 1;
|
||
end;
|
||
|
||
function TvFormula.GetNextElement: TvFormulaElement;
|
||
begin
|
||
if FElements.Count <= FCurIndex then Exit(nil);
|
||
Result := TvFormulaElement(FElements.Items[FCurIndex]);
|
||
Inc(FCurIndex);
|
||
end;
|
||
|
||
procedure TvFormula.AddElement(AElement: TvFormulaElement);
|
||
begin
|
||
FElements.Add(AElement);
|
||
end;
|
||
|
||
function TvFormula.AddElementWithKind(AKind: TvFormulaElementKind): TvFormulaElement;
|
||
begin
|
||
Result := AddElementWithKindAndText(AKind, '');
|
||
end;
|
||
|
||
function TvFormula.AddElementWithKindAndText(AKind: TvFormulaElementKind;
|
||
AText: string): TvFormulaElement;
|
||
begin
|
||
Result := TvFormulaElement.Create;
|
||
Result.Kind := AKind;
|
||
Result.Text := AText;
|
||
AddElement(Result);
|
||
|
||
case AKind of
|
||
fekFraction, fekPower, fekSubscript, fekSummation:
|
||
begin
|
||
Result.Formula := TvFormula.Create(FPage);
|
||
Result.AdjacentFormula := TvFormula.Create(FPage);
|
||
end;
|
||
fekRoot:
|
||
begin
|
||
Result.Formula := TvFormula.Create(FPage);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
// Based on:
|
||
// http://en.wikipedia.org/wiki/Shunting-yard_algorithm
|
||
procedure TvFormula.AddItemsByConvertingInfixToRPN(AInfix: TFPList);
|
||
var
|
||
OperatorStack: TObjectStack;
|
||
i: Integer;
|
||
CurItem: TvFormulaElement;
|
||
|
||
procedure PopFromStackIntoList(APopTopOperators: Boolean; APopUntilParenteses: Boolean);
|
||
var
|
||
lElement: TvFormulaElement;
|
||
lAllowContinue: Boolean;
|
||
begin
|
||
while OperatorStack.Count > 0 do
|
||
begin
|
||
lElement := OperatorStack.Pop() as TvFormulaElement;
|
||
|
||
// while there is an operator token, o2, at the top of the stack, and
|
||
// either o1 is left-associative and its precedence is equal to that of o2,
|
||
// or o1 has precedence less than that of o2,
|
||
if APopTopOperators then
|
||
begin
|
||
if not (lElement.Kind in FormulaOperators) then Exit;
|
||
|
||
lAllowContinue := TvFormulaElement.IsLeftAssociativeFromKind(lElement.Kind)
|
||
and (TvFormulaElement.GetPrecedenceFromKind(lElement.Kind) =
|
||
TvFormulaElement.GetPrecedenceFromKind(CurItem.Kind));
|
||
lAllowContinue := lAllowContinue or
|
||
(TvFormulaElement.GetPrecedenceFromKind(lElement.Kind) >
|
||
TvFormulaElement.GetPrecedenceFromKind(CurItem.Kind));
|
||
if not lAllowContinue then Exit;
|
||
end;
|
||
|
||
if APopUntilParenteses and (lElement.Kind = fekParentesesOpen) then Exit;
|
||
|
||
FElements.Add(lElement);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
Clear();
|
||
|
||
OperatorStack := TObjectStack.Create;
|
||
try
|
||
for i := 0 to AInfix.Count-1 do
|
||
begin
|
||
CurItem := TvFormulaElement(AInfix.Items[i]);
|
||
case CurItem.Kind of
|
||
fekVariable:
|
||
begin
|
||
FElements.Add(CurItem);
|
||
end;
|
||
fekSubtraction, fekMultiplication, fekSum, fekFraction:
|
||
begin
|
||
PopFromStackIntoList(True, False);
|
||
OperatorStack.Push(CurItem);
|
||
end;
|
||
fekParentesesOpen:
|
||
begin
|
||
OperatorStack.Push(CurItem);
|
||
end;
|
||
freParentesesClose:
|
||
begin
|
||
PopFromStackIntoList(False, True);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
PopFromStackIntoList(True, False);
|
||
finally
|
||
OperatorStack.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvFormula.AddItemsByConvertingInfixStringToRPN(AStr: string);
|
||
var
|
||
lInfix: TFPList;
|
||
begin
|
||
lInfix := TFPList.Create;
|
||
try
|
||
TokenizeInfixString(AStr, lInfix);
|
||
AddItemsByConvertingInfixToRPN(lInfix);
|
||
finally
|
||
lInfix.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvFormula.TokenizeInfixString(AStr: string; AOutput: TFPList);
|
||
const
|
||
Str_Space: Char = ' ';
|
||
|
||
procedure AddToken(AStr: string);
|
||
var
|
||
lToken: TvFormulaElement;
|
||
lStr: string;
|
||
FPointSeparator: TFormatSettings;
|
||
begin
|
||
FPointSeparator := DefaultFormatSettings;
|
||
FPointSeparator.DecimalSeparator := '.';
|
||
FPointSeparator.ThousandSeparator := '#';// disable the thousand separator
|
||
|
||
lStr := Trim(AStr);
|
||
if lStr = '' then Exit;
|
||
|
||
lToken := TvFormulaElement.Create;
|
||
|
||
// Moves
|
||
case lStr[1] of
|
||
'*': lToken.Kind := fekMultiplication;
|
||
'/': lToken.Kind := fekFraction;
|
||
'+': lToken.Kind := fekSum;
|
||
'-': lToken.Kind := fekSubtraction;
|
||
'(': lToken.Kind := fekParentesesOpen;
|
||
')': lToken.Kind := freParentesesClose;
|
||
else
|
||
lToken.Kind := fekVariable;
|
||
lToken.Number := StrToFloat(AStr, FPointSeparator);
|
||
end;
|
||
|
||
AOutput.Add(lToken);
|
||
end;
|
||
|
||
var
|
||
i: Integer;
|
||
lTmpStr: string = '';
|
||
lState: Integer;
|
||
lCurChar: Char;
|
||
begin
|
||
lState := 0;
|
||
|
||
i := 1;
|
||
while i <= Length(AStr) do
|
||
begin
|
||
case lState of
|
||
0: // Adding to the tmp string
|
||
begin
|
||
lCurChar := AStr[i];
|
||
if lCurChar = Str_Space then
|
||
begin
|
||
//lState := 1;
|
||
AddToken(lTmpStr);
|
||
lTmpStr := '';
|
||
end
|
||
else if lCurChar in ['/', '*', '+', '-', '(', ')'] then
|
||
begin
|
||
if lTmpStr <> '' then AddToken(lTmpStr);
|
||
lTmpStr := '';
|
||
lState := 0;
|
||
AddToken(lCurChar);
|
||
end
|
||
else
|
||
begin
|
||
lTmpStr := lTmpStr + lCurChar;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Inc(i);
|
||
end;
|
||
|
||
// If there is a token still to be added, add it now
|
||
if (lState = 0) and (lTmpStr <> '') then AddToken(lTmpStr);
|
||
end;
|
||
|
||
// The formula must be in RPN for this to work
|
||
function TvFormula.CalculateRPNFormulaValue: Double;
|
||
var
|
||
lOperand_A, lOperand_B, CurElement: TvFormulaElement;
|
||
i: Integer;
|
||
begin
|
||
lOperand_A := nil;
|
||
lOperand_B := nil;
|
||
Result := 0;
|
||
for i := 0 to FElements.Count-1 do
|
||
begin
|
||
CurElement := TvFormulaElement(FElements.Items[i]);
|
||
case CurElement.Kind of
|
||
fekVariable:
|
||
begin
|
||
if lOperand_A = nil then lOperand_A := CurElement
|
||
else lOperand_B := CurElement;
|
||
end;
|
||
fekSubtraction:
|
||
begin
|
||
lOperand_A.Number := lOperand_A.Number - lOperand_B.Number;
|
||
lOperand_B := nil;
|
||
end;
|
||
fekMultiplication:
|
||
begin
|
||
lOperand_A.Number := lOperand_A.Number * lOperand_B.Number;
|
||
lOperand_B := nil;
|
||
end;
|
||
fekSum:
|
||
begin
|
||
lOperand_A.Number := lOperand_A.Number + lOperand_B.Number;
|
||
lOperand_B := nil;
|
||
end;
|
||
fekFraction:
|
||
begin
|
||
lOperand_A.Number := lOperand_A.Number / lOperand_B.Number;
|
||
lOperand_B := nil;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Result := lOperand_A.Number;
|
||
end;
|
||
|
||
procedure TvFormula.Clear;
|
||
begin
|
||
inherited Clear;
|
||
FElements.ForEachCall(@CallbackDeleteElement, nil);
|
||
FElements.Clear;
|
||
end;
|
||
|
||
function TvFormula.CalculateHeight(ADest: TFPCustomCanvas): Double;
|
||
var
|
||
lElement: TvFormulaElement;
|
||
begin
|
||
if ADest <> nil then
|
||
Result := ADest.TextHeight(STR_FPVECTORIAL_TEXT_HEIGHT_SAMPLE) + 2
|
||
else
|
||
Result := 15;
|
||
|
||
lElement := GetFirstElement();
|
||
while lElement <> nil do
|
||
begin
|
||
Result := Max(Result, lElement.CalculateHeight(ADest));
|
||
lElement := GetNextElement;
|
||
end;
|
||
|
||
// Cache the result
|
||
Height := Result;
|
||
end;
|
||
|
||
function TvFormula.CalculateWidth(ADest: TFPCustomCanvas): Double;
|
||
var
|
||
lElement: TvFormulaElement;
|
||
begin
|
||
Result := 0;
|
||
lElement := GetFirstElement();
|
||
while lElement <> nil do
|
||
begin
|
||
if lElement.Kind <> fekMultiplication then
|
||
Result := Result + lElement.CalculateWidth(ADest) + SpacingBetweenElementsX;
|
||
lElement := GetNextElement;
|
||
end;
|
||
// Remove an extra spacing, since it is added even to the last item
|
||
Result := Result - SpacingBetweenElementsX;
|
||
// Cache the result
|
||
Width := Result;
|
||
end;
|
||
|
||
procedure TvFormula.PositionSubparts(constref ARenderInfo: TvRenderInfo;
|
||
ABaseX, ABaseY: Double);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
//
|
||
lElement: TvFormulaElement;
|
||
lPosX: Double = 0;
|
||
lMaxHeight: Double = 0;
|
||
begin
|
||
CalculateHeight(ADest);
|
||
CalculateWidth(ADest);
|
||
Left := ABaseX;
|
||
Top := ABaseY;
|
||
|
||
// Then calculate the position of each element
|
||
lElement := GetFirstElement();
|
||
if lElement = nil then Exit;
|
||
while lElement <> nil do
|
||
begin
|
||
lElement.Left := Left + lPosX;
|
||
lPosX := lPosX + lElement.Width + SpacingBetweenElementsX;
|
||
lElement.Top := Top;
|
||
lMaxHeight := Max(lMaxHeight, lElement.Height);
|
||
|
||
lElement.PositionSubparts(ARenderInfo, ABaseX, ABaseY);
|
||
|
||
lElement := GetNextElement();
|
||
end;
|
||
|
||
// Go back and make a second loop to
|
||
// check if there are any high elements in the same line,
|
||
// and if yes, centralize the smaller ones
|
||
lElement := GetFirstElement();
|
||
if lElement = nil then Exit;
|
||
while lElement <> nil do
|
||
begin
|
||
if lElement.Height < lMaxHeight then
|
||
begin
|
||
lElement.Top := Top - lMaxHeight / 2 + lElement.Height / 2;
|
||
end;
|
||
|
||
lElement := GetNextElement();
|
||
end;
|
||
end;
|
||
|
||
procedure TvFormula.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
begin
|
||
ALeft := X;
|
||
ATop := Y;
|
||
ARight := CalculateWidth(ADest);
|
||
if ADest = nil then
|
||
ABottom := CalculateHeight(ADest) * 15
|
||
else
|
||
ABottom := CalculateHeight(ADest) * ADest.TextHeight('Źç');
|
||
ARight := X + ARight;
|
||
ABottom := Y + ABottom;
|
||
end;
|
||
|
||
procedure TvFormula.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
lElement: TvFormulaElement;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
|
||
// First position all elements
|
||
PositionSubparts(ARenderInfo, Left, Top);
|
||
|
||
// Now draw them all
|
||
lElement := GetFirstElement();
|
||
if lElement = nil then Exit;
|
||
while lElement <> nil do
|
||
begin
|
||
lElement.Render(ARenderInfo, ADoDraw);
|
||
|
||
lElement := GetNextElement();
|
||
end;
|
||
end;
|
||
|
||
function TvFormula.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
var
|
||
lFormulaElement: TvFormulaElement;
|
||
lStr: string;
|
||
begin
|
||
lStr := Format('[%s]', [Self.ClassName]);
|
||
lStr := lStr + Format(' Left=%f Top=%f Width=%f Height=%f', [Left, Top, Width, Height]);
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
|
||
lFormulaElement := GetFirstElement();
|
||
while lFormulaElement <> nil do
|
||
begin
|
||
lFormulaElement.GenerateDebugTree(ADestRoutine, Result);
|
||
|
||
lFormulaElement := GetNextElement()
|
||
end;
|
||
end;
|
||
|
||
{ TvEntityWithSubEntities }
|
||
|
||
procedure TvEntityWithSubEntities.CallbackDeleteElement(data, arg: pointer);
|
||
begin
|
||
TvEntity(data).Free;
|
||
end;
|
||
|
||
constructor TvEntityWithSubEntities.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
FElements := TFPList.Create;
|
||
end;
|
||
|
||
destructor TvEntityWithSubEntities.Destroy;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i:= FElements.Count-1 downto 0 do
|
||
TvEntity(FElements[i]).Free;
|
||
FElements.Free;
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.GetFirstEntity: TvEntity;
|
||
begin
|
||
if FElements.Count = 0 then Exit(nil);
|
||
Result := TvEntity(FElements.Items[0]);
|
||
FCurIndex := 1;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.GetNextEntity: TvEntity;
|
||
begin
|
||
if FElements.Count <= FCurIndex then Exit(nil);
|
||
Result := TvEntity(FElements.Items[FCurIndex]);
|
||
Inc(FCurIndex);
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.GetEntitiesCount: Integer;
|
||
begin
|
||
Result := FElements.Count;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.GetEntity(AIndex: Integer): TvEntity;
|
||
begin
|
||
Result := TvEntity(FElements.Items[AIndex]);
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.AddEntity(AEntity: TvEntity): Integer;
|
||
begin
|
||
//AEntity.Parent := Self;
|
||
AEntity.SetPage(Self.FPage);
|
||
Result := FElements.Add(AEntity);
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.GetEntityIndex(AEntity: TvEntity): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to FElements.Count-1 do
|
||
if TvEntity(FElements.Items[i]) = AEntity then Exit(i);
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.DeleteEntity(AIndex: Cardinal): Boolean;
|
||
var
|
||
lEntity: TvEntity;
|
||
begin
|
||
lEntity := TvEntity(FElements.Items[AIndex]);
|
||
FElements.Remove(lEntity);
|
||
lEntity.Free;
|
||
Result := True;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.RemoveEntity(AEntity: TvEntity;
|
||
AFreeAfterRemove: Boolean): Boolean;
|
||
var
|
||
lIndex: Integer;
|
||
begin
|
||
Result := False;
|
||
lIndex := FindEntityWithReference(AEntity);
|
||
if lIndex < 0 then Exit;
|
||
if AFreeAfterRemove then DeleteEntity(lIndex)
|
||
else FElements.Remove(AEntity);
|
||
Result := True;
|
||
end;
|
||
|
||
procedure TvEntityWithSubEntities.Rotate(AAngle: Double; ABase: T3DPoint);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i := 0 to FElements.Count-1 do
|
||
begin
|
||
TvEntity(FElements.Items[i]).Rotate(AAngle, ABase);
|
||
end;
|
||
end;
|
||
|
||
procedure TvEntityWithSubEntities.Clear;
|
||
begin
|
||
inherited Clear;
|
||
FElements.ForEachCall(@CallbackDeleteElement, nil);
|
||
FElements.Clear;
|
||
end;
|
||
|
||
procedure TvEntityWithSubEntities.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
lEntity: TvEntity;
|
||
rinfo: TvRenderInfo;
|
||
isFirst: Boolean;
|
||
begin
|
||
rinfo := ARenderInfo;
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
isFirst := true;
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
{$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
|
||
//WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
|
||
// [Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
|
||
{$ENDIF}
|
||
|
||
// Render
|
||
lEntity.Render(ARenderInfo, ADoDraw);
|
||
|
||
if isFirst then
|
||
begin
|
||
rinfo := ARenderInfo;
|
||
isFirst := false;
|
||
end else
|
||
CalcEntityCanvasMinMaxXY_With2Points(rinfo,
|
||
ARenderInfo.EntityCanvasMinXY.X,
|
||
ARenderInfo.EntityCanvasMinXY.Y,
|
||
ARenderInfo.EntityCanvasMaxXY.X,
|
||
ARenderInfo.EntityCanvasMaxXY.Y
|
||
);
|
||
|
||
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
|
||
if AutoFitDebug <> nil then AutoFitDebug.Add(Format('=[%s] MinX=%d MinY=%d MaxX=%d MaxY=%d',
|
||
[lEntity.ClassName, ARenderInfo.EntityCanvasMinXY.X, ARenderInfo.EntityCanvasMinXY.Y,
|
||
ARenderInfo.EntityCanvasMaxXY.X, ARenderInfo.EntityCanvasMaxXY.Y]));
|
||
{$endif}
|
||
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
|
||
ARenderInfo := rinfo;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.GenerateDebugTree(
|
||
ADestRoutine: TvDebugAddItemProc; APageItem: Pointer): Pointer;
|
||
var
|
||
lStr: string;
|
||
lCurEntity: TvEntity;
|
||
begin
|
||
lStr := Format('[%s] Name="%s" X=%f Y=%f' + FExtraDebugStr,
|
||
[Self.ClassName, Self.Name, X, Y]);
|
||
|
||
// Add styles
|
||
// Pen
|
||
if spbfPenColor in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Pen.Color=%s', [GenerateDebugStrForFPColor(Pen.Color)]);
|
||
if spbfPenStyle in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Pen.Style=%s', [GetEnumName(TypeInfo(TFPPenStyle), integer(Pen.Style))]);
|
||
if spbfPenWidth in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Pen.Width=%d', [Pen.Width]);
|
||
// Brush
|
||
if spbfBrushColor in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Brush.Color=%s', [GenerateDebugStrForFPColor(Brush.Color)]);
|
||
if spbfBrushStyle in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Brush.Style=%s', [GetEnumName(TypeInfo(TFPBrushStyle), integer(Brush.Style))]);
|
||
// Font
|
||
if spbfFontColor in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Font.Color=%s', [GenerateDebugStrForFPColor(Font.Color)]);
|
||
if spbfFontSize in SetPenBrushAndFontElements then
|
||
lStr := lStr + Format(' Font.Size=%f', [Font.Size]);
|
||
|
||
Result := ADestRoutine(lStr, APageItem);
|
||
|
||
// Add sub-entities
|
||
lCurEntity := GetFirstEntity();
|
||
while lCurEntity <> nil do
|
||
begin
|
||
lCurEntity.GenerateDebugTree(ADestRoutine, Result);
|
||
lCurEntity := GetNextEntity();
|
||
end;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.FindEntityWithReference(AEntity: TvEntity
|
||
): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to FElements.Count - 1 do
|
||
begin
|
||
if TvEntity(FElements.Items[i]) = AEntity then Exit(i);
|
||
end;
|
||
end;
|
||
|
||
function TvEntityWithSubEntities.FindEntityWithNameAndType(AName: string;
|
||
AType: TvEntityClass; ARecursively: Boolean): TvEntity;
|
||
var
|
||
lCurEntity: TvEntity;
|
||
lCurName: String;
|
||
begin
|
||
Result := nil;
|
||
lCurEntity := GetFirstEntity();
|
||
while lCurEntity <> nil do
|
||
begin
|
||
if (lCurEntity is TvNamedEntity) then
|
||
lCurName := TvNamedEntity(lCurEntity).Name
|
||
else
|
||
lCurName := '';
|
||
|
||
if (lCurEntity is AType) and
|
||
(lCurEntity is TvNamedEntity) and (lCurName = AName) then
|
||
begin
|
||
Result := lCurEntity;
|
||
Exit;
|
||
end;
|
||
|
||
if ARecursively and (lCurEntity is TvEntityWithSubEntities) then
|
||
begin
|
||
Result := TvEntityWithSubEntities(lCurEntity).FindEntityWithNameAndType(AName, AType, True);
|
||
if Result <> nil then Exit;
|
||
end;
|
||
|
||
lCurEntity := GetNextEntity();
|
||
end;
|
||
end;
|
||
|
||
{ TvInsert }
|
||
|
||
constructor TvInsert.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
Style := TvStyle.Create;
|
||
end;
|
||
|
||
destructor TvInsert.Destroy;
|
||
begin
|
||
FreeAndNil(Style);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvInsert.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
OldForceRenderBlock: Boolean;
|
||
begin
|
||
inherited Render(ARenderInfo, ADoDraw);
|
||
if InsertEntity = nil then Exit;
|
||
// If we are inserting a block, make sure it will render its contents
|
||
OldForceRenderBlock := ARenderInfo.ForceRenderBlock;
|
||
ARenderInfo.ForceRenderBlock := True;
|
||
// If necessary rotate the canvas
|
||
if RotationAngle <> 0 then
|
||
begin
|
||
InsertEntity.Rotate(RotationAngle, Make3DPoint(0, 0));
|
||
end;
|
||
// Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
|
||
InsertEntity.Move(X, Y);
|
||
Style.ApplyOverFromPen(@Pen, SetElements);
|
||
Style.ApplyOverFromBrush(@Brush, SetElements);
|
||
Style.ApplyOverFromFont(@Font, SetElements);
|
||
Style.ApplyIntoEntity(InsertEntity);
|
||
// Render
|
||
InsertEntity.Render(ARenderInfo, ADoDraw);
|
||
// Change them back
|
||
InsertEntity.Move(-X, -Y);
|
||
// And unrotate it back again
|
||
if RotationAngle <> 0 then
|
||
begin
|
||
InsertEntity.Rotate(-1 * RotationAngle, Make3DPoint(0, 0));
|
||
end;
|
||
ARenderInfo.ForceRenderBlock := OldForceRenderBlock;
|
||
end;
|
||
|
||
function TvInsert.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
begin
|
||
FExtraDebugStr := Format(' RotationAngle(degrees)=%f', [RotationAngle * 180 / Pi]);
|
||
if InsertEntity is TvNamedEntity then
|
||
FExtraDebugStr := FExtraDebugStr + Format(' InsertEntity="%s"', [TvNamedEntity(InsertEntity).Name]);
|
||
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
end;
|
||
|
||
{ TvBlock }
|
||
|
||
procedure TvBlock.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
lEntity: TvEntity;
|
||
begin
|
||
// blocks are invisible by themselves
|
||
//inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
if not ARenderInfo.ForceRenderBlock then Exit;
|
||
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
{$IFDEF FPVECTORIAL_DEBUG_BLOCKS}
|
||
WriteLn(Format('[TvInsert.Render] Name=%s Block=%s Entity=%s EntityXY=%f | %f BlockXY=%f | %f InsertXY=%f | %f',
|
||
[Name, Block.Name, lEntity.ClassName, lEntity.X, lEntity.Y, Block.X, Block.Y, X, Y]));
|
||
{$ENDIF}
|
||
|
||
// Alter the position of the elements to consider the positioning of the BLOCK and of the INSERT
|
||
lEntity.Move(X, Y);
|
||
// Render
|
||
lEntity.Render(ARenderInfo, ADoDraw);
|
||
// Change them back
|
||
lEntity.Move(-X, -Y);
|
||
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
end;
|
||
|
||
{ TvParagraph }
|
||
|
||
constructor TvParagraph.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
end;
|
||
|
||
destructor TvParagraph.Destroy;
|
||
begin
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvParagraph.AddText(AText: string): TvText;
|
||
begin
|
||
Result := TvText.Create(FPage);
|
||
Result.Value.Text := AText;
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvParagraph.AddCurvedText(AText: string): TvCurvedText;
|
||
begin
|
||
Result := TvCurvedText.Create(FPage);
|
||
Result.Value.Text := AText;
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvParagraph.AddField(AKind: TvFieldKind): TvField;
|
||
begin
|
||
Result := TvField.Create(FPage);
|
||
Result.Kind := AKind;
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvParagraph.AddRasterImage: TvRasterImage;
|
||
begin
|
||
Result := TvRasterImage.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvParagraph.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
|
||
begin
|
||
Result := TvEmbeddedVectorialDoc.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
procedure TvParagraph.CalculateBoundingBox(constref ARenderInfo: TvRenderInfo;
|
||
out ALeft, ATop, ARight, ABottom: Double);
|
||
var
|
||
lEntity: TvEntity;
|
||
lCurWidth: Double = 0.0;
|
||
lCurHeight: Double = 0.0;
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
lText: TvText absolute lEntity;
|
||
{$ifdef USE_LCL_CANVAS}
|
||
ACanvas: TCanvas absolute ARenderInfo.Canvas;
|
||
{$endif}
|
||
begin
|
||
ALeft := X;
|
||
ATop := Y;
|
||
ARight := X;
|
||
ABottom := Y;
|
||
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
if Style <> nil then
|
||
Style.ApplyIntoEntity(lEntity);
|
||
lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
|
||
lCurWidth := lCurWidth + (lRight - lLeft);
|
||
lCurHeight := Max(lCurHeight, Abs(lTop - lBottom));
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
|
||
ALeft := X;
|
||
ATop := Y - lCurHeight;
|
||
ARight := X + lCurWidth;
|
||
ABottom := Y;
|
||
end;
|
||
|
||
function TvParagraph.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
|
||
begin
|
||
Result:=inherited TryToSelect(APos, ASubpart, ASnapFlexibility);
|
||
end;
|
||
|
||
procedure TvParagraph.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
//
|
||
lCurWidth: Double = 0.0;
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
OldTextX: Double = 0.0;
|
||
OldTextY: Double = 0.0;
|
||
lEntity: TvEntity;
|
||
lText: TvText; // absolute lEntity;
|
||
lPrevText: TvText = nil;
|
||
lFirstText: Boolean = True;
|
||
lResetOldStyle: Boolean = False;
|
||
lEntityRenderInfo: TvRenderInfo;
|
||
CurX, CurY, lHeight_px: Integer;
|
||
lFeatures: TvEntityFeatures;
|
||
begin
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
InitializeRenderInfo(lEntityRenderInfo, Self);
|
||
|
||
// Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
lFeatures := lEntity.GetEntityFeatures(ARenderInfo);
|
||
lHeight_px := 0;
|
||
if YPos_NeedsAdjustment_DelFirstLineBodyHeight then
|
||
lHeight_px := -1 * lFeatures.FirstLineHeight;
|
||
if (lFeatures.DrawsUpwardHeightAdjustment > 0) then
|
||
lHeight_px := lFeatures.DrawsUpwardHeightAdjustment - lFeatures.FirstLineHeight;
|
||
|
||
if lEntity is TvText then
|
||
begin
|
||
lText := TvText(lEntity); // cannot debug with "absolute"...
|
||
|
||
// Set the text style if not already set
|
||
lResetOldStyle := False;
|
||
if (Style <> nil) and (lText.Style = nil) then
|
||
begin
|
||
lText.Style := Style;
|
||
lResetOldStyle := True
|
||
end;
|
||
|
||
// Direct text position setting resets the auto-positioning
|
||
if (OldTextX <> lText.X) or (OldTextY <> lText.Y) then
|
||
begin
|
||
lCurWidth := 0;
|
||
lFirstText := True;
|
||
end;
|
||
|
||
OldTextX := lText.X;
|
||
OldTextY := lText.Y;
|
||
CurX := CoordToCanvasX(lText.X + X + lCurWidth, ADestX, AMulX);
|
||
CurY := CoordToCanvasY(lText.Y + Y, ADestY, AMulY);
|
||
lText.X := 0;
|
||
lText.Y := 0;
|
||
CurY += lHeight_px;
|
||
lText.Render_Use_NextText_X := not lFirstText;
|
||
if lText.Render_Use_NextText_X then
|
||
lText.Render_NextText_X := lPrevText.Render_NextText_X;
|
||
|
||
// Style apply
|
||
if Style <> nil then
|
||
Style.ApplyIntoEntity(lText);
|
||
|
||
CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
lEntityRenderInfo.DestX := CurX;
|
||
lEntityRenderInfo.DestY := CurY;
|
||
lText.Render(lEntityRenderInfo, ADoDraw);
|
||
lText.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
|
||
lCurWidth := lCurWidth + Abs(lRight - lLeft);
|
||
lFirstText := False;
|
||
lPrevText := lText;
|
||
|
||
lText.X := OldTextX;
|
||
lText.Y := OldTextY;
|
||
if lResetOldStyle then
|
||
TvText(lEntity).Style := nil;
|
||
end
|
||
else
|
||
begin
|
||
OldTextX := lEntity.X;
|
||
OldTextY := lEntity.Y;
|
||
lEntity.X := lEntity.X + X + lCurWidth;
|
||
lEntity.Y := lEntity.Y + Y;
|
||
|
||
CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
lEntityRenderInfo.Canvas := ADest;
|
||
lEntityRenderInfo.DestX := ADestX;
|
||
lEntityRenderInfo.DestY := ADestY + lHeight_px;
|
||
lEntityRenderInfo.MulX := AMulX;
|
||
lEntityRenderInfo.MulY := AMulY;
|
||
lEntity.Render(lEntityRenderInfo, ADoDraw);
|
||
|
||
lEntity.X := OldTextX;
|
||
lEntity.Y := OldTextY;
|
||
end;
|
||
|
||
MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
end;
|
||
|
||
function TvParagraph.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
begin
|
||
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
end;
|
||
|
||
{ TvList }
|
||
|
||
constructor TvList.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
|
||
Parent := Nil;
|
||
end;
|
||
|
||
destructor TvList.Destroy;
|
||
begin
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvList.AddParagraph(ASimpleText: string): TvParagraph;
|
||
begin
|
||
Result := TvParagraph.Create(FPage);
|
||
// TODO:
|
||
// if FPage <> nil then
|
||
// Result.ListStyle := FPage.FOwner.GetListStyleByLevel(ALevel);
|
||
if ASimpleText <> '' then
|
||
Result.AddText(ASimpleText);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvList.AddList: TvList;
|
||
begin
|
||
Result := TvList.Create(FPage);
|
||
|
||
Result.Style := Style;
|
||
Result.ListStyle := ListStyle;
|
||
Result.Parent := Self;
|
||
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvList.GetLevel: Integer;
|
||
var
|
||
oListItem : TvList;
|
||
begin
|
||
Result := 0;
|
||
|
||
oListItem := Parent;
|
||
|
||
while (oListItem<>Nil) do
|
||
begin
|
||
oListItem := oListItem.Parent;
|
||
|
||
inc(Result);
|
||
end;
|
||
end;
|
||
|
||
function TvList.GetBulletSize: Double;
|
||
begin
|
||
Result := Font.Size;
|
||
if Result = 0 then Result := 10;
|
||
Result := Result * 1.5; // for upper/lower spacing
|
||
end;
|
||
|
||
procedure TvList.DrawBullet(ADest: TFPCustomCanvas;
|
||
var ARenderInfo: TvRenderInfo; ALevel: Integer; AX, AY: Double;
|
||
ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double;
|
||
ADoDraw: Boolean);
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
lBulletSpacing: Double;
|
||
lLevel: Integer;
|
||
begin
|
||
lBulletSpacing := GetBulletSize() / 2;
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Pen.FPColor := colBlack;
|
||
ADest.Brush.Style := bsSolid;
|
||
ADest.Brush.FPColor := colBlack;
|
||
lLevel := GetLevel();
|
||
|
||
// level 0 - filled circle
|
||
// level 1 - circle with empty filling
|
||
// lebel 2+ - filled square
|
||
case lLevel of
|
||
1: ADest.Brush.Style := bsClear;
|
||
end;
|
||
|
||
case lLevel of
|
||
0, 1:
|
||
begin
|
||
ADest.Ellipse(CoordToCanvasX(AX + lBulletSpacing), CoordToCanvasY(AY + lBulletSpacing*4), // ToDo: Figure out why this needs to be like that for curved_text.html to render well
|
||
CoordToCanvasX(AX + lBulletSpacing*2), CoordToCanvasY(AY + lBulletSpacing*5));
|
||
end;
|
||
else
|
||
ADest.Rectangle(CoordToCanvasX(AX + lBulletSpacing), CoordToCanvasY(AY + lBulletSpacing*4),
|
||
CoordToCanvasX(AX + lBulletSpacing*2), CoordToCanvasY(AY + lBulletSpacing*5));
|
||
end;
|
||
end;
|
||
|
||
procedure TvList.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean = True);
|
||
var
|
||
ADest: TFPCustomCanvas absolute ARenderInfo.Canvas;
|
||
ADestX: Integer absolute ARenderInfo.DestX;
|
||
ADestY: Integer absolute ARenderInfo.DestY;
|
||
AMulX: Double absolute ARenderInfo.MulX;
|
||
AMulY: Double absolute ARenderInfo.MulY;
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
lEntity: TvEntity;
|
||
lPara: TvParagraph absolute lEntity;
|
||
lList: TvList absolute lEntity;
|
||
lEntityRenderInfo: TvRenderInfo;
|
||
CurX, CurY, lBulletSize, lItemHeight: Double;
|
||
lHeight_px: Integer;
|
||
begin
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
|
||
// Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
|
||
lBulletSize := GetBulletSize() * Abs(AMulX);
|
||
CurX := X + lBulletSize;
|
||
CurY := Y;
|
||
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
// handle both directions of drawing
|
||
lHeight_px := 0;
|
||
lEntity.CalculateHeightInCanvas(ARenderInfo, lHeight_px);
|
||
|
||
// draw the bullet (if necessary)
|
||
if lEntity is TvParagraph then
|
||
begin
|
||
DrawBullet(ADest, lEntityRenderInfo, GetLevel(),
|
||
X, CurY, ADestX, ADestY+lHeight_px, AMulX, AMulY, ADoDraw);
|
||
end;
|
||
|
||
// attempt to centralize the item
|
||
lEntity.X := CurX;
|
||
lEntity.Y := CurY;
|
||
lItemHeight := lEntity.GetHeight(ARenderInfo);
|
||
if lItemHeight < lBulletSize then
|
||
begin
|
||
lItemHeight := lBulletSize;
|
||
lEntity.Y := lEntity.CentralizeY_InHeight(ARenderInfo, lBulletSize);
|
||
end;
|
||
|
||
// draw the item
|
||
lEntityRenderInfo.Canvas := ADest;
|
||
lEntityRenderInfo.DestX := ADestX;
|
||
lEntityRenderInfo.DestY := ADestY+lHeight_px;
|
||
lEntityRenderInfo.MulX := AMulX;
|
||
lEntityRenderInfo.MulY := AMulY;
|
||
lEntity.Render(lEntityRenderInfo, ADoDraw);
|
||
|
||
// prepare next loop iteration
|
||
MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
CurY := CurY + lItemHeight;
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
end;
|
||
|
||
{ TvRichText }
|
||
|
||
constructor TvRichText.Create(APage: TvPage);
|
||
begin
|
||
inherited Create(APage);
|
||
end;
|
||
|
||
destructor TvRichText.Destroy;
|
||
begin
|
||
inherited Destroy;
|
||
end;
|
||
|
||
function TvRichText.AddParagraph: TvParagraph;
|
||
begin
|
||
Result := TvParagraph.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvRichText.AddList: TvList;
|
||
begin
|
||
Result := TvList.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvRichText.AddTable: TvTable;
|
||
begin
|
||
Result := TvTable.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvRichText.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
|
||
begin
|
||
Result := TvEmbeddedVectorialDoc.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvRichText.AddRasterImage: TvRasterImage;
|
||
begin
|
||
Result := TvRasterImage.Create(FPage);
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
// this function is for descendents to override with a different behavior such as TvTableCell
|
||
procedure TvRichText.GetEffectiveCellSpacing(out ATopSpacing, ALeftSpacing, ARightSpacing, ABottomSpacing: Double);
|
||
begin
|
||
ATopSpacing := SpacingTop;
|
||
ALeftSpacing := SpacingLeft;
|
||
ARightSpacing := SpacingRight;
|
||
ABottomSpacing := SpacingBottom;
|
||
end;
|
||
|
||
function TvRichText.CalculateCellHeight_ForWidth(constref ARenderInfo: TvRenderInfo; AWidth: Double): Double;
|
||
var
|
||
lCurHeight: Double = 0.0;
|
||
lLeft, lTop, lRight, lBottom, lSpacingTop, lSpacingBottom, lTmp: Double;
|
||
lEntity: TvEntity;
|
||
//lParagraph: TvParagraph absolute lEntity;
|
||
begin
|
||
Result := 0;
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
lEntity.X := X;
|
||
lEntity.Y := Y + Result;
|
||
lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
|
||
Result := Result + (lBottom - lTop);
|
||
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
|
||
GetEffectiveCellSpacing(lTmp, lSpacingTop, lTmp, lSpacingBottom);
|
||
Result := Result + lSpacingTop + lSpacingBottom;
|
||
end;
|
||
|
||
function TvRichText.CalculateMaxNeededWidth(constref ARenderInfo: TvRenderInfo): Double;
|
||
var
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
lEntity: TvEntity;
|
||
//lParagraph: TvParagraph absolute lEntity;
|
||
begin
|
||
Result := 0;
|
||
|
||
// if the width is not yet known, calculate it
|
||
if Width <= 0 then
|
||
begin
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
lEntity.X := X;
|
||
lEntity.Y := Y + Result;
|
||
lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
|
||
Result := Max(Result, (lRight - lLeft));
|
||
|
||
lEntity := GetNextEntity();
|
||
end;
|
||
end;
|
||
|
||
Result := Result + SpacingLeft + SpacingRight;
|
||
end;
|
||
|
||
function TvRichText.TryToSelect(APos: TPoint; var ASubpart: Cardinal; ASnapFlexibility: Integer = 5): TvFindEntityResult;
|
||
begin
|
||
Result:=inherited TryToSelect(APos, ASubpart, ASnapFlexibility);
|
||
end;
|
||
|
||
procedure TvRichText.Render(var ARenderInfo: TvRenderInfo; ADoDraw: Boolean);
|
||
var
|
||
lCurHeight: Double = 0.0;
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
lHeight_px: Integer;
|
||
lEntity: TvEntity;
|
||
//lParagraph: TvParagraph absolute lEntity;
|
||
lEntityRenderInfo: TvRenderInfo;
|
||
begin
|
||
InitializeRenderInfo(ARenderInfo, Self);
|
||
|
||
// Don't call inherited Render(ADest, ARenderInfo, ADestX, ADestY, AMulX, AMulY, ADoDraw);
|
||
lEntity := GetFirstEntity();
|
||
while lEntity <> nil do
|
||
begin
|
||
lEntity.X := X;
|
||
lEntity.Y := Y + lCurHeight;
|
||
lHeight_px := lEntity.GetEntityFeatures(ARenderInfo).DrawsUpwardHeightAdjustment;
|
||
CopyAndInitDocumentRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
lEntityRenderInfo.Canvas := ARenderInfo.Canvas;
|
||
lEntityRenderInfo.DestX := ARenderInfo.DestX;
|
||
lEntityRenderInfo.DestY := ARenderInfo.DestY + lHeight_px;
|
||
lEntityRenderInfo.Canvas := ARenderInfo.Canvas;
|
||
lEntityRenderInfo.Canvas := ARenderInfo.Canvas;
|
||
lEntity.Render(lEntityRenderInfo, ADoDraw);
|
||
lEntity.CalculateBoundingBox(ARenderInfo, lLeft, lTop, lRight, lBottom);
|
||
lCurHeight := lCurHeight + (lBottom - lTop);
|
||
|
||
lEntity := GetNextEntity();
|
||
MergeRenderInfo(lEntityRenderInfo, ARenderInfo);
|
||
end;
|
||
end;
|
||
|
||
function TvRichText.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer): Pointer;
|
||
begin
|
||
Result:=inherited GenerateDebugTree(ADestRoutine, APageItem);
|
||
end;
|
||
|
||
{ TvPage }
|
||
|
||
procedure TvPage.InitializeRenderInfo(out ARenderInfo: TvRenderInfo;
|
||
ACanvas: TFPCustomCanvas; AEntity: TvEntity);
|
||
begin
|
||
FillChar(ARenderInfo, SizeOf(TvRenderInfo), #0);
|
||
TvEntity.InitializeRenderInfo(ARenderInfo, AEntity, True);
|
||
ARenderInfo.Canvas := ACanvas;
|
||
ARenderInfo.Page := Self;
|
||
ARenderInfo.Renderer := FOwner.FRenderer;
|
||
end;
|
||
|
||
constructor TvPage.Create(AOwner: TvVectorialDocument);
|
||
begin
|
||
inherited Create;
|
||
FOwner := AOwner;
|
||
AdjustPenColorToBackground := true;
|
||
System.FillChar(RenderInfo, SizeOf(RenderInfo), #0);
|
||
TvEntity.InitializeRenderInfo(RenderInfo, nil, True);
|
||
end;
|
||
|
||
destructor TvPage.Destroy;
|
||
begin
|
||
TvEntity.FinalizeRenderInfo(RenderInfo);
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvPage.Assign(ASource: TvPage);
|
||
begin
|
||
|
||
end;
|
||
|
||
procedure TvPage.SetPageFormat(AFormat: TvPageFormat);
|
||
begin
|
||
case AFormat of
|
||
vpA4:
|
||
begin
|
||
Width := 210;
|
||
Height := 297;
|
||
end;
|
||
else
|
||
Width := 210;
|
||
Height := 297;
|
||
end;
|
||
end;
|
||
|
||
procedure TvPage.CalculateDocumentSize;
|
||
{$IFDEF USE_LCL_CANVAS}
|
||
var
|
||
i: Integer;
|
||
lCurEntity: TvEntity;
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
lBmp: TBitmap;
|
||
lRenderInfo: TvRenderInfo;
|
||
begin
|
||
MinX := 0;
|
||
MinY := 0;
|
||
MinZ := 0;
|
||
MaxX := 0;
|
||
MaxY := 0;
|
||
MaxZ := 0;
|
||
lBmp := TBitmap.Create;
|
||
for i := 0 to GetEntitiesCount() -1 do
|
||
begin
|
||
lCurEntity := GetEntity(i);
|
||
lRenderInfo.Canvas := lBmp.Canvas;
|
||
lRenderInfo.Page := self;
|
||
lCurEntity.CalculateBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom);
|
||
MinX := Min(MinX, lLeft);
|
||
MaxX := Max(MaxX, lRight);
|
||
if UseTopLeftCoordinates then
|
||
begin
|
||
MinY := Min(MinY, lTop);
|
||
MaxY := Max(MaxY, lBottom);
|
||
end else
|
||
begin
|
||
MinY := Min(MinY, lBottom);
|
||
MaxY := Max(MaxY, lTop);
|
||
end;
|
||
end;
|
||
lBmp.Free;
|
||
//Width := abs(MaxX - MinX);
|
||
//Height := abs(MaxY - MinY);
|
||
end;
|
||
{$ELSE}
|
||
begin
|
||
end;
|
||
{$ENDIF}
|
||
|
||
function TvPage.RealWidth: Double;
|
||
begin
|
||
Result := abs(MaxX - MinX);
|
||
end;
|
||
|
||
function TvPage.RealHeight: Double;
|
||
begin
|
||
Result := abs(MaxY - MinY);
|
||
end;
|
||
|
||
procedure TvPage.AutoFit(ADest: TFPCustomCanvas; AWidth, AHeight, ARenderHeight: Integer;
|
||
out ADeltaX, ADeltaY: Integer; out AZoom: Double);
|
||
var
|
||
lCurEntity: TvEntity;
|
||
lLeft, lTop, lWidth, lHeight: Integer;
|
||
lMinX, lMinY, lMaxX, lMaxY, lNaturalHeightDiff: Integer;
|
||
lZoomFitX, lZoomFitY, lNaturalMulY: Double;
|
||
|
||
function CalculateAllEntitySizes(): Boolean;
|
||
var
|
||
i: Integer;
|
||
lRenderInfo: TvRenderInfo;
|
||
begin
|
||
Result := True;
|
||
|
||
lMinX := High(Integer);
|
||
lMinY := High(Integer);
|
||
lMaxX := Low(Integer);
|
||
lMaxY := Low(Integer);
|
||
|
||
if Self is TvVectorialPage then
|
||
begin
|
||
for i := 0 to GetEntitiesCount() - 1 do
|
||
begin
|
||
lCurEntity := TvEntity(GetEntity(i));
|
||
InitializeRenderInfo(lRenderInfo, ADest, lCurEntity);
|
||
if lCurEntity.CalculateSizeInCanvas(lRenderInfo, ARenderHeight, AZoom, lLeft, lTop, lWidth, lHeight) then
|
||
begin
|
||
lMinX := Min(lMinX, lLeft);
|
||
lMaxX := Max(lMaxX, lLeft + lWidth);
|
||
if UseTopLeftCoordinates then
|
||
begin
|
||
lMinY := Min(lMinY, lTop);
|
||
lMaxY := Max(lMaxY, lTop + lHeight);
|
||
end else
|
||
begin
|
||
lMaxY := Max(lMaxY, lTop);
|
||
lMinY := Min(lMinY, lTop - lHeight);
|
||
end;
|
||
end;
|
||
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
|
||
AutoFitDebug.Add(Format('[%s] MinX=%d MinY=%d MaxX=%d MaxY=%D', [lCurEntity.ClassName, lMinX, lMinY, lMaxX, lMaxY]));
|
||
{$endif}
|
||
end;
|
||
|
||
lMinX := Min(lMinX, lLeft);
|
||
lMaxX := Max(lMaxX, lLeft + lWidth);
|
||
if UseTopLeftCoordinates then
|
||
begin
|
||
lMinY := Min(lMinY, lTop);
|
||
lMaxY := Max(lMaxY, lTop + lHeight);
|
||
end else
|
||
begin
|
||
lMaxY := Max(lMaxY, lTop);
|
||
lMinY := Min(lMinY, lTop + lHeight);
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
Render(ADest, 0, 0, AZoom, AZoom * lNaturalMulY, False);
|
||
lMinX := RenderInfo.EntityCanvasMinXY.X;
|
||
lMinY := RenderInfo.EntityCanvasMinXY.Y;
|
||
lMaxX := RenderInfo.EntityCanvasMaxXY.X;
|
||
lMaxY := RenderInfo.EntityCanvasMaxXY.Y;
|
||
end;
|
||
|
||
if (lMinX = High(Integer)) or (lMinY = High(Integer)) or
|
||
(lMaxX = Low(Integer)) or(lMaxY = Low(Integer))
|
||
then
|
||
Exit(False);
|
||
|
||
lWidth := lMaxX - lMinX;
|
||
lHeight := lMaxY - lMinY;
|
||
if (lWidth = 0) or (lHeight = 0) then Exit(False);
|
||
end;
|
||
|
||
begin
|
||
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
|
||
AutoFitDebug := TStringList.Create;
|
||
try
|
||
{$endif}
|
||
ADeltaX := 0;
|
||
ADeltaY := 0;
|
||
GetNaturalRenderPos(lNaturalHeightDiff, lNaturalMulY);
|
||
|
||
// First Calculate the zoom
|
||
|
||
AZoom := 1;
|
||
if not CalculateAllEntitySizes() then Exit;
|
||
|
||
lZoomFitX := AWidth / lWidth;
|
||
lZoomFitY := AHeight / lHeight;
|
||
AZoom := Min(lZoomFitX, lZoomFitY) * 0.9;
|
||
|
||
// Now DeltaX, DeltaY
|
||
|
||
if not CalculateAllEntitySizes() then Exit;
|
||
ADeltaX := Round(-1 * lMinX) + AWidth div 2 - lWidth div 2;
|
||
ADeltaY := Round(-1 * lMinY) + (AHeight div 2 - lHeight div 2);
|
||
|
||
{$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
|
||
ADest.Brush.Style := bsClear;
|
||
ADest.Pen.FPColor := colRed;
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Rectangle(lMinX+ADeltaX, lMinY+ADeltaY, lMaxX+ADeltaX, lMaxY+ADeltaY);
|
||
{$endif}
|
||
|
||
{$ifdef FPVECTORIAL_AUTOFIT_DEBUG}
|
||
finally
|
||
{$ifdef Windows}
|
||
AutoFitDebug.SaveToFile('C:\Programas\autofit.txt');
|
||
{$else}
|
||
AutoFitDebug.SaveToFile('/Users/felipe/autofit.txt');
|
||
{$endif}
|
||
AutoFitDebug.Free;
|
||
AutoFitDebug := nil;
|
||
end;
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvPage.SetNaturalRenderPos(AUseTopLeftCoords: Boolean);
|
||
begin
|
||
FUseTopLeftCoordinates := AUseTopLeftCoords;
|
||
end;
|
||
|
||
function TvPage.HasNaturalRenderPos: Boolean;
|
||
begin
|
||
Result := FUseTopLeftCoordinates;
|
||
end;
|
||
|
||
function TvPage.GetTopLeftCoords_Adjustment: Double;
|
||
begin
|
||
if UseTopLeftCoordinates then
|
||
Result := 1
|
||
else
|
||
Result := -1;
|
||
end;
|
||
|
||
|
||
{ TvVectorialPage }
|
||
|
||
procedure TvVectorialPage.ClearTmpPath;
|
||
begin
|
||
FTmpPath.Points := nil;
|
||
FTmpPath.PointsEnd := nil;
|
||
FTmpPath.Len := 0;
|
||
FTmpPath.Brush.Color := colBlue;
|
||
FTmpPath.Brush.Style := bsClear;
|
||
FTmpPath.Pen.Color := colBlack;
|
||
FTmpPath.Pen.Style := psSolid;
|
||
FTmpPath.Pen.Width := 1;
|
||
end;
|
||
|
||
procedure TvVectorialPage.AppendSegmentToTmpPath(ASegment: TPathSegment);
|
||
begin
|
||
FTmpPath.AppendSegment(ASegment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.CallbackDeleteEntity(data, arg: pointer);
|
||
begin
|
||
if (data <> nil) then
|
||
TvEntity(data).Free;
|
||
end;
|
||
|
||
constructor TvVectorialPage.Create(AOwner: TvVectorialDocument);
|
||
begin
|
||
inherited Create(AOwner);
|
||
|
||
FEntities := TFPList.Create;
|
||
FTmpPath := TPath.Create(Self);
|
||
FOwner := AOwner;
|
||
Clear();
|
||
BackgroundColor := colWhite;
|
||
RenderInfo.BackgroundColor := colWhite;
|
||
end;
|
||
|
||
destructor TvVectorialPage.Destroy;
|
||
begin
|
||
Clear;
|
||
|
||
if FTmpPath <> nil then
|
||
begin
|
||
FTmpPath.Free;
|
||
FTmpPath := nil;
|
||
end;
|
||
|
||
FEntities.Free;
|
||
FEntities := nil;
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvVectorialPage.Assign(ASource: TvPage);
|
||
var
|
||
i: Integer;
|
||
AVecSource: TvVectorialPage absolute ASource;
|
||
begin
|
||
if not (ASource is TvVectorialPage) then Exit;
|
||
Clear;
|
||
|
||
for i := 0 to AVecSource.GetEntitiesCount - 1 do
|
||
Self.AddEntity(AVecSource.GetEntity(i));
|
||
end;
|
||
|
||
function TvVectorialPage.GetEntity(ANum: Cardinal): TvEntity;
|
||
begin
|
||
if ANum >= FEntities.Count then raise Exception.Create('TvVectorialDocument.GetEntity: Entity number out of bounds');
|
||
|
||
Result := TvEntity(FEntities.Items[ANum]);
|
||
|
||
if Result = nil then raise Exception.Create(Format('TvVectorialDocument.GetEntity: Invalid Entity number ANum=%d', [ANum]));
|
||
end;
|
||
|
||
function TvVectorialPage.GetEntitiesCount: Integer;
|
||
begin
|
||
Result := FEntities.Count;
|
||
end;
|
||
|
||
function TvVectorialPage.GetLastEntity(): TvEntity;
|
||
begin
|
||
Result:=TvEntity(FEntities.Last);
|
||
end;
|
||
|
||
function TvVectorialPage.GetEntityIndex(AEntity: TvEntity): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to GetEntitiesCount()-1 do
|
||
if TvEntity(FEntities.Items[i]) = AEntity then Exit(i);
|
||
end;
|
||
|
||
function TvVectorialPage.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
|
||
var
|
||
lEntity: TvEntity;
|
||
i: Integer;
|
||
lSubpart: Cardinal;
|
||
begin
|
||
Result := vfrNotFound;
|
||
|
||
for i := 0 to GetEntitiesCount() - 1 do
|
||
begin
|
||
lEntity := GetEntity(i);
|
||
|
||
Result := lEntity.TryToSelect(Pos, lSubpart);
|
||
|
||
if Result <> vfrNotFound then
|
||
begin
|
||
Owner.SelectedElement := lEntity;
|
||
Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TvVectorialPage.FindEntityWithNameAndType(AName: string;
|
||
AType: TvEntityClass; ARecursively: Boolean): TvEntity;
|
||
var
|
||
i: Integer;
|
||
lCurEntity: TvEntity;
|
||
lCurName: String;
|
||
begin
|
||
Result := nil;
|
||
for i := 0 to GetEntitiesCount()-1 do
|
||
begin
|
||
lCurEntity := GetEntity(i);
|
||
|
||
if (lCurEntity is TvNamedEntity) then
|
||
lCurName := TvNamedEntity(lCurEntity).Name
|
||
else
|
||
lCurName := '';
|
||
|
||
if (lCurEntity is AType) and
|
||
(lCurEntity is TvNamedEntity) and (lCurName = AName) then
|
||
begin
|
||
Result := lCurEntity;
|
||
Exit;
|
||
end;
|
||
|
||
if ARecursively and (lCurEntity is TvEntityWithSubEntities) then
|
||
begin
|
||
Result := TvEntityWithSubEntities(lCurEntity).FindEntityWithNameAndType(AName, AType, True);
|
||
if Result <> nil then Exit;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TvVectorialPage.Clear;
|
||
begin
|
||
FEntities.ForEachCall(@CallbackDeleteEntity, nil);
|
||
FEntities.Clear();
|
||
ClearTmpPath();
|
||
ClearLayerSelection();
|
||
end;
|
||
|
||
{@@
|
||
Returns if the entity was really deleted or false if there is no entity with this index
|
||
}
|
||
function TvVectorialPage.DeleteEntity(AIndex: Cardinal): Boolean;
|
||
var
|
||
lEntity: TvEntity;
|
||
begin
|
||
Result := False;
|
||
if AIndex >= GetEntitiesCount() then Exit;;
|
||
lEntity := GetEntity(AIndex);
|
||
if lEntity = nil then Exit;
|
||
FEntities.Delete(AIndex);
|
||
lEntity.Free;
|
||
Result := True;
|
||
end;
|
||
|
||
function TvVectorialPage.RemoveEntity(AEntity: TvEntity; AFreeAfterRemove: Boolean = True): Boolean;
|
||
begin
|
||
Result := False;
|
||
if AEntity = nil then Exit;
|
||
FEntities.Remove(AEntity);
|
||
if AFreeAfterRemove then AEntity.Free;
|
||
Result := True;
|
||
end;
|
||
|
||
{@@
|
||
Adds an entity to the document and returns it's current index
|
||
}
|
||
function TvVectorialPage.AddEntity(AEntity: TvEntity): Integer;
|
||
begin
|
||
AEntity.SetPage(Self);
|
||
if FCurrentLayer = nil then
|
||
begin
|
||
Result := FEntities.Count;
|
||
//AEntity.Parent := nil;
|
||
FEntities.Add(Pointer(AEntity));
|
||
end
|
||
// If a layer is selected as current, add elements to it instead
|
||
else
|
||
begin
|
||
Result := FCurrentLayer.GetSubpartCount();
|
||
//AEntity.Parent := FCurrentLayer;
|
||
FCurrentLayer.AddEntity(AEntity);
|
||
end;
|
||
end;
|
||
|
||
function TvVectorialPage.AddPathCopyMem(APath: TPath; AOnlyCreate: Boolean = False): TPath;
|
||
var
|
||
lPath: TPath;
|
||
//Len: Integer;
|
||
begin
|
||
lPath := TPath.Create(Self);
|
||
lPath.Assign(APath);
|
||
Result := lPath;
|
||
if not AOnlyCreate then AddEntity(lPath);
|
||
//WriteLn(':>TvVectorialDocument.AddPath 1 Len = ', Len);
|
||
end;
|
||
|
||
{@@
|
||
Starts writing a Path in multiple steps.
|
||
Should be followed by zero or more calls to AddPointToPath
|
||
and by a call to EndPath to effectively add the data.
|
||
|
||
@see EndPath, AddPointToPath
|
||
}
|
||
procedure TvVectorialPage.StartPath(AX, AY: Double);
|
||
var
|
||
segment: T2DSegment;
|
||
begin
|
||
ClearTmpPath();
|
||
|
||
FTmpPath.Len := 1;
|
||
segment := T2DSegment.Create;
|
||
segment.SegmentType := stMoveTo;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
|
||
FTmpPath.Points := segment;
|
||
FTmpPath.PointsEnd := segment;
|
||
end;
|
||
|
||
procedure TvVectorialPage.StartPath;
|
||
begin
|
||
ClearTmpPath();
|
||
end;
|
||
|
||
procedure TvVectorialPage.AddMoveToPath(AX, AY: Double);
|
||
var
|
||
segment: T2DSegment;
|
||
begin
|
||
segment := T2DSegment.Create;
|
||
segment.SegmentType := stMoveTo;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
{@@
|
||
Adds one more point to the end of a Path being
|
||
writing in multiple steps.
|
||
|
||
Does nothing if not called between StartPath and EndPath.
|
||
|
||
Can be called multiple times to add multiple points.
|
||
|
||
@see StartPath, EndPath
|
||
}
|
||
procedure TvVectorialPage.AddLineToPath(AX, AY: Double);
|
||
var
|
||
segment: T2DSegment;
|
||
begin
|
||
segment := T2DSegment.Create;
|
||
segment.SegmentType := st2DLine;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.AddLineToPath(AX, AY: Double; AColor: TFPColor);
|
||
var
|
||
segment: T2DSegmentWithPen;
|
||
begin
|
||
segment := T2DSegmentWithPen.Create;
|
||
segment.SegmentType := st2DLineWithPen;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
segment.Pen.Color := AColor;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.AddLineToPath(AX, AY, AZ: Double);
|
||
var
|
||
segment: T3DSegment;
|
||
begin
|
||
segment := T3DSegment.Create;
|
||
segment.SegmentType := st3DLine;
|
||
segment.X := AX;
|
||
segment.Y := AY;
|
||
segment.Z := AZ;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
{@@
|
||
Gets the current Pen Pos in the temporary path
|
||
}
|
||
procedure TvVectorialPage.GetCurrentPathPenPos(var AX, AY: Double);
|
||
begin
|
||
// Check if we are the first segment in the tmp path
|
||
if FTmpPath.PointsEnd = nil then raise Exception.Create('[TvVectorialDocument.GetCurrentPathPenPos] One cannot obtain the Pen Pos if there are no segments in the temporary path');
|
||
|
||
AX := T2DSegment(FTmpPath.PointsEnd).X;
|
||
AY := T2DSegment(FTmpPath.PointsEnd).Y;
|
||
end;
|
||
|
||
procedure TvVectorialPage.GetTmpPathStartPos(var AX, AY: Double);
|
||
begin
|
||
AX := 0;
|
||
AY := 0;
|
||
if (FTmpPath = nil) or (FTmpPath.GetSubpartCount() <= 0) or (FTmpPath.Points = nil) then Exit;
|
||
if FTmpPath.Points is T2DSegment then
|
||
begin
|
||
AX := T2DSegment(FTmpPath.Points).X;
|
||
AY := T2DSegment(FTmpPath.Points).Y;
|
||
end;
|
||
end;
|
||
|
||
{@@
|
||
Adds a bezier element to the path. It starts where the previous element ended
|
||
and it goes throw the control points [AX1, AY1] and [AX2, AY2] and ends
|
||
in [AX3, AY3].
|
||
}
|
||
procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AX2, AY2, AX3, AY3: Double);
|
||
var
|
||
segment: T2DBezierSegment;
|
||
begin
|
||
segment := T2DBezierSegment.Create;
|
||
segment.SegmentType := st2DBezier;
|
||
segment.X := AX3;
|
||
segment.Y := AY3;
|
||
segment.X2 := AX1;
|
||
segment.Y2 := AY1;
|
||
segment.X3 := AX2;
|
||
segment.Y3 := AY2;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.AddBezierToPath(AX1, AY1, AZ1, AX2, AY2, AZ2, AX3, AY3, AZ3: Double);
|
||
var
|
||
segment: T3DBezierSegment;
|
||
begin
|
||
segment := T3DBezierSegment.Create;
|
||
segment.SegmentType := st3DBezier;
|
||
segment.X := AX3;
|
||
segment.Y := AY3;
|
||
segment.Z := AZ3;
|
||
segment.X2 := AX1;
|
||
segment.Y2 := AY1;
|
||
segment.Z2 := AZ1;
|
||
segment.X3 := AX2;
|
||
segment.Y3 := AY2;
|
||
segment.Z3 := AZ2;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.AddEllipticalArcToPath(ARadX, ARadY, AXAxisRotation,
|
||
ADestX, ADestY: Double; ALeftmostEllipse, AClockwiseArcFlag: Boolean);
|
||
var
|
||
segment: T2DEllipticalArcSegment;
|
||
begin
|
||
segment := T2DEllipticalArcSegment.Create;
|
||
segment.SegmentType := st2DEllipticalArc;
|
||
segment.X := ADestX;
|
||
segment.Y := ADestY;
|
||
segment.RX := ARadX;
|
||
segment.RY := ARadY;
|
||
segment.XRotation := AXAxisRotation;
|
||
segment.LeftmostEllipse := ALeftmostEllipse;
|
||
segment.ClockwiseArcFlag := AClockwiseArcFlag;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.AddEllipticalArcWithCenterToPath(ARadX, ARadY,
|
||
AXAxisRotation, ADestX, ADestY, ACenterX, ACenterY: Double;
|
||
AClockwiseArcFlag: Boolean);
|
||
var
|
||
segment: T2DEllipticalArcSegment;
|
||
begin
|
||
segment := T2DEllipticalArcSegment.Create;
|
||
segment.SegmentType := st2DEllipticalArc;
|
||
segment.X := ADestX;
|
||
segment.Y := ADestY;
|
||
segment.RX := ARadX;
|
||
segment.RY := ARadY;
|
||
segment.XRotation := AXAxisRotation;
|
||
segment.CX := ACenterX;
|
||
segment.CY := ACenterY;
|
||
segment.ClockwiseArcFlag := AClockwiseArcFlag;
|
||
segment.CenterSetByUser := true;
|
||
|
||
AppendSegmentToTmpPath(segment);
|
||
end;
|
||
|
||
procedure TvVectorialPage.SetBrushColor(AColor: TFPColor);
|
||
begin
|
||
FTmPPath.Brush.Color := AColor;
|
||
end;
|
||
|
||
procedure TvVectorialPage.SetBrushStyle(AStyle: TFPBrushStyle);
|
||
begin
|
||
FTmPPath.Brush.Style := AStyle;
|
||
end;
|
||
|
||
procedure TvVectorialPage.SetPenColor(AColor: TFPColor);
|
||
begin
|
||
FTmPPath.Pen.Color := AColor;
|
||
end;
|
||
|
||
procedure TvVectorialPage.SetPenStyle(AStyle: TFPPenStyle);
|
||
begin
|
||
FTmPPath.Pen.Style := AStyle;
|
||
end;
|
||
|
||
procedure TvVectorialPage.SetPenWidth(AWidth: Integer);
|
||
begin
|
||
FTmPPath.Pen.Width := AWidth;
|
||
end;
|
||
|
||
procedure TvVectorialPage.SetClipPath(AClipPath: TPath; AClipMode: TvClipMode);
|
||
begin
|
||
FTmPPath.ClipPath := AClipPath;
|
||
FTmPPath.ClipMode := AClipMode;
|
||
end;
|
||
|
||
{@@
|
||
Finishes writing a Path, which was created in multiple
|
||
steps using StartPath and AddPointToPath,
|
||
to the document.
|
||
|
||
Does nothing if there wasn't a previous correspondent call to
|
||
StartPath.
|
||
|
||
@see StartPath, AddPointToPath
|
||
}
|
||
function TvVectorialPage.EndPath(AOnlyCreate: Boolean = False): TPath;
|
||
begin
|
||
if FTmpPath.Len = 0 then Exit;
|
||
Result := AddPathCopyMem(FTmpPath, AOnlyCreate);
|
||
Result.FPage := self;
|
||
ClearTmpPath();
|
||
end;
|
||
|
||
function TvVectorialPage.AddText(AX, AY, AZ: Double; FontName: string;
|
||
FontSize: Double; AText: string; AOnlyCreate: Boolean = False): TvText;
|
||
var
|
||
lText: TvText;
|
||
begin
|
||
lText := TvText.Create(Self);
|
||
lText.Value.Text := AText;
|
||
lText.X := AX;
|
||
lText.Y := AY;
|
||
lText.Z := AZ;
|
||
lText.Font.Name := FontName;
|
||
lText.Font.Size := FontSize;
|
||
if not AOnlyCreate then AddEntity(lText);
|
||
Result := lText;
|
||
end;
|
||
|
||
function TvVectorialPage.AddText(AX, AY: Double; AStr: string; AOnlyCreate: Boolean = False): TvText;
|
||
begin
|
||
Result := AddText(AX, AY, 0, '', 10, AStr, AOnlyCreate);
|
||
end;
|
||
|
||
function TvVectorialPage.AddText(AX, AY, AZ: Double; AStr: string; AOnlyCreate: Boolean = False): TvText;
|
||
begin
|
||
Result := AddText(AX, AY, AZ, '', 10, AStr, AOnlyCreate);
|
||
end;
|
||
|
||
function TvVectorialPage.AddCircle(ACenterX, ACenterY, ARadius: Double; AOnlyCreate: Boolean = False): TvCircle;
|
||
var
|
||
lCircle: TvCircle;
|
||
begin
|
||
lCircle := TvCircle.Create(Self);
|
||
lCircle.X := ACenterX;
|
||
lCircle.Y := ACenterY;
|
||
lCircle.Radius := ARadius;
|
||
Result := lCircle;
|
||
if not AOnlyCreate then AddEntity(lCircle);
|
||
end;
|
||
|
||
function TvVectorialPage.AddCircularArc(ACenterX, ACenterY, ARadius,
|
||
AStartAngle, AEndAngle: Double; AColor: TFPColor; AOnlyCreate: Boolean = False): TvCircularArc;
|
||
var
|
||
lCircularArc: TvCircularArc;
|
||
begin
|
||
lCircularArc := TvCircularArc.Create(Self);
|
||
lCircularArc.X := ACenterX;
|
||
lCircularArc.Y := ACenterY;
|
||
lCircularArc.Radius := ARadius;
|
||
lCircularArc.StartAngle := AStartAngle;
|
||
lCircularArc.EndAngle := AEndAngle;
|
||
lCircularArc.Pen.Color := AColor;
|
||
Result := lCircularArc;
|
||
if not AOnlyCreate then AddEntity(lCircularArc);
|
||
end;
|
||
|
||
function TvVectorialPage.AddEllipse(CenterX, CenterY, HorzHalfAxis,
|
||
VertHalfAxis, Angle: Double; AOnlyCreate: Boolean = False): TvEllipse;
|
||
var
|
||
lEllipse: TvEllipse;
|
||
begin
|
||
lEllipse := TvEllipse.Create(Self);
|
||
lEllipse.X := CenterX;
|
||
lEllipse.Y := CenterY;
|
||
lEllipse.HorzHalfAxis := HorzHalfAxis;
|
||
lEllipse.VertHalfAxis := VertHalfAxis;
|
||
lEllipse.Angle := Angle;
|
||
Result := lEllipse;
|
||
if not AOnlyCreate then AddEntity(lEllipse);
|
||
end;
|
||
|
||
function TvVectorialPage.AddBlock(AName: string; AX, AY, AZ: Double): TvBlock;
|
||
var
|
||
lBlock: TvBlock;
|
||
begin
|
||
lBlock := TvBlock.Create(Self);
|
||
lBlock.X := AX;
|
||
lBlock.Y := AY;
|
||
lBlock.Name := AName;
|
||
AddEntity(lBlock);
|
||
Result := lBlock;
|
||
end;
|
||
|
||
function TvVectorialPage.AddInsert(AX, AY, AZ: Double; AInsertEntity: TvEntity): TvInsert;
|
||
var
|
||
lInsert: TvInsert;
|
||
begin
|
||
lInsert := TvInsert.Create(Self);
|
||
lInsert.X := AX;
|
||
lInsert.Y := AY;
|
||
lInsert.InsertEntity := AInsertEntity;
|
||
AddEntity(lInsert);
|
||
Result := lInsert;
|
||
end;
|
||
|
||
function TvVectorialPage.AddLayer(AName: string): TvLayer;
|
||
begin
|
||
Result := TvLayer.Create(Self);
|
||
Result.Name := AName;
|
||
AddEntity(Result);
|
||
end;
|
||
|
||
function TvVectorialPage.AddLayerAndSetAsCurrent(AName: string): TvLayer;
|
||
begin
|
||
Result := AddLayer(AName);
|
||
FCurrentLayer := Result;
|
||
end;
|
||
|
||
procedure TvVectorialPage.ClearLayerSelection;
|
||
begin
|
||
FCurrentLayer := nil;
|
||
end;
|
||
|
||
function TvVectorialPage.SetCurrentLayer(ALayer: TvEntityWithSubEntities): Boolean;
|
||
begin
|
||
Result := True;
|
||
FCurrentLayer := ALayer;
|
||
end;
|
||
|
||
function TvVectorialPage.GetCurrentLayer: TvEntityWithSubEntities;
|
||
begin
|
||
Result := FCurrentLayer;
|
||
end;
|
||
|
||
|
||
function TvVectorialPage.AddAlignedDimension(BaseLeft, BaseRight, DimLeft,
|
||
DimRight: T3DPoint; AOnlyCreate: Boolean = False): TvAlignedDimension;
|
||
var
|
||
lDim: TvAlignedDimension;
|
||
begin
|
||
lDim := TvAlignedDimension.Create(Self);
|
||
lDim.BaseLeft := BaseLeft;
|
||
lDim.BaseRight := BaseRight;
|
||
lDim.DimensionLeft := DimLeft;
|
||
lDim.DimensionRight := DimRight;
|
||
Result := lDim;
|
||
if not AOnlyCreate then AddEntity(lDim);
|
||
end;
|
||
|
||
function TvVectorialPage.AddRadialDimension(AIsDiameter: Boolean; ACenter,
|
||
ADimLeft, ADimRight: T3DPoint; AOnlyCreate: Boolean = False): TvRadialDimension;
|
||
var
|
||
lDim: TvRadialDimension;
|
||
begin
|
||
lDim := TvRadialDimension.Create(Self);
|
||
lDim.IsDiameter := AIsDiameter;
|
||
lDim.Center := ACenter;
|
||
lDim.DimensionLeft := ADimLeft;
|
||
lDim.DimensionRight := ADimRight;
|
||
Result := lDim;
|
||
if not AOnlyCreate then AddEntity(lDim);
|
||
end;
|
||
|
||
function TvVectorialPage.AddArcDimension(AArcValue, AArcRadius: Double; ABaseLeft, ABaseRight, ADimLeft, ADimRight, ATextPos: T3DPoint; AOnlyCreate: Boolean): TvArcDimension;
|
||
var
|
||
lDim: TvArcDimension;
|
||
begin
|
||
lDim := TvArcDimension.Create(Self);
|
||
lDim.BaseLeft := ABaseLeft;
|
||
lDim.BaseRight := ABaseRight;
|
||
lDim.DimensionLeft := ADimLeft;
|
||
lDim.DimensionRight := ADimRight;
|
||
lDim.ArcRadius := AArcRadius;
|
||
lDim.ArcValue := AArcValue;
|
||
lDim.TextPos := ATextPos;
|
||
Result := lDim;
|
||
if not AOnlyCreate then AddEntity(lDim);
|
||
end;
|
||
|
||
function TvVectorialPage.AddPoint(AX, AY, AZ: Double): TvPoint;
|
||
var
|
||
lPoint: TvPoint;
|
||
begin
|
||
lPoint := TvPoint.Create(Self);
|
||
lPoint.X := AX;
|
||
lPoint.Y := AY;
|
||
lPoint.Z := AZ;
|
||
AddEntity(lPoint);
|
||
Result := lPoint;
|
||
end;
|
||
|
||
procedure TvVectorialPage.PositionEntitySubparts(constref
|
||
ARenderInfo: TvRenderInfo; ABaseX, ABaseY: Double);
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i := 0 to GetEntitiesCount()-1 do
|
||
GetEntity(i).PositionSubparts(ARenderInfo, ABaseX, ABaseY);
|
||
end;
|
||
|
||
procedure TvVectorialPage.DrawBackground(ADest: TFPCustomCanvas);
|
||
begin
|
||
ADest.Pen.Style := psClear;
|
||
ADest.Brush.Style := bsSolid;
|
||
ADest.Brush.FPColor := BackgroundColor;
|
||
ADest.FillRect(0, 0, ADest.Width, ADest.Height);
|
||
ADest.Pen.Style := psSolid;
|
||
end;
|
||
|
||
procedure TvVectorialPage.RenderPageBorder(ADest: TFPCustomCanvas;
|
||
ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
lLeft, lTop, lRight, lBottom: Integer;
|
||
begin
|
||
// Fix the min/max values
|
||
if MinX = MaxX then MaxX := MinX + Width;
|
||
if MinY = MaxY then MaxY := MinY + Height;
|
||
|
||
lLeft := CoordToCanvasX(MinX);
|
||
lTop := CoordToCanvasY(MaxY);
|
||
lRight := CoordToCanvasX(MaxX);
|
||
lBottom := CoordToCanvasY(MinY);
|
||
|
||
ADest.Brush.Style := bsClear;
|
||
ADest.Pen.FPColor := colBlack;
|
||
ADest.Pen.Style := psSolid;
|
||
ADest.Pen.Width := 1;
|
||
ADest.Rectangle(lLeft, lTop, lRight, lBottom);
|
||
end;
|
||
|
||
{@@
|
||
This function draws a FPVectorial vectorial page to a TFPCustomCanvas
|
||
descendent, such as TCanvas from the LCL.
|
||
|
||
Be careful that by default this routine does not execute coordinate transformations,
|
||
and that FPVectorial works with a start point in the bottom-left corner, with
|
||
the X growing to the right and the Y growing to the top. This will result in
|
||
an image in TFPCustomCanvas mirrored in the Y axis in relation with the document
|
||
as seen in a PDF viewer, for example. This can be easily changed with the
|
||
provided parameters. To have the standard view of an image viewer one could
|
||
use this function like this:
|
||
|
||
ASource.Render(ADest, 0, ASource.Height, 1.0, -1.0);
|
||
|
||
Set ADoDraw to falses in order to just get the bounding box of all entities
|
||
on the page in RenderInfo.EnitityCanvasMinXY/EntityCanvasMaxXY.
|
||
}
|
||
procedure TvVectorialPage.Render(ADest: TFPCustomCanvas;
|
||
ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double;
|
||
ADoDraw: Boolean = true);
|
||
var
|
||
i: Integer;
|
||
CurEntity: TvEntity;
|
||
rinfo: TvRenderInfo;
|
||
begin
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
WriteLn(':>DrawFPVectorialToCanvas');
|
||
{$endif}
|
||
|
||
InitializeRenderInfo(RenderInfo, ADest, nil);
|
||
InitializeRenderInfo(rInfo, ADest, nil);
|
||
TvEntity.CopyAndInitDocumentRenderInfo(rInfo, RenderInfo, False, False);
|
||
|
||
if Assigned(FOwner.FRenderer) then
|
||
FOwner.FRenderer.BeginRender(RenderInfo, ADoDraw);
|
||
|
||
for i := 0 to GetEntitiesCount - 1 do
|
||
begin
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format('[Path] ID=%d', [i]));
|
||
{$endif}
|
||
|
||
CurEntity := GetEntity(i);
|
||
|
||
RenderInfo.BackgroundColor := BackgroundColor;
|
||
RenderInfo.AdjustPenColorToBackground := AdjustPenColorToBackground;
|
||
RenderInfo.DestX := ADestX;
|
||
RenderInfo.DestY := ADestY;
|
||
RenderInfo.MulX := AMulX;
|
||
RenderInfo.MulY := AMulY;
|
||
|
||
CurEntity.Render(RenderInfo, ADoDraw);
|
||
|
||
if i = 0 then
|
||
rInfo := RenderInfo
|
||
else
|
||
begin
|
||
rInfo.EntityCanvasMinXY.X := Min(rInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.X);
|
||
rInfo.EntityCanvasMinXY.Y := Min(rInfo.EntityCanvasMinXY.Y, RenderInfo.EntityCanvasMinXY.Y);
|
||
rInfo.EntityCanvasMaxXY.X := Max(rInfo.EntityCanvasMaxXY.X, RenderInfo.EntityCanvasMaxXY.X);
|
||
rInfo.EntityCanvasMaxXY.Y := Max(rInfo.EntityCanvasMaxXY.Y, RenderInfo.EntityCanvasMaxXY.Y);
|
||
end;
|
||
end;
|
||
|
||
if Assigned(FOwner.FRenderer) then
|
||
FOwner.FRenderer.EndRender(RenderInfo, ADoDraw);
|
||
|
||
TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, rInfo, True, False);
|
||
|
||
{$ifdef FPVECTORIAL_RENDERINFO_VISUALDEBUG}
|
||
ADest.Brush.Style := bsClear;
|
||
ADest.Pen.FPColor := colRed;
|
||
ADest.Rectangle(rInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.Y,
|
||
rInfo.EntityCanvasMaxXY.X, rInfo.EntityCanvasMaxXY.Y);
|
||
{$endif}
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
WriteLn(':<DrawFPVectorialToCanvas');
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvVectorialPage.GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double);
|
||
begin
|
||
if FUseTopLeftCoordinates then
|
||
begin
|
||
APageHeight := 0;
|
||
AMulY := 1.0;
|
||
end
|
||
else
|
||
begin
|
||
AMulY := -1.0;
|
||
end;
|
||
end;
|
||
|
||
procedure TvVectorialPage.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc;
|
||
APageItem: Pointer);
|
||
var
|
||
lCurEntity: TvEntity;
|
||
i: Integer;
|
||
begin
|
||
for i := 0 to FEntities.Count - 1 do
|
||
begin
|
||
lCurEntity := TvEntity(FEntities.Items[i]);
|
||
lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
|
||
end;
|
||
end;
|
||
|
||
{ TvTextPageSequence }
|
||
|
||
constructor TvTextPageSequence.Create(AOwner: TvVectorialDocument);
|
||
begin
|
||
inherited Create(AOwner);
|
||
|
||
FUseTopLeftCoordinates := True;
|
||
Footer := TvRichText.Create(Self);
|
||
Header := TvRichText.Create(Self);
|
||
MainText := TvRichText.Create(Self);
|
||
end;
|
||
|
||
destructor TvTextPageSequence.Destroy;
|
||
begin
|
||
Footer.Free;
|
||
Header.Free;
|
||
MainText.Free;
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvTextPageSequence.Assign(ASource: TvPage);
|
||
begin
|
||
inherited Assign(ASource);
|
||
end;
|
||
|
||
function TvTextPageSequence.GetEntity(ANum: Cardinal): TvEntity;
|
||
begin
|
||
Result := MainText.GetEntity(ANum);
|
||
end;
|
||
|
||
function TvTextPageSequence.GetEntitiesCount: Integer;
|
||
begin
|
||
Result := MainText.GetEntitiesCount();
|
||
end;
|
||
|
||
function TvTextPageSequence.GetLastEntity: TvEntity;
|
||
begin
|
||
Result := MainText.GetEntity(MainText.GetEntitiesCount()-1);
|
||
end;
|
||
|
||
function TvTextPageSequence.GetEntityIndex(AEntity: TvEntity): Integer;
|
||
begin
|
||
Result := MainText.GetEntityIndex(AEntity);
|
||
end;
|
||
|
||
function TvTextPageSequence.FindAndSelectEntity(Pos: TPoint): TvFindEntityResult;
|
||
begin
|
||
//
|
||
end;
|
||
|
||
function TvTextPageSequence.FindEntityWithNameAndType(AName: string;
|
||
AType: TvEntityClass; ARecursively: Boolean): TvEntity;
|
||
begin
|
||
//
|
||
end;
|
||
|
||
procedure TvTextPageSequence.Clear;
|
||
begin
|
||
MainText.Clear;
|
||
end;
|
||
|
||
function TvTextPageSequence.DeleteEntity(AIndex: Cardinal): Boolean;
|
||
begin
|
||
Result := MainText.DeleteEntity(AIndex);
|
||
end;
|
||
|
||
function TvTextPageSequence.RemoveEntity(AEntity: TvEntity;
|
||
AFreeAfterRemove: Boolean): Boolean;
|
||
begin
|
||
Result := True;
|
||
MainText.Clear;
|
||
end;
|
||
|
||
function TvTextPageSequence.AddEntity(AEntity: TvEntity): Integer;
|
||
begin
|
||
AEntity.SetPage(Self);
|
||
Result := MainText.AddEntity(AEntity);
|
||
end;
|
||
|
||
function TvTextPageSequence.AddParagraph: TvParagraph;
|
||
begin
|
||
Result := MainText.AddParagraph();
|
||
end;
|
||
|
||
function TvTextPageSequence.AddList: TvList;
|
||
begin
|
||
Result := MainText.AddList();
|
||
end;
|
||
|
||
function TvTextPageSequence.AddTable: TvTable;
|
||
begin
|
||
Result := MainText.AddTable;
|
||
end;
|
||
|
||
function TvTextPageSequence.AddEmbeddedVectorialDoc: TvEmbeddedVectorialDoc;
|
||
begin
|
||
Result := MainText.AddEmbeddedVectorialDoc;
|
||
end;
|
||
|
||
procedure TvTextPageSequence.DrawBackground(ADest: TFPCustomCanvas);
|
||
begin
|
||
//
|
||
end;
|
||
|
||
procedure TvTextPageSequence.RenderPageBorder(ADest: TFPCustomCanvas;
|
||
ADestX: Integer; ADestY: Integer; AMulX: Double; AMulY: Double);
|
||
begin
|
||
//
|
||
end;
|
||
|
||
procedure TvTextPageSequence.Render(ADest: TFPCustomCanvas; ADestX: Integer;
|
||
ADestY: Integer; AMulX: Double; AMulY: Double; ADoDraw: Boolean = true);
|
||
|
||
function CoordToCanvasX(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestX + AmulX * ACoord);
|
||
end;
|
||
|
||
function CoordToCanvasY(ACoord: Double): Integer;
|
||
begin
|
||
Result := Round(ADestY + AmulY * ACoord);
|
||
end;
|
||
|
||
var
|
||
i: Integer;
|
||
CurEntity: TvEntity;
|
||
CurY_px: Integer = 0;
|
||
lHeight_px: Integer;
|
||
lBoundsLeft, lBoundsTop, lBoundsRight, lBoundsBottom: Double;
|
||
lSumRenderInfo: TvRenderInfo;
|
||
begin
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
WriteLn(':>TvTextPageSequence.Render');
|
||
{$endif}
|
||
CurY_px := ADestY;
|
||
InitializeRenderInfo(RenderInfo, ADest, nil);
|
||
TvEntity.CopyAndInitDocumentRenderInfo(lSumRenderInfo, RenderInfo);
|
||
|
||
for i := 0 to GetEntitiesCount - 1 do
|
||
begin
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
Write(Format('[Path] ID=%d', [i]));
|
||
{$endif}
|
||
|
||
CurEntity := GetEntity(i);
|
||
|
||
CurEntity.X := 0;
|
||
CurEntity.Y := 0;
|
||
lHeight_px := CurEntity.GetEntityFeatures(lSumRenderInfo).TotalHeight;
|
||
RenderInfo.BackgroundColor := BackgroundColor;
|
||
RenderInfo.DestX := ADestX;
|
||
RenderInfo.DestY := CurY_px + lHeight_px;
|
||
RenderInfo.MulX := AMulX;
|
||
RenderInfo.MulY := AMulY;
|
||
CurEntity.Render(RenderInfo, ADoDraw);
|
||
// Store the old position in X/Y but don't use it, we use this to debug out the position
|
||
CurEntity.X := ADestX;
|
||
CurEntity.Y := CurY_px;
|
||
lHeight_px := Abs(RenderInfo.EntityCanvasMaxXY.Y - RenderInfo.EntityCanvasMinXY.Y);
|
||
CurY_px := CurY_px + lHeight_px;
|
||
|
||
TvEntity.CalcEntityCanvasMinMaxXY_With2Points(lSumRenderInfo,
|
||
RenderInfo.EntityCanvasMinXY.X, RenderInfo.EntityCanvasMinXY.Y,
|
||
RenderInfo.EntityCanvasMaxXY.X, RenderInfo.EntityCanvasMaxXY.Y);
|
||
end;
|
||
|
||
TvEntity.CopyAndInitDocumentRenderInfo(RenderInfo, lSumRenderInfo, True);
|
||
|
||
{$ifdef FPVECTORIAL_TOCANVAS_DEBUG}
|
||
WriteLn(':<TvTextPageSequence.Render');
|
||
{$endif}
|
||
end;
|
||
|
||
procedure TvTextPageSequence.GetNaturalRenderPos(var APageHeight: Integer; out AMulY: Double);
|
||
begin
|
||
APageHeight := 0;
|
||
AMulY := 1.0;
|
||
end;
|
||
|
||
procedure TvTextPageSequence.GenerateDebugTree(
|
||
ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
|
||
var
|
||
lCurEntity: TvEntity;
|
||
i: Integer;
|
||
begin
|
||
for i := 0 to MainText.GetEntitiesCount() - 1 do
|
||
begin
|
||
lCurEntity := MainText.GetEntity(i);
|
||
lCurEntity.GenerateDebugTree(ADestRoutine, APageItem);
|
||
end;
|
||
end;
|
||
|
||
(*
|
||
function TvTextPageSequence.AddImage: TvImage;
|
||
begin
|
||
Result := MainText.AddImage;
|
||
end;
|
||
*)
|
||
{ TvVectorialDocument }
|
||
|
||
{@@
|
||
Constructor.
|
||
}
|
||
constructor TvVectorialDocument.Create;
|
||
begin
|
||
inherited Create;
|
||
|
||
FPages := TFPList.Create;
|
||
FCurrentPageIndex := -1;
|
||
FStyles := TFPList.Create;
|
||
FListStyles := TFPList.Create;
|
||
if gDefaultRenderer <> nil then
|
||
FRenderer := gDefaultRenderer.Create;
|
||
end;
|
||
|
||
{@@
|
||
Destructor.
|
||
}
|
||
destructor TvVectorialDocument.Destroy;
|
||
begin
|
||
Clear();
|
||
|
||
FPages.Free;
|
||
FPages := nil;
|
||
FStyles.Free;
|
||
FStyles := nil;
|
||
FListStyles.Free;
|
||
FListStyles := nil;
|
||
|
||
ClearRenderer();
|
||
|
||
inherited Destroy;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.Assign(ASource: TvVectorialDocument);
|
||
//var
|
||
// i: Integer;
|
||
begin
|
||
// Clear;
|
||
//
|
||
// for i := 0 to ASource.GetEntitiesCount - 1 do
|
||
// Self.AddEntity(ASource.GetEntity(i));
|
||
end;
|
||
|
||
procedure TvVectorialDocument.AssignTo(ADest: TvVectorialDocument);
|
||
begin
|
||
ADest.Assign(Self);
|
||
end;
|
||
|
||
{@@
|
||
Convenience method which creates the correct
|
||
writer object for a given vector graphics document format.
|
||
}
|
||
function TvVectorialDocument.CreateVectorialWriter(AFormat: TvVectorialFormat): TvCustomVectorialWriter;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := nil;
|
||
|
||
for i := 0 to Length(GvVectorialFormats) - 1 do
|
||
if GvVectorialFormats[i].Format = AFormat then
|
||
begin
|
||
if GvVectorialFormats[i].WriterClass <> nil then
|
||
Result := GvVectorialFormats[i].WriterClass.Create;
|
||
|
||
Break;
|
||
end;
|
||
|
||
if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
|
||
end;
|
||
|
||
{@@
|
||
Convenience method which creates the correct
|
||
reader object for a given vector graphics document format.
|
||
}
|
||
function TvVectorialDocument.CreateVectorialReader(AFormat: TvVectorialFormat): TvCustomVectorialReader;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := nil;
|
||
|
||
for i := 0 to Length(GvVectorialFormats) - 1 do
|
||
if GvVectorialFormats[i].Format = AFormat then
|
||
begin
|
||
if GvVectorialFormats[i].ReaderClass <> nil then
|
||
Result := GvVectorialFormats[i].ReaderClass.Create;
|
||
|
||
Break;
|
||
end;
|
||
|
||
if Result = nil then raise Exception.Create('Unsupported vector graphics format.');
|
||
end;
|
||
|
||
{@@
|
||
Writes the document to a file.
|
||
|
||
If the file doesn't exist, it will be created.
|
||
}
|
||
procedure TvVectorialDocument.WriteToFile(AFileName: string; AFormat: TvVectorialFormat);
|
||
var
|
||
AWriter: TvCustomVectorialWriter;
|
||
begin
|
||
AWriter := CreateVectorialWriter(AFormat);
|
||
try
|
||
AWriter.WriteToFile(AFileName, Self);
|
||
finally
|
||
AWriter.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.WriteToFile(AFileName: string);
|
||
var
|
||
lFormat: TvVectorialFormat;
|
||
begin
|
||
lFormat := GetFormatFromExtension(AFileName);
|
||
WriteToFile(AFileName, lFormat);
|
||
end;
|
||
|
||
{@@
|
||
Writes the document to a stream
|
||
}
|
||
procedure TvVectorialDocument.WriteToStream(AStream: TStream; AFormat: TvVectorialFormat);
|
||
var
|
||
AWriter: TvCustomVectorialWriter;
|
||
begin
|
||
AWriter := CreateVectorialWriter(AFormat);
|
||
try
|
||
AWriter.WriteToStream(AStream, Self);
|
||
finally
|
||
AWriter.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.WriteToStrings(AStrings: TStrings;
|
||
AFormat: TvVectorialFormat);
|
||
var
|
||
AWriter: TvCustomVectorialWriter;
|
||
begin
|
||
AWriter := CreateVectorialWriter(AFormat);
|
||
try
|
||
AWriter.WriteToStrings(AStrings, Self);
|
||
finally
|
||
AWriter.Free;
|
||
end;
|
||
end;
|
||
|
||
{@@
|
||
Reads the document from a file.
|
||
|
||
Any current contents in this object will be removed.
|
||
}
|
||
procedure TvVectorialDocument.ReadFromFile(AFileName: string;
|
||
AFormat: TvVectorialFormat);
|
||
var
|
||
AReader: TvCustomVectorialReader;
|
||
begin
|
||
Self.Clear;
|
||
|
||
AReader := CreateVectorialReader(AFormat);
|
||
try
|
||
AReader.Settings := ReaderSettings;
|
||
AReader.ReadFromFile(AFileName, Self);
|
||
finally
|
||
AReader.Free;
|
||
end;
|
||
end;
|
||
|
||
{@@
|
||
Reads the document from a file. A variant that auto-detects the format from the extension and other factors.
|
||
}
|
||
procedure TvVectorialDocument.ReadFromFile(AFileName: string);
|
||
var
|
||
lFormat: TvVectorialFormat;
|
||
begin
|
||
lFormat := GetFormatFromExtension(AFileName);
|
||
ReadFromFile(AFileName, lFormat);
|
||
end;
|
||
|
||
{@@
|
||
Reads the document from a stream.
|
||
|
||
Any current contents in this object will be removed.
|
||
}
|
||
procedure TvVectorialDocument.ReadFromStream(AStream: TStream;
|
||
AFormat: TvVectorialFormat);
|
||
var
|
||
AReader: TvCustomVectorialReader;
|
||
begin
|
||
Self.Clear;
|
||
|
||
AReader := CreateVectorialReader(AFormat);
|
||
try
|
||
AReader.Settings := ReaderSettings;
|
||
AReader.ReadFromStream(AStream, Self);
|
||
finally
|
||
AReader.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.ReadFromStrings(AStrings: TStrings;
|
||
AFormat: TvVectorialFormat);
|
||
var
|
||
AReader: TvCustomVectorialReader;
|
||
begin
|
||
Self.Clear;
|
||
|
||
AReader := CreateVectorialReader(AFormat);
|
||
try
|
||
AReader.Settings := ReaderSettings;
|
||
AReader.ReadFromStrings(AStrings, Self);
|
||
finally
|
||
AReader.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.ReadFromXML(ADoc: TXMLDocument; AFormat: TvVectorialFormat);
|
||
var
|
||
AReader: TvCustomVectorialReader;
|
||
begin
|
||
Self.Clear;
|
||
|
||
AReader := CreateVectorialReader(AFormat);
|
||
try
|
||
AReader.ReadFromXML(ADoc, Self);
|
||
finally
|
||
AReader.Free;
|
||
end;
|
||
end;
|
||
|
||
class function TvVectorialDocument.GetFormatFromExtension(AFileName: string;
|
||
ARaiseException: Boolean = True): TvVectorialFormat;
|
||
var
|
||
lExt: string;
|
||
begin
|
||
lExt := ExtractFileExt(AFileName);
|
||
if AnsiCompareText(lExt, STR_PDF_EXTENSION) = 0 then Result := vfPDF
|
||
else if AnsiCompareText(lExt, STR_POSTSCRIPT_EXTENSION) = 0 then Result := vfPostScript
|
||
else if AnsiCompareText(lExt, STR_SVG_EXTENSION) = 0 then Result := vfSVG
|
||
else if AnsiCompareText(lExt, STR_SVGZ_EXTENSION) = 0 then Result := vfSVGZ
|
||
else if AnsiCompareText(lExt, STR_CORELDRAW_EXTENSION) = 0 then Result := vfCorelDrawCDR
|
||
else if AnsiCompareText(lExt, STR_WINMETAFILE_EXTENSION) = 0 then Result := vfWindowsMetafileWMF
|
||
else if AnsiCompareText(lExt, STR_AUTOCAD_EXCHANGE_EXTENSION) = 0 then Result := vfDXF
|
||
else if AnsiCompareText(lExt, STR_ENCAPSULATEDPOSTSCRIPT_EXTENSION) = 0 then Result := vfEncapsulatedPostScript
|
||
else if AnsiCompareText(lExt, STR_LAS_EXTENSION) = 0 then Result := vfLAS
|
||
else if AnsiCompareText(lExt, STR_LAZ_EXTENSION) = 0 then Result := vfLAZ
|
||
else if AnsiCompareText(lExt, STR_RAW_EXTENSION) = 0 then Result := vfRAW
|
||
else if AnsiCompareText(lExt, STR_MATHML_EXTENSION) = 0 then Result := vfMathML
|
||
else if AnsiCompareText(lExt, STR_ODG_EXTENSION) = 0 then Result := vfODG
|
||
else if AnsiCompareText(lExt, STR_DOCX_EXTENSION) = 0 then Result := vfDOCX
|
||
else if AnsiCompareText(lExt, STR_HTML_EXTENSION) = 0 then Result := vfHTML
|
||
else if ARaiseException then
|
||
raise Exception.Create('TvVectorialDocument.GetFormatFromExtension: The extension (' + lExt + ') doesn''t match any supported formats.')
|
||
else
|
||
Result := vfUnknown;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetDetailedFileFormat(): string;
|
||
begin
|
||
//
|
||
end;
|
||
|
||
procedure TvVectorialDocument.GuessDocumentSize();
|
||
var
|
||
i, j: Integer;
|
||
lEntity: TvEntity;
|
||
lLeft, lTop, lRight, lBottom: Double;
|
||
CurPage: TvPage;
|
||
lRenderInfo: TvRenderInfo;
|
||
begin
|
||
lRenderInfo := Default(TvRenderInfo);
|
||
|
||
lLeft := 0;
|
||
lTop := 0;
|
||
lRight := 0;
|
||
lBottom := 0;
|
||
|
||
for j := 0 to GetPageCount()-1 do
|
||
begin
|
||
CurPage := GetPage(j);
|
||
for i := 0 to CurPage.GetEntitiesCount() - 1 do
|
||
begin
|
||
lEntity := CurPage.GetEntity(I);
|
||
TvEntity.InitializeRenderInfo(lRenderInfo, nil);
|
||
lRenderInfo.Page := CurPage;
|
||
lEntity.ExpandBoundingBox(lRenderInfo, lLeft, lTop, lRight, lBottom);
|
||
end;
|
||
end;
|
||
|
||
Width := lRight - lLeft;
|
||
Height := lBottom - lTop;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.GuessGoodZoomLevel(AScreenSize: Integer);
|
||
begin
|
||
If Height <> 0 Then
|
||
ZoomLevel := AScreenSize / Height;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetPage(AIndex: Integer): TvPage;
|
||
begin
|
||
Result := TvPage(FPages.Items[AIndex]);
|
||
end;
|
||
|
||
function TvVectorialDocument.GetPageIndex(APage: TvPage): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to FPages.Count-1 do
|
||
if TvPage(FPages.Items[i]) = APage then Exit(i);
|
||
end;
|
||
|
||
function TvVectorialDocument.GetPageAsVectorial(AIndex: Integer): TvVectorialPage;
|
||
var
|
||
lPage: TvPage;
|
||
begin
|
||
lPage := GetPage(AIndex);
|
||
if lPage is TvVectorialPage then
|
||
Result := TvVectorialPage(lPage)
|
||
else
|
||
Result := nil;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetPageAsText(AIndex: Integer): TvTextPageSequence;
|
||
var
|
||
lPage: TvPage;
|
||
begin
|
||
lPage := GetPage(AIndex);
|
||
if lPage is TvTextPageSequence then
|
||
Result := TvTextPageSequence(lPage)
|
||
else
|
||
Result := nil;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetPageCount: Integer;
|
||
begin
|
||
Result := FPages.Count;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetCurrentPage: TvPage;
|
||
begin
|
||
if FCurrentPageIndex >= 0 then
|
||
Result := GetPage(FCurrentPageIndex)
|
||
else
|
||
Result := nil;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetCurrentPageAsVectorial: TvVectorialPage;
|
||
var
|
||
lCurPage: TvPage;
|
||
begin
|
||
lCurPage := GetCurrentPage();
|
||
if lCurPage is TvVectorialPage then
|
||
Result := TvVectorialPage(lCurPage)
|
||
else
|
||
Result := nil
|
||
end;
|
||
|
||
procedure TvVectorialDocument.SetCurrentPage(AIndex: Integer);
|
||
begin
|
||
FCurrentPageIndex := AIndex;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.SetDefaultPageFormat(AFormat: TvPageFormat);
|
||
begin
|
||
case AFormat of
|
||
vpA4:
|
||
begin
|
||
Width := 210;
|
||
Height := 297;
|
||
end;
|
||
else
|
||
Width := 210;
|
||
Height := 297;
|
||
end;
|
||
end;
|
||
|
||
function TvVectorialDocument.AddPage(AUseTopLeftCoords: Boolean = False): TvVectorialPage;
|
||
begin
|
||
Result := TvVectorialPage.Create(Self);
|
||
Result.Width := Width;
|
||
Result.Height := Height;
|
||
Result.SetNaturalRenderPos(AUseTopLeftCoords);
|
||
FPages.Add(Result);
|
||
if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
|
||
end;
|
||
|
||
function TvVectorialDocument.AddTextPageSequence: TvTextPageSequence;
|
||
begin
|
||
Result := TvTextPageSequence.Create(Self);
|
||
Result.Width := Width;
|
||
Result.Height := Height;
|
||
FPages.Add(Result);
|
||
if FCurrentPageIndex < 0 then FCurrentPageIndex := FPages.Count-1;
|
||
end;
|
||
|
||
function TvVectorialDocument.AddStyle: TvStyle;
|
||
begin
|
||
Result := TvStyle.Create;
|
||
FStyles.Add(Result);
|
||
end;
|
||
|
||
function TvVectorialDocument.AddListStyle: TvListStyle;
|
||
begin
|
||
Result := TvListStyle.Create;
|
||
FListStyles.Add(Result);
|
||
end;
|
||
|
||
procedure TvVectorialDocument.AddStandardTextDocumentStyles(AFormat: TvVectorialFormat);
|
||
var
|
||
lTextBody, lBaseHeading, lCurStyle: TvStyle;
|
||
lCurListStyle : TvListStyle;
|
||
i: Integer;
|
||
lCurListLevelStyle: TvListLevelStyle;
|
||
begin
|
||
lTextBody := AddStyle();
|
||
lTextBody.Name := 'Text Body';
|
||
lTextBody.Kind := vskTextBody;
|
||
lTextBody.Font.Size := 12;
|
||
lTextBody.Font.Name := 'Times New Roman';
|
||
lTextBody.Brush.Style := bsClear;
|
||
lTextBody.Alignment := vsaJustifed;
|
||
lTextBody.MarginTop := 0;
|
||
lTextBody.MarginBottom := 2.12;
|
||
lTextBody.SetElements := [spbfFontSize, spbfFontName, spbfAlignment,
|
||
sseMarginTop, sseMarginBottom, spbfBrushStyle];
|
||
StyleTextBody := lTextBody;
|
||
|
||
// Headings
|
||
lBaseHeading := AddStyle();
|
||
lBaseHeading.Name := 'Heading';
|
||
lBaseHeading.Kind := vskHeading;
|
||
lBaseHeading.Font.Size := 14;
|
||
lBaseHeading.Font.Name := 'Arial';
|
||
lBaseHeading.Brush.Style := bsClear;
|
||
lBaseHeading.MarginTop := 4.23;
|
||
lBaseHeading.MarginBottom := 2.12;
|
||
lBaseHeading.SetElements := [spbfFontSize, spbfFontName, sseMarginTop, sseMarginBottom];
|
||
|
||
lCurStyle := AddStyle();
|
||
lCurStyle.Name := 'Heading 1';
|
||
lCurStyle.Parent := lBaseHeading;
|
||
lCurStyle.HeadingLevel := 1;
|
||
lCurStyle.Font.Bold := True;
|
||
case AFormat of
|
||
vfHTML: lCurStyle.Font.Size := 20;
|
||
else
|
||
lCurStyle.Font.Size := 1.15 * lBaseHeading.Font.Size;
|
||
end;
|
||
lCurStyle.Brush.Style := bsClear;
|
||
lCurStyle.SetElements := [spbfFontSize, spbfFontBold];
|
||
StyleHeading1 := lCurStyle;
|
||
|
||
lCurStyle := AddStyle();
|
||
lCurStyle.Name := 'Heading 2';
|
||
lCurStyle.Parent := lBaseHeading;
|
||
lCurStyle.HeadingLevel := 2;
|
||
lCurStyle.Font.Bold := True;
|
||
case AFormat of
|
||
vfHTML: lCurStyle.Font.Size := 16;
|
||
else
|
||
lCurStyle.Font.Size := 14;
|
||
lCurStyle.Font.Italic := True;
|
||
end;
|
||
lCurStyle.Brush.Style := bsClear;
|
||
lCurStyle.SetElements := [spbfFontSize, spbfFontBold, spbfFontItalic];
|
||
StyleHeading2 := lCurStyle;
|
||
|
||
lCurStyle := AddStyle();
|
||
lCurStyle.Name := 'Heading 3';
|
||
lCurStyle.Parent := lBaseHeading;
|
||
lCurStyle.HeadingLevel := 3;
|
||
lCurStyle.Font.Bold := True;
|
||
lCurStyle.Font.Size := 14;
|
||
lCurStyle.Brush.Style := bsClear;
|
||
lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
|
||
StyleHeading3 := lCurStyle;
|
||
|
||
lCurStyle := AddStyle();
|
||
lCurStyle.Name := 'Heading 4';
|
||
lCurStyle.Parent := lBaseHeading;
|
||
lCurStyle.HeadingLevel := 4;
|
||
lCurStyle.Font.Size := 12;
|
||
lCurStyle.Font.Bold := True;
|
||
lCurStyle.Brush.Style := bsClear;
|
||
lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
|
||
StyleHeading4 := lCurStyle;
|
||
|
||
lCurStyle := AddStyle();
|
||
lCurStyle.Name := 'Heading 5';
|
||
lCurStyle.Parent := lBaseHeading;
|
||
lCurStyle.HeadingLevel := 5;
|
||
lCurStyle.Font.Size := 10;
|
||
lCurStyle.Font.Bold := True;
|
||
lCurStyle.Brush.Style := bsClear;
|
||
lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
|
||
StyleHeading5 := lCurStyle;
|
||
|
||
lCurStyle := AddStyle();
|
||
lCurStyle.Name := 'Heading 6';
|
||
lCurStyle.Parent := lBaseHeading;
|
||
lCurStyle.HeadingLevel := 6;
|
||
lCurStyle.Font.Size := 8;
|
||
lCurStyle.Font.Bold := True;
|
||
lCurStyle.Brush.Style := bsClear;
|
||
lCurStyle.SetElements := [spbfFontSize, spbfFontName, spbfFontBold];
|
||
StyleHeading6 := lCurStyle;
|
||
|
||
// ---------------------------------
|
||
// Centralized paragraph styles
|
||
// ---------------------------------
|
||
|
||
StyleTextBodyCentralized := AddStyle();
|
||
StyleTextBodyCentralized.ApplyOver(StyleTextBody);
|
||
StyleTextBodyCentralized.Name := 'Text Body Centered';
|
||
StyleTextBodyCentralized.Alignment := vsaCenter;
|
||
StyleTextBodyCentralized.SetElements := StyleTextBodyCentralized.SetElements + [spbfAlignment];
|
||
|
||
StyleTextBodyBold := AddStyle();
|
||
StyleTextBodyBold.ApplyOver(StyleTextBody);
|
||
StyleTextBodyBold.Name := 'Text Body Bold';
|
||
StyleTextBodyBold.Font.Bold := True;
|
||
StyleTextBodyBold.SetElements := StyleTextBodyCentralized.SetElements + [spbfFontBold];
|
||
|
||
StyleHeading1Centralized := AddStyle();
|
||
StyleHeading1Centralized.ApplyOver(StyleHeading1);
|
||
StyleHeading1Centralized.Name := 'Heading 1 Centered';
|
||
StyleHeading1Centralized.Alignment := vsaCenter;
|
||
StyleHeading1Centralized.SetElements := StyleHeading1Centralized.SetElements + [spbfAlignment];
|
||
|
||
StyleHeading2Centralized := AddStyle();
|
||
StyleHeading2Centralized.ApplyOver(StyleHeading2);
|
||
StyleHeading2Centralized.Name := 'Heading 2 Centered';
|
||
StyleHeading2Centralized.Alignment := vsaCenter;
|
||
StyleHeading2Centralized.SetElements := StyleHeading2Centralized.SetElements + [spbfAlignment];
|
||
|
||
StyleHeading3Centralized := AddStyle();
|
||
StyleHeading3Centralized.ApplyOver(StyleHeading3);
|
||
StyleHeading3Centralized.Name := 'Heading 3 Centered';
|
||
StyleHeading3Centralized.Alignment := vsaCenter;
|
||
StyleHeading3Centralized.SetElements := StyleHeading3Centralized.SetElements + [spbfAlignment];
|
||
|
||
// ---------------------------------
|
||
// Bullet List Items
|
||
// ---------------------------------
|
||
|
||
lCurListStyle := AddListStyle();
|
||
lCurListStyle.Name := 'Bullet List Style';
|
||
StyleBulletList := lCurListStyle;
|
||
|
||
for i := 0 To NUM_MAX_LISTSTYLES-1 Do
|
||
begin
|
||
lCurListLevelStyle := StyleBulletList.AddListLevelStyle;
|
||
lCurListLevelStyle.Kind := vlskBullet;
|
||
lCurListLevelStyle.Level := i;
|
||
|
||
// Bullet is positioned at MarginLeft - HangingIndent
|
||
lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
|
||
lCurListLevelStyle.HangingIndent := 6.35;
|
||
end;
|
||
|
||
lCurListStyle := AddListStyle();
|
||
lCurListStyle.Name := 'Numbered List Style';
|
||
StyleNumberList := lCurListStyle;
|
||
|
||
for i := 0 To NUM_MAX_LISTSTYLES-1 Do
|
||
begin
|
||
lCurListLevelStyle := StyleNumberList.AddListLevelStyle;
|
||
lCurListLevelStyle.Kind := vlskNumeric;
|
||
lCurListLevelStyle.NumberFormat := vnfDecimal;
|
||
lCurListLevelStyle.Level := i;
|
||
|
||
lCurListLevelStyle.Prefix := '';
|
||
lCurListLevelStyle.Suffix := '.';
|
||
lCurListLevelStyle.DisplayLevels := True; // 1.1.1.1.
|
||
lCurListLevelStyle.LeaderFontName := 'Arial';
|
||
|
||
// For MS Word
|
||
// Bullet is positioned at MarginLeft - HangingIndent
|
||
lCurListLevelStyle.MarginLeft := 16.35*(i + 1);
|
||
lCurListLevelStyle.HangingIndent := 6.35 + 3*i;
|
||
end;
|
||
|
||
// ---------------------------------
|
||
// Text Span Items
|
||
// ---------------------------------
|
||
StyleTextSpanBold := AddStyle();
|
||
StyleTextSpanBold.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
|
||
StyleTextSpanBold.Name := 'Bold';
|
||
StyleTextSpanBold.Font.Bold := True;
|
||
StyleTextSpanBold.Brush.Style := bsClear;
|
||
StyleTextSpanBold.SetElements := StyleTextSpanBold.SetElements + [spbfFontBold];
|
||
|
||
StyleTextSpanItalic := AddStyle();
|
||
StyleTextSpanItalic.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
|
||
StyleTextSpanItalic.Name := 'Italic';
|
||
StyleTextSpanItalic.Font.Italic := True;
|
||
StyleTextSpanItalic.Brush.Style := bsClear;
|
||
StyleTextSpanItalic.SetElements := StyleTextSpanItalic.SetElements + [spbfFontItalic];
|
||
|
||
StyleTextSpanUnderline := AddStyle();
|
||
StyleTextSpanUnderline.Kind := vskTextSpan; // This implies this style should not be applied to Paragraphs
|
||
StyleTextSpanUnderline.Name := 'Underline';
|
||
StyleTextSpanUnderline.Font.Underline := True;
|
||
StyleTextSpanUnderline.Brush.Style := bsClear;
|
||
StyleTextSpanUnderline.SetElements := StyleTextSpanUnderline.SetElements + [spbfFontUnderline];
|
||
end;
|
||
|
||
function TvVectorialDocument.GetStyleCount: Integer;
|
||
begin
|
||
Result := FStyles.Count;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetStyle(AIndex: Integer): TvStyle;
|
||
begin
|
||
Result := TvStyle(FStyles.Items[AIndex]);
|
||
end;
|
||
|
||
function TvVectorialDocument.FindStyleIndex(AStyle: TvStyle): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to GetStyleCount()-1 do
|
||
if GetStyle(i) = AStyle then Exit(i);
|
||
end;
|
||
|
||
function TvVectorialDocument.GetListStyleCount: Integer;
|
||
begin
|
||
Result := FListStyles.Count;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetListStyle(AIndex: Integer): TvListStyle;
|
||
begin
|
||
Result := TvListStyle(FListStyles.Items[AIndex]);
|
||
end;
|
||
|
||
function TvVectorialDocument.FindListStyleIndex(AListStyle: TvListStyle): Integer;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
Result := -1;
|
||
for i := 0 to GetListStyleCount()-1 do
|
||
if GetListStyle(i) = AListStyle then Exit(i);
|
||
end;
|
||
|
||
|
||
{@@
|
||
Clears all data in the document
|
||
}
|
||
// GM: Release memory for each page
|
||
procedure TvVectorialDocument.Clear;
|
||
var
|
||
i: integer;
|
||
p: TvPage;
|
||
begin
|
||
for i:=0 to FStyles.Count-1 do
|
||
TvStyle(FStyles[i]).Free;
|
||
FStyles.Clear;
|
||
|
||
for i:=0 to FListStyles.Count-1 do
|
||
TvListStyle(FListStyles[i]).Free;
|
||
FListStyles.Clear;
|
||
|
||
for i:=FPages.Count-1 downto 0 do
|
||
begin
|
||
p := TvPage(FPages[i]);
|
||
p.Clear;
|
||
FreeAndNil(p);
|
||
end;
|
||
FPages.Clear;
|
||
FCurrentPageIndex:=-1;
|
||
end;
|
||
|
||
function TvVectorialDocument.GetRenderer: TvRenderer;
|
||
begin
|
||
Result := FRenderer;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.SetRenderer(ARenderer: TvRenderer);
|
||
begin
|
||
ClearRenderer();
|
||
FRenderer := ARenderer;
|
||
end;
|
||
|
||
procedure TvVectorialDocument.ClearRenderer;
|
||
begin
|
||
if FRenderer <> nil then FreeAndNil(FRenderer);
|
||
end;
|
||
|
||
procedure TvVectorialDocument.GenerateDebugTree(ADestRoutine: TvDebugAddItemProc; APageItem: Pointer);
|
||
var
|
||
i, lTmpInt: integer;
|
||
p: TvPage;
|
||
lPageItem: Pointer;
|
||
lDebugStr: string;
|
||
lTmpY: Double;
|
||
begin
|
||
for i:=0 to FPages.Count-1 do
|
||
begin
|
||
p := TvPage(FPages[i]);
|
||
|
||
lDebugStr := 'Origin=';
|
||
p.GetNaturalRenderPos(lTmpInt, lTmpY);
|
||
if lTmpY > 0 then
|
||
lDebugStr += 'top-left'
|
||
else
|
||
lDebugStr += 'bottom-left';
|
||
|
||
|
||
lPageItem := ADestRoutine(Format('Page %d : %s %s Width=%f Height=%f MinX=%f MaxX=%f MinY=%f MaxY=%f',
|
||
[i, p.ClassName, lDebugStr, p.Width, p.Height, p.MinX, p.MaxX, p.MinY, p.MaxY]), APageItem);
|
||
p.GenerateDebugTree(ADestRoutine, lPageItem);
|
||
end;
|
||
end;
|
||
|
||
{ TvCustomVectorialReader }
|
||
|
||
class function TvCustomVectorialReader.GetTextContentsFromNode(ANode: TDOMNode): DOMString;
|
||
var
|
||
lNodeTextTmp: DOMString;
|
||
lContentNode: TDOMNode;
|
||
begin
|
||
Result := '';
|
||
|
||
for lContentNode in ANode.GetEnumeratorAllChildren() do
|
||
begin
|
||
if lContentNode is TDOMText then
|
||
lNodeTextTmp := TDOMText(lContentNode).TextContent
|
||
else if lContentNode is TDOMEntityReference then
|
||
begin
|
||
lNodeTextTmp := UTF8LowerCase(lContentNode.NodeName);
|
||
case lNodeTextTmp of
|
||
'pi': lNodeTextTmp := 'π';
|
||
'invisibletimes': lNodeTextTmp := '';
|
||
else
|
||
lNodeTextTmp := '';//lContentNode.NodeName;
|
||
end;
|
||
end
|
||
else
|
||
lNodeTextTmp := lContentNode.NodeName;
|
||
|
||
Result := Result + lNodeTextTmp;
|
||
end;
|
||
end;
|
||
|
||
class function TvCustomVectorialReader.RemoveLineEndingsAndTrim(AStr: string): string;
|
||
begin
|
||
Result := Trim(AStr);
|
||
Result := StringReplace(Result, #13, '', [rfReplaceAll]);
|
||
Result := StringReplace(Result, #10, '', [rfReplaceAll]);
|
||
end;
|
||
|
||
constructor TvCustomVectorialReader.Create;
|
||
begin
|
||
inherited Create;
|
||
end;
|
||
|
||
procedure TvCustomVectorialReader.ReadFromFile(AFileName: string; AData: TvVectorialDocument);
|
||
var
|
||
FileStream: TFileStream;
|
||
begin
|
||
FFilename := AFilename;
|
||
FileStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyNone);
|
||
try
|
||
ReadFromStream(FileStream, AData);
|
||
finally
|
||
FileStream.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvCustomVectorialReader.ReadFromStream(AStream: TStream;
|
||
AData: TvVectorialDocument);
|
||
var
|
||
AStringStream: TStringStream;
|
||
AStrings: TStringList;
|
||
begin
|
||
AStringStream := TStringStream.Create('');
|
||
AStrings := TStringList.Create;
|
||
try
|
||
AStringStream.CopyFrom(AStream, AStream.Size);
|
||
AStringStream.Seek(0, soFromBeginning);
|
||
AStrings.Text := AStringStream.DataString;
|
||
ReadFromStrings(AStrings, AData);
|
||
finally
|
||
AStringStream.Free;
|
||
AStrings.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvCustomVectorialReader.ReadFromStrings(AStrings: TStrings;
|
||
AData: TvVectorialDocument);
|
||
var
|
||
AStringStream: TStringStream;
|
||
begin
|
||
AStringStream := TStringStream.Create('');
|
||
try
|
||
AStringStream.WriteString(AStrings.Text);
|
||
AStringStream.Seek(0, soFromBeginning);
|
||
ReadFromStream(AStringStream, AData);
|
||
finally
|
||
AStringStream.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvCustomVectorialReader.ReadFromXML(ADoc: TXMLDocument; AData: TvVectorialDocument);
|
||
begin
|
||
end;
|
||
|
||
{ TsCustomSpreadWriter }
|
||
|
||
constructor TvCustomVectorialWriter.Create;
|
||
begin
|
||
inherited Create;
|
||
end;
|
||
|
||
{@@
|
||
Default file writting method.
|
||
|
||
Opens the file and calls WriteToStream
|
||
|
||
@param AFileName The output file name.
|
||
If the file already exists it will be replaced.
|
||
@param AData The document to be saved.
|
||
|
||
@see TsWorkbook
|
||
}
|
||
procedure TvCustomVectorialWriter.WriteToFile(AFileName: string; AData: TvVectorialDocument);
|
||
var
|
||
OutputFile: TFileStream;
|
||
begin
|
||
OutputFile := TFileStream.Create(AFileName, fmCreate or fmOpenWrite);
|
||
try
|
||
WriteToStream(OutputFile, AData);
|
||
finally
|
||
OutputFile.Free;
|
||
end;
|
||
end;
|
||
|
||
{@@
|
||
The default stream writer just uses WriteToStrings
|
||
}
|
||
procedure TvCustomVectorialWriter.WriteToStream(AStream: TStream;
|
||
AData: TvVectorialDocument);
|
||
var
|
||
lStringList: TStringList;
|
||
begin
|
||
lStringList := TStringList.Create;
|
||
try
|
||
WriteToStrings(lStringList, AData);
|
||
lStringList.SaveToStream(AStream);
|
||
finally
|
||
lStringList.Free;
|
||
end;
|
||
end;
|
||
|
||
procedure TvCustomVectorialWriter.WriteToStrings(AStrings: TStrings;
|
||
AData: TvVectorialDocument);
|
||
begin
|
||
|
||
end;
|
||
|
||
finalization
|
||
|
||
SetLength(GvVectorialFormats, 0);
|
||
|
||
end.
|
||
|