mirror of
http://gitlab.expertsoft.com.ua/git/expertcad
synced 2026-01-11 17:25:39 +02:00
8306 lines
254 KiB
ObjectPascal
8306 lines
254 KiB
ObjectPascal
unit DrawEngine;
|
||
interface
|
||
uses
|
||
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
|
||
Printers, ExtCtrls,math,PCTypesUtils,RichEdit,ComCtrls,RichEdit2,olectnrs,ActiveX,
|
||
U_Common_Classes, Parser10,rrEllipses,OpenGL {Tolik--27-05-2017--},GDIPlus, GDIPAPI, GDIPOBJ;
|
||
type
|
||
TPoint = Windows.TPoint;
|
||
TRect = Windows.TRect;
|
||
TSize = Windows.TSize;
|
||
|
||
const
|
||
INCHES_PER_MILIMETER: Real = 0.04;
|
||
|
||
{ ExtPenStyles: array[TPenStyle] of Word =
|
||
(PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL, PS_INSIDEFRAME); //01.11.2011}
|
||
ExtPenStyles: array[TPenStyle] of TPenStyle =
|
||
(psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear,
|
||
psInsideFrame, psUserStyle, psAlternate);
|
||
type
|
||
TOffset = record
|
||
X, Y: Integer;
|
||
end;
|
||
|
||
TExtPen = class(TObject)
|
||
FhPen: HPEN;
|
||
end;
|
||
|
||
TPCDrawEngine = class(TObject)
|
||
private
|
||
FCanvas: TCanvas;
|
||
comp: TBitmap;
|
||
protected
|
||
FCachePen: Boolean; //01.11.2011
|
||
FPens: TStringList;
|
||
|
||
Procedure SetCanvas(value: TCanvas);
|
||
procedure drawlinePix(x1,y1,x2,y2,color,aWidth,style,row: integer);overload;
|
||
procedure drawlinePix(p1,p2:TPoint; row: Integer);overload;
|
||
procedure drawlinePixD(x1,y1,x2,y2: Double;color,aWidth,style,row: integer);
|
||
function ExtCreatePenMy(aCanva: TCanvas): HPEN;
|
||
|
||
public
|
||
ConvertPoint: ConvertXYProc;
|
||
ConvertLen : ConvertDimProc;
|
||
DeConvertPoint: ConvertXYProc;
|
||
DeConvertLen : ConvertDimProc;
|
||
PrintBmp: TBitmap;
|
||
isPrinting: Boolean;
|
||
Tag: Integer;
|
||
Isometric: Boolean;
|
||
ClipRgn : HRGN;
|
||
ExClip: HRGN;
|
||
|
||
FPrinting: Boolean; //01.11.2011
|
||
property CachePen: Boolean read FCachePen write FCachePen; //01.11.2011
|
||
|
||
// procedure PenCh(aObject: TObject);
|
||
Procedure ConvertCoord (var X,Y,Z: Double);
|
||
function ConvertCoordToPt(const pt: TDoublePoint): TPoint; //31.10.2011
|
||
Procedure ConvertDim (var Dim: Double);
|
||
Procedure DeConvertCoord (var X,Y,Z: Double);
|
||
Procedure DeConvertDim (var Dim: Double);
|
||
Function GetVertDirection:Integer;
|
||
Function GetHorzDirection:Integer;
|
||
Procedure CalcRowPoints(x1, y1, x2, y2: Double; hl, hh: double; var r1, r2, r3: TDoublePoint);
|
||
Procedure drawrow(x1,y1,x2,y2: Double; solid: Boolean;hl:double=5;hh:double=3);overload;
|
||
Procedure drawrow(x1,y1,x2,y2: Double; solid: Boolean;var reg:HRGN;hl:double=5;hh:double=3);overload;
|
||
Procedure drawrowpix(x1,y1,x2,y2,h,w: integer; solid: Boolean);
|
||
Procedure drawrow(xp1,xp2: TDoublePoint; solid: Boolean;var rgn:HRGN;hl:double=5;hh:double=3);overload;
|
||
|
||
Procedure MoveTo(p:TDoublePoint);
|
||
Procedure LineTo(p:TDoublePoint);
|
||
Procedure MoveToPix(x1,y1:Double);
|
||
Procedure LineToPix(x1,y1:Double);
|
||
Procedure BezierTo(cx1,cy1,cx2,cy2,ex,ey:Double);
|
||
Procedure Polygon(const p: TDoublePointArr;var RegHandle: HRGN; ADrawPoints: Pointer=nil);
|
||
Procedure WPolygon(const p:array of TPoint;var RegHandle: HRGN; ADrawPoints: Pointer=nil);
|
||
Procedure WPolyline(const p:array of TPoint);
|
||
Function PolygonRegion(const p: TDoublePointArr):HRGN;overload;
|
||
Function PolygonRegion(p1,p2,p3,p4: TDoublePoint):HRGN;overload;
|
||
Function PolygonRegion(p1,p2,p3,p4: TPoint):HRGN;overload;
|
||
Function PolygonRegion(p: TPointArr):HRGN;overload;
|
||
Procedure Polyline(p: TDoublePointArr);
|
||
Procedure RectanglePix(x1,y1,x2,y2:Double);
|
||
Procedure EllipsePix(x1,y1,x2,y2:Double);
|
||
Procedure DrawVane(p1,p2:TDoublePoint; pColor,bColor:TColor; Dim,Mar:Double;
|
||
HasFlans: Boolean; var RegHandle:HRGN;kortapa:Boolean;Covered:Boolean;
|
||
SeloDist:Double;st:Integer;penS:Integer=0);
|
||
Procedure DrawCover(p1,p2,p3,p4:TDoublePoint;aColor:TColor;dConvert:Boolean);
|
||
Procedure DrawFlansh(p1,p2:TDoublePoint; pColor,bColor:TColor; Dim,Mar,Len:Double; var RegHandle:HRGN;st:Integer);
|
||
Procedure DrawFiltre(p1,p2:TDoublePoint; pColor,bColor:TColor; Dim,Mar,Len:Double; var RegHandle:HRGN;st:Integer);
|
||
Procedure DrawToprak(p1,p2:TDoublePoint; pColor,bColor:TColor; Dim,Mar:Double; var RegHandle:HRGN;st:Integer;pos:Integer);
|
||
Procedure DrawKatod(p1,p2: TDoublePoint; Color: TColor; var RegHandle: HRGN);
|
||
Procedure DrawRegulator(p1,p2:TDoublePoint; pColor,bColor,npColor:TColor; Dim,Mar:Double; var RegHandle:HRGN;covered:Boolean;st:Integer);
|
||
Procedure DrawIsoKombi(p1,p2:TDoublePoint; pColor,bColor:TColor; rad1,rad2:Double; var RegHandle:HRGN;covered:Boolean;st:Integer);
|
||
Procedure DrawIsoSofben(p1,p2:TDoublePoint; pColor,bColor:TColor; rad1:Double; var RegHandle:HRGN;st:Integer);
|
||
Procedure DrawIsoOcak(p1,p2:TDoublePoint; pColor,bColor:TColor; size:Double; var RegHandle:HRGN;st:Integer);
|
||
Procedure DrawIsoGnCihaz(p1,p2:TDoublePoint; pColor,bColor:TColor; size:Double; var RegHandle:HRGN;st:Integer);
|
||
Procedure DrawIsoSoba(p1,p2:TDoublePoint; pColor,bColor:TColor; w,h:Double; var RegHandle:HRGN;st:Integer);
|
||
procedure drawline(x1,y1,x2,y2:Double;color,awidth,style,row: integer; rowL:Double=3.5;rowH:Double=1.2;rowWhite:Boolean=False);overload;
|
||
procedure drawline(p1,p2:TDoublePoint;color,awidth,style,row: integer; rowL:Double=3.5;rowH:Double=1.2;rowWhite:Boolean=False);overload;
|
||
procedure DrawPatternLine(p1, p2: TDoublePoint; color, awidth,style: integer;Pattern:TObject);
|
||
procedure drawline(p1,p2:TDoublePoint);overload;
|
||
procedure drawDashLine(p1,p2:TDoublePoint);
|
||
Procedure SetCanvasValues(PenColor,BrushColor:TColor; PenWidth : Integer; PenStyle : TPenStyle; BrushStyle:TBrushStyle; PenMode: TPenMode);overload;
|
||
Procedure SetCanvasValues(PenColor,BrushColor:TColor; PenWidth : Integer; PenStyle : TPenStyle; BrushStyle:TBrushStyle);overload;
|
||
Procedure SetCanvasValues(PenColor,BrushColor:TColor; PenWidth , PenStyle , BrushStyle: Integer; PenMode: TPenMode);overload;
|
||
Function LineRegion(p1,p2:TDoublePoint;w:Double):HRGN;
|
||
Procedure drawpolyline(points: TDoublePointArr; color,awidth,style,row: integer);overload;
|
||
Procedure drawpolyline(points:TDoublePointArr; Closed: Boolean);overload;
|
||
procedure drawrect(x1,y1,x2,y2:Double;color,awidth,style,bc,bs: integer);overload;
|
||
Procedure DrawRect(p1:TDoublePoint;rw,rh:Double;color,awidth,style,bc,bs: integer;var rgn:HRGN);overload;
|
||
procedure drawrect(p1,p2:TDoublePoint;color,awidth,style,bc,bs: integer);overload;
|
||
procedure drawrect(p1,p2,p3,p4:TDoublePoint;color,awidth,style,bc,bs: integer;var rgn:HRGN);overload;
|
||
procedure drawpolygon(const points: TDoublePointArr; color,awidth,style,bc,bs: integer; var rgn: HRGN;brsBmp:TBitmap=nil; ADrawPoints: Pointer=nil);overload;
|
||
procedure drawpolygon(p1,p2,p3,p4:TDoublePoint; color,awidth,style,bc,bs: integer);overload;
|
||
procedure drawpolygon(p1,p2,p3,p4:TDoublePoint; color,awidth,style,bc,bs: integer;var rgn: HRGN);overload;
|
||
Procedure FillRgn(rgn:HRGN;bc,bs:Integer);
|
||
// Tolik -- 31/05/2017 --
|
||
//procedure DrawPie(x1, y1, x2, y2 : double; bc, bs, CutStyle: Integer; var rgn:HRGN; cp:TDoublePoint; Fangle, SAngle, Radius, aCutRadius: Double);
|
||
procedure DrawPie(bc, bs, CutStyle: Integer; var rgn:HRGN; cp:TDoublePoint; Fangle, SAngle, Radius, aCutRadius: Double);
|
||
procedure DrawPieRGB(x1, y1, x2, y2, x3, y3, x4, y4 : double; bc, bs: Integer; var rgn:HRGN;cp, ap2, ap3:TDoublePoint; Fangle, SAngle, Rad: Double);
|
||
procedure DrawPieShadow(ap1: TDoublePoint; Radius, Sangle, Fangle, cutRadius: Double; cutStyle: integer);
|
||
//
|
||
// Tolik 26/05/2017 --
|
||
//Procedure FillRect(rect:TDoubleRect;bc,bs:Integer);
|
||
Procedure FillRect(rect:TDoubleRect; bc,bs:Integer; aTransparency: Integer = 0);
|
||
//
|
||
//Tolik 24/11/2019 --
|
||
//Function CreateArcRegion(cx,cy,rad,a1,a2:Double):Integer;
|
||
Function CreateArcRegion(cx,cy,rad,a1,a2:Double): HRGN;
|
||
//Function CreateDoubleArcRegion(cx,cy,rad1,rad2,a1,a2,a3,a4:Double):Integer;
|
||
Function CreateDoubleArcRegion(cx,cy,rad1,rad2,a1,a2,a3,a4:Double):HRGN;
|
||
//
|
||
Procedure AddBezArcPoints(var dPoints:TDoublePointArr; cp:TDoublePoint;rad,a1,a2:Double;dirPoint:TDoublePoint);
|
||
//Tolik 24/11/2019 --
|
||
Function BezierRegion(bPoints:TDoublePointArr): HRGN;
|
||
//
|
||
Procedure drawbezarc(cx,cy,rad,a1,a2:Double;color,awidth,style,bc,bs,arcstyle: integer;
|
||
var rgn:HRGN; var p1,p2: TDoublePoint;inCombined:Boolean;row:Integer; rowL:double=3.5;rowH:double=1.2);
|
||
Procedure drawbezelparc(cx,cy,radA,radB,a1,a2,angle:Double;color,awidth,style,bc,bs,arcstyle: integer;
|
||
var rgn:HRGN; var p1,p2: TDoublePoint;inCombined:Boolean;row:Integer);
|
||
Procedure drawbezierellipse(cx,cy,radA,radB,angle:Double;color,awidth,style,bc,bs:Integer;
|
||
var rgn:HRGN; inCombined:Boolean);
|
||
|
||
procedure DrawCircle(cx,cy,rad: Double;color,awidth,style,bc,bs: integer;var rgn:HRGN;inCombined:Boolean;Hatched:Boolean=False);overload;
|
||
procedure DrawCircle(cp:TDoublePoint;rad:Double;color,awidth,style,bc,bs: integer;var rgn:HRGN;Hatched:Boolean=False);overload;
|
||
// Tolik -- 19/08/2017 --
|
||
Procedure DrawOverLappedCircle(ap1x, ap1y, ap2x, ap2y, radius, CutRadius: Double; acolor, aawidth, style, bcolor, GDIbrs: Integer;var RegHandle:Hrgn; InCombined: Boolean; Hatched: Boolean = False);
|
||
Procedure DrawOverLappedEllipse(ap1x, ap1y, ap2x, ap2y, radius, radius1, CutRadius, CutRadius1: Double; acolor, aawidth,style,bcolor,GDIbrs: integer;var RegHandle: HRGN);
|
||
//
|
||
Procedure DrawCross(p:TdoublePoint;color,awidth,style:Integer;dim:Double;Rotated:Boolean=True);
|
||
procedure DrawCircle(p1: TDoublePoint;rad: Double);overload;
|
||
procedure DrawPoint(p1: TDoublePoint);overload;
|
||
procedure DrawPoint(p1: TDoublePoint;color:TColor);overload;
|
||
procedure DrawCirclePix(cx,cy,rad,color,awidth,style,bc,bs: integer;var rgn:HRGN);overload;
|
||
procedure drawbezier(points:TDoublePointArr;
|
||
nbrPoint,color,awidth,style,brc,brs:integer;Filled,InCombined:Boolean;
|
||
pattern:Tobject;var RegHandle:HRGN;row:Integer;rowL,rowH:Double;brsBmp:TBitmap=nil);overload;
|
||
procedure drawbezier(points:TDoublePointArr; color,awidth,style:integer);overload;
|
||
|
||
procedure drawpatbezier(points:TDoublePointArr;
|
||
nbrPoint,color,awidth,style,brc,brs:integer;Filled:Boolean;
|
||
pattern:Tobject);
|
||
|
||
procedure drawbezier(p1,p2,p3,p4: TDoublePoint);overload;
|
||
|
||
procedure drawCurve(points: TDoublePointArr; color,awidth,style: integer);
|
||
procedure drawcurvesegment(p1,p2:TDoublepoint);
|
||
Procedure TraceText(p1: TDoublePoint;Color:TColor;Text,FontName:String;FontSize:Integer);
|
||
Procedure DrawCenteredText(p1: TDoublePoint;Color:TColor;Text,FontName:String;FontSize:Integer;Angle:Double);overload;
|
||
Procedure DrawCenteredText(p1: TDoublePoint;Color:TColor;Text,FontName:String;FontSize:Double;Angle:Double);overload;
|
||
Procedure DrawCenteredText(p1: TPoint;Color:TColor;Text,FontName:String;FontSize:Double;Angle:Double);overload;
|
||
Procedure DrawCenteredText(p1: TDoublePoint;Color:TColor;Text,FontName:String;FontSize:Double);overload;
|
||
|
||
|
||
Procedure DrawLabel(r1,r2:TDoublePoint;aText: String; afont: Tfont;
|
||
aheight:Double;pcolor,awidth,style,bc,bs: integer;var rgn:HRGN);
|
||
Procedure GetTextLens(var TextLen,TextH:Double;atext: string; afont: Tfont;aheight,CWidth,CSpace: double);
|
||
Function SetCanvasFont(FName:String;FHeight,CWidth,CSpace,Angle:Double; Styles: TFontStyles;Charset:Byte;FColor:TColor):TFont;
|
||
Procedure ResetCanvasFont(oldFont:TFont);
|
||
Procedure GDIDrawText(r1,r2,r3,r4:TDoublePoint;Text:String;vAlign:TTextVAlign;hAlign:TTextHAlign);
|
||
Procedure Drawtext(ap1,ap2,ap3,a4: TDoublePoint;angle:Double;
|
||
atext: string; afont: Tfont;
|
||
aheight,CWidth,CSpace: double;
|
||
var nH,nl:Integer);overload;
|
||
Procedure Drawtext(ap1,ap2,ap3,a4: TDoublePoint;angle:Double;
|
||
atext: string; fontName: String;aColor:TColor;
|
||
aheight,CWidth,CSpace: double;
|
||
var nH,nl:Integer);overload;
|
||
Procedure Drawtext(ap1,ap2,ap3,a4: TPoint;angle:Double;
|
||
atext: string; fontName: String;aColor:TColor;
|
||
aheight: double);overload;
|
||
|
||
procedure Drawtext(ap1: TDoublePoint; angle: Double; atext,afontName: String;
|
||
Styles:TFontStyles;aColor:TColor;aheight: double; marx:double = 0;mary:double=0);overload;
|
||
procedure Drawtext(ap1: TDoublePoint; atext:TstringList;
|
||
afontName: String;Styles:TFontStyles;aColor:TColor;aheight: double;
|
||
marx:double = 0;mary:double=0);overload;
|
||
procedure Drawtext(ap1: TDoublePoint; atext:TstringList;
|
||
afontName: String;Styles:TFontStyles;aColor:TColor;aheight: double;var Region:HRGN;
|
||
var tw,th: Double;
|
||
marx:double = 0;mary:double=0);overload;
|
||
procedure DrawMtextToCanvas(ap1: TPoint;atext: TstringList; afontName:String;
|
||
Styles: TFontStyles;aColor: TColor; aSize,aHeight,marX,marY,limitH: Integer;
|
||
var Region: HRGN; var tw,th: Integer; FCanvas: TCanvas);
|
||
|
||
|
||
Procedure TextToRect(p1,p2,p3,p4: TDoublePoint; aText: String; aFont: TFont; CSpace:Double; var w,h: Double);
|
||
Procedure DrawAlignedText(xp1,xp2: TDoublePoint; atext: string;
|
||
fontName: TFontName; aColor: integer;aheight: double);
|
||
Procedure DrawHDim(ap1,ap2,ap3:TDoublepoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight:Double; LStyle:THDimLabelStyle;TextPos:TDimTextPos;et: TEndType;
|
||
var Reghandle: HRGN);
|
||
Procedure DrawVDim(ap1,ap2,ap3:TDoublepoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:TVDimLabelStyle;TextPos:TDimTextPos;et:TEndType;
|
||
var Reghandle: HRGN);
|
||
Procedure DrawAlignedDim(ap1,ap2,ap3:TDoublepoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:TADimLabelStyle;TextPos:TDimTextPos;et: TEndType;
|
||
tHorz: Boolean;var Reghandle: HRGN);
|
||
Procedure DrawCircleDim(ap1,ap2:TDoublepoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:TCDimLabelStyle;TextPos:TDimTextPos;et: TEndType;
|
||
tHorz: Boolean; DrawOuterGuide,DrawInnerGuide:Boolean; var Reghandle: HRGN);
|
||
Procedure DrawArcDim(ap1: TDoublePoint;Radius,SAngle,FAngle:Double;dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight,GuideLen: Double; LStyle:TArcDimLabelStyle;var Reghandle: HRGN;var p1,p2: TDoublePoint);
|
||
|
||
|
||
Function CreateRectRegion(x1,y1,x2,y2:Double):HRGN;
|
||
Procedure DrawRTF(re: TRichEdit98; x1,y1,x2,y2: integer);
|
||
Procedure DrawRTFToCanvas(re: TRichEdit98; x1,y1,x2,y2: Double; xCanvas: Tcanvas; Convert: Boolean);
|
||
Procedure DrawOLEToCanvas(ole: TOleContainer; x1,y1,x2,y2: Double; xCanvas: Tcanvas; Convert: Boolean);
|
||
Procedure DrawMetafile(p1,p2,p3,p4: TDoublepoint;color,awidth,style: Integer;
|
||
metafile: TMetafile; stretch:Boolean;var RegHandle:HRGN);
|
||
Procedure DrawTransparentMetafile(p1,p2,p3,p4: TDoublepoint;color,awidth,style:Integer;
|
||
metafile: TMetafile; var RegHandle: HRGN);
|
||
|
||
Procedure DrawMathGraph(cRect:TDoubleRect;cx,cy:Double;color,awidth,style,ScaleColor:Integer;
|
||
OneUnit:double;Source:String;DrawTick,DrawNumbers,isPolar:Boolean;NumStep:Double);
|
||
procedure drawselectionpoint(x,y,z: Double; pType: TPointType; dim :double; col : TColor; isXOR:Boolean = False);
|
||
procedure drawellipse(x,y,a,b,xangle: Double;lines: integer;color,awidth,style,bc,bs: integer;
|
||
var Reghandle: HRGN; var BoundRect: TDoubleRect);overload;
|
||
procedure drawEllipse(p1: TDoublePoint;ax,bx: Double;angle:Double);overload;
|
||
Procedure DrawEllipticArc(x,y,a,b,xangle: Double; startangle: Double;
|
||
drawangle: Double;lines:integer;color,awidth,style,bc,bs,arcStyle: integer;
|
||
var lp1,lp2: TPoint;var regHandle: HRGN;var BoundRect: TDoublerect);
|
||
Procedure DrawFigureIcon(fRect: TDoubleRect; ix,iy: Double;vpos: TIconVertPos;hPos: TIconHorzPos; Icon: Tbitmap);
|
||
//Tolik 20/10/2021 --
|
||
{
|
||
Procedure DrawPicture(ap1,ap2,ap3,ap4: TDoublepoint;color,awidth,style: integer;
|
||
isTransparent: Boolean;
|
||
var Modified: Boolean; Picture : TBitmap;
|
||
Var Image: TBitmap;
|
||
var aImageEdited: Boolean; // Tolik 20/04/20108 --
|
||
DoFlip:Boolean; isDeformed: Boolean;var RegHandle: HRGN;Tiled:Boolean=False);
|
||
}
|
||
Procedure DrawPicture(ap1,ap2,ap3,ap4: TDoublepoint;color,awidth,style: integer;
|
||
isTransparent: Boolean;
|
||
var Modified: Boolean; Picture : TBitmap;
|
||
Var Image: TBitmap;
|
||
var aImageEdited: Boolean; // Tolik 20/04/20108 --
|
||
DoFlip:Boolean; isDeformed: Boolean;var RegHandle: HRGN;Tiled:Boolean=False;
|
||
GrayColor: TColor = -1);
|
||
//
|
||
Procedure DrawBitmap(p1,p2,p3,p4: TDoublepoint;color,awidth,style: integer;
|
||
isTransparent: Boolean;
|
||
Bitmap : TBitmap);
|
||
//Tolik 20/10/2021 --
|
||
//Function MakeBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap;isTrans:Boolean): Boolean;
|
||
Function MakeBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap;isTrans:Boolean; GrColor: TColor = -1): Boolean;
|
||
//
|
||
Function SkewBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap;isTrans:Boolean): Boolean;
|
||
Procedure RotateBitmap(var BitmapOriginal,BitmapRotated: TBitmap; Teta: Double; isTrans: Boolean);
|
||
Function isRotated(p1,p2,p3,p4: TPoint):Boolean;
|
||
constructor create;
|
||
destructor Destroy; override;
|
||
Procedure Clip(clpRgn:HRGN);
|
||
Procedure ClipBack;
|
||
Procedure ClipAnd(clpRgn:HRGN);
|
||
Procedure SetUpOpenGL(Wnd:HWND);
|
||
Procedure GLInit;
|
||
Procedure GLPaint;
|
||
procedure ClearPens;
|
||
procedure DefinePrinting;
|
||
function ExtractExtPenByCanvas: HPEN; //01.11.2011
|
||
function IsPointInRegion(aReg: Integer; pt: PDoublePoint): Boolean;
|
||
|
||
Property Canvas:TCanvas read FCanvas write setCanvas;
|
||
|
||
end;
|
||
|
||
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap; ROP: Integer);
|
||
|
||
procedure stretchDrawGraphics(ACanvas : TCanvas; R : TRect;
|
||
Graphic: TGraphic; transparent : boolean);
|
||
|
||
Function ProcessRichRecord(DC:HDC; HT:PHandleTable; rec:PEnhMetaRecord;
|
||
count:integer; param: pointer): integer;stdcall;
|
||
var psCustomDash : Byte = 7;
|
||
|
||
FDeviceName: string; {<7B><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
|
||
FPageHeightPixel, FPageWidthPixel: Integer; {<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
FOrientation: TPrinterOrientation; {<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
FPrintOffsetPixels: TOffset;
|
||
FPixelsPerMMX, FPixelsPerMMY: Real;
|
||
MMSize, FPageHeightMM: Integer;
|
||
TheReport, TheHead, HeadLine, RecordLine, TFname, TLname: string;
|
||
|
||
|
||
|
||
implementation
|
||
|
||
Uses DrawObjects, U_BaseCommon, U_Layers;
|
||
|
||
var FirstEMRText: Boolean;
|
||
|
||
|
||
Constructor TPCDrawEngine.create;
|
||
begin
|
||
inherited create;
|
||
FCanvas := TCanvas.Create;
|
||
comp := TBitmap.Create;
|
||
Tag := 0;
|
||
Isometric:= False;
|
||
ClipRgn := 0;
|
||
|
||
FPrinting := false; //01.11.2011
|
||
FCachePen := false; //01.11.2011
|
||
FPens := TStringList.Create; //01.11.2011
|
||
FPens.Sorted := true;
|
||
end;
|
||
|
||
destructor TPCDrawEngine.Destroy;
|
||
begin
|
||
ClearPens;
|
||
FPens.Free;
|
||
if ClipRgn <> 0 then
|
||
DeleteObject(ClipRgn);
|
||
if ExClip <> 0 then
|
||
DeleteObject(ExClip);
|
||
// Tolik
|
||
if Assigned(Comp) then
|
||
Comp.free;
|
||
//
|
||
inherited;
|
||
end;
|
||
|
||
procedure DrawAlphaAPI(Source: TBitmap; Destination: TCanvas;
|
||
const X, Y: Integer; const Opacity: Byte = 255);
|
||
var BlendFunc: TBlendFunction;
|
||
begin
|
||
BlendFunc.BlendOp := AC_SRC_OVER;
|
||
BlendFunc.BlendFlags := 0;
|
||
BlendFunc.SourceConstantAlpha := Opacity;
|
||
|
||
if Source.PixelFormat = pf32bit then
|
||
BlendFunc.AlphaFormat := AC_SRC_ALPHA
|
||
else
|
||
BlendFunc.AlphaFormat := 0;
|
||
|
||
Windows.AlphaBlend(Destination.Handle, X, Y, Source.Width, Source.Height,
|
||
Source.Canvas.Handle, 0, 0, Source.Width, Source.Height, BlendFunc);
|
||
end;
|
||
|
||
// 06/11/2017 Tolik -- <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> GDI, <20><> <20><>-<2D><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> BMP-<2D><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>,
|
||
// <20><>-<2D><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> BMP-<2D><><EFBFBD><EFBFBD><EFBFBD> .... -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
procedure DrawOpacityBrush(ACanvas: TCanvas; aRect: TRect; X, Y: Integer; AColor: TColor; Opacity: Byte);
|
||
var
|
||
ColorRgb: Integer;
|
||
ColorR, ColorG, ColorB: Byte;
|
||
GDIBrush : TGPSolidBrush;
|
||
Grap : TGPGraphics;
|
||
//SemiTransBrush : TGPSolidBrush;
|
||
|
||
begin
|
||
ColorRgb := ColorToRGB(AColor);
|
||
ColorR := GetRValue(ColorRgb);
|
||
ColorG := GetGValue(ColorRgb);
|
||
ColorB := GetBValue(ColorRgb);
|
||
|
||
GDiBrush := TGPSolidBrush.Create(GdiPapi.MakeColor(Opacity, ColorR, ColorG, ColorB));
|
||
Grap := TGPGraphics.Create(ACanvas.Handle);
|
||
Grap.FillRectangle(GDIBrush, GdiPapi.MakeRect(aRect.Left,aRect.Top,(aRect.Right - aRect.Left), (aRect.Bottom - aRect.Top) ));
|
||
grap.Free;
|
||
GDIBrush.Free;
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.setCanvas(value: TCanvas);
|
||
Begin
|
||
if value <> FCanvas then
|
||
EmptyProcedure;
|
||
FCanvas:= value;
|
||
|
||
// FCanvas.Pen.OnChange := PenCh;
|
||
|
||
{$ifndef designtime}
|
||
// TExtPen(FCanvas.Pen).Geometric := True;
|
||
{$endif designtime}
|
||
End;
|
||
|
||
Procedure TPCDrawEngine.ConvertCoord (var X,Y,Z: Double);
|
||
begin
|
||
if assigned(ConvertPoint) then ConvertPoint(x,y,z);
|
||
end;
|
||
|
||
function TPCDrawEngine.ConvertCoordToPt(const pt: TDoublePoint): TPoint;
|
||
var
|
||
xp: TDoublePoint;
|
||
begin
|
||
xp.x := pt.X;
|
||
xp.Y := pt.y;
|
||
xp.Z := 0;
|
||
ConvertCoord(xp.x, xp.y, xp.z);
|
||
Result := Point(Round(xp.x), Round(xp.y));
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.ConvertDim (var Dim: Double);
|
||
begin
|
||
if assigned(ConvertLen) then ConvertLen(Dim);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DeConvertCoord (var X,Y,Z: Double);
|
||
begin
|
||
if assigned(DeConvertPoint) then DeConvertPoint(x,y,z);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DeConvertDim (var Dim: Double);
|
||
begin
|
||
if assigned(DeConvertLen) then DeConvertLen(Dim);
|
||
end;
|
||
|
||
|
||
Function TPCDrawEngine.GetVertDirection:Integer;
|
||
var x1,y1,x2,y2,z: Double;
|
||
begin
|
||
x1 := 100; y1 := 100;
|
||
x2 := 200; y2 := 200;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
result := Round((y2-y1)/ abs(y2-y1));
|
||
end;
|
||
|
||
Function TPCDrawEngine.GetHorzDirection:Integer;
|
||
var x1,y1,x2,y2,z: Double;
|
||
begin
|
||
x1 := 100; y1 := 100;
|
||
x2 := 200; y2 := 200;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
result := Round((x2-x1)/ abs(x2-x1));
|
||
end;
|
||
|
||
|
||
|
||
Procedure TPCDrawEngine.MoveTo(p:TDoublePoint);
|
||
begin
|
||
ConvertCoord(p.x,p.y,p.z);
|
||
MoveToPix(p.x,p.y);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.LineTo(p:TDoublePoint);
|
||
begin
|
||
ConvertCoord(p.x,p.y,p.z);
|
||
LineToPix(p.x,p.y);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.MoveToPix(x1,y1:Double);
|
||
var
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.moveto(Round(x1),Round(y1));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
FCanvas.moveto(Round(x1),Round(y1));
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.LineToPix(x1,y1:Double);
|
||
var
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.LineTo(Round(x1),Round(y1));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
FCanvas.LineTo(Round(x1),Round(y1));
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.BezierTo(cx1,cy1,cx2,cy2,ex,ey:Double);
|
||
var Points: array [0..2] of Windows.Tpoint;
|
||
z: Double;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
z := 0;
|
||
ConvertCoord(cx1,cy1,z);
|
||
ConvertCoord(cx2,cy2,z);
|
||
ConvertCoord(ex ,ey,z);
|
||
Points[0] := DP2P(cx1,cy1);
|
||
Points[1] := DP2P(cx2,cy2);
|
||
Points[2] := DP2P(ex,ey);
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.PolyBezierTo(Points);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.PolyBezierTo(Points);
|
||
end;
|
||
end;
|
||
|
||
type
|
||
PPoints = ^TPoints;
|
||
TPoints = array[0..0] of TPoint;
|
||
|
||
Function TPCDrawEngine.PolygonRegion(const p: TDoublePointArr):HRGN;
|
||
var ip: Pointer;
|
||
i,size: Integer;
|
||
xp: TdoublePoint;
|
||
z: Double;
|
||
begin
|
||
size := Length(p);
|
||
GetMem(ip,size*8);
|
||
for i := 0 to size -1 do begin
|
||
xp := p[i];
|
||
z := 0;
|
||
ConvertCoord(xp.x,xp.y,z);
|
||
// Tolik 23/04/2019 --
|
||
//PInt(PChar(ip)+i*8+0)^:= Round(xp.x);
|
||
//PInt(PChar(ip)+i*8+4)^:= Round(xp.y);
|
||
PInt(PAnsiChar(ip)+i*8+0)^:= Round(xp.x);
|
||
PInt(PAnsiChar(ip)+i*8+4)^:= Round(xp.y);
|
||
//
|
||
end;
|
||
Result := CreatePolygonRgn(PPoints(ip)^,size,ALTERNATE);
|
||
FreeMem(ip,size*8);
|
||
end;
|
||
|
||
Function TPCDrawEngine.PolygonRegion(p1,p2,p3,p4: TDoublePoint):HRGN;
|
||
var pArr: TDoublePointArr;
|
||
begin
|
||
SetLength(pArr,4);
|
||
pArr[0] := p1;
|
||
pArr[1] := p2;
|
||
pArr[2] := p3;
|
||
pArr[3] := p4;
|
||
result := PolygonRegion(pArr);
|
||
end;
|
||
|
||
Function TPCDrawEngine.PolygonRegion(p: TPointArr):HRGN;
|
||
var ip: Pointer;
|
||
i,size: Integer;
|
||
xp:TPoint;
|
||
begin
|
||
size := Length(p);
|
||
GetMem(ip,size*8);
|
||
for i := 0 to size -1 do begin
|
||
xp := p[i];
|
||
//Tolik 23/04/2019 - -
|
||
//PInt(PChar(ip)+i*8+0)^:= xp.x;
|
||
//PInt(PChar(ip)+i*8+4)^:= xp.y;
|
||
PInt(PAnsiChar(ip)+i*8+0)^:= xp.x;
|
||
PInt(PAnsiChar(ip)+i*8+4)^:= xp.y;
|
||
//
|
||
end;
|
||
Result := CreatePolygonRgn(PPoints(ip)^,size,ALTERNATE);
|
||
FreeMem(ip,size*8);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.Polygon(const p:TDoublePointArr;var regHandle: HRGN; ADrawPoints: Pointer=nil);
|
||
var ip: Pointer;
|
||
i,size: Integer;
|
||
xp: TDoublePoint;
|
||
z: Double;
|
||
px: array of TPoint;
|
||
begin
|
||
if ADrawPoints = nil then
|
||
begin
|
||
size := Length(p);
|
||
SetLength(px,size);
|
||
for i := 0 to size -1 do begin
|
||
xp := p[i];
|
||
ConvertCoord(xp.x,xp.y,xp.z);
|
||
px[i] := Point(Round(xp.x), Round(xp.y));
|
||
end;
|
||
end;
|
||
WPolygon(px,regHandle, ADrawPoints);
|
||
{ if RegHandle <> 0 then
|
||
DeleteObject(regHandle);}
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.Polyline(p:TDoublePointArr);
|
||
var ip: Array of Windows.TPoint;
|
||
i,size: Integer;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
size := Length(p);
|
||
SetLength(ip,Size);
|
||
|
||
for i := 0 to size -1 do begin
|
||
ConvertCoord(p[i].x,p[i].y,p[i].z);
|
||
ip[i] := DP2P(p[i]);
|
||
end;
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.Polyline(ip);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.Polyline(ip);
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.EllipsePix(x1,y1,x2,y2:Double);
|
||
var
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.Ellipse(DR2R(x1,y1,x2,y2));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.Ellipse(DR2R(x1,y1,x2,y2));
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.RectanglePix(x1,y1,x2,y2:Double);
|
||
var
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.Rectangle(DR2R(x1,y1,x2,y2));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.Rectangle(DR2R(x1,y1,x2,y2));
|
||
end;
|
||
end;
|
||
procedure TPCDrawEngine.drawline(p1,p2:TDoublePoint;color,awidth,style,row: integer; rowL:Double=3.5;rowH:Double=1.2;rowWhite:Boolean=False);
|
||
begin
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.Pen.Style := psSolid;
|
||
FCanvas.Brush.Style := BSSolid;
|
||
if rowWhite then begin
|
||
FCanvas.Brush.Color := clWhite;
|
||
end else begin
|
||
FCanvas.Brush.Color := color;
|
||
end;
|
||
|
||
if row = 1 then drawrow(p1.x,p1.y,p2.x,p2.y,true,rowL,rowH)
|
||
else if row = 2 then drawrow(p2.x,p2.y,p1.x,p1.y,true,rowL,rowH)
|
||
else if row = 3 then begin
|
||
drawrow(p2.x,p2.y,p1.x,p1.y,true,rowL,rowH);
|
||
drawrow(p1.x,p1.y,p2.x,p2.y,true,rowL,rowH)
|
||
end
|
||
else if row = 4 then drawrow(p1.x,p1.y,p2.x,p2.y,false,rowL,rowH)
|
||
else if row = 5 then drawrow(p2.x,p2.y,p1.x,p1.y,false,rowL,rowH)
|
||
else if row = 6 then begin
|
||
drawrow(p2.x,p2.y,p1.x,p1.y,false,rowL,rowH);
|
||
drawrow(p1.x,p1.y,p2.x,p2.y,false,rowL,rowH)
|
||
end;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
if style = psCustomDash then begin
|
||
FCanvas.pen.style := psSolid;
|
||
drawdashline(p1,p2);
|
||
end else begin
|
||
FCanvas.pen.style := penstyles[style];
|
||
drawline(p1,p2);
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawline(x1, y1, x2, y2: Double; color, aWidth, style, row: integer;
|
||
rowL: Double = 3.5; rowH: Double = 1.2; rowWhite: Boolean = False);
|
||
begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
FCanvas.pen.style := penstyles[style];
|
||
MoveTo(DoublePoint(x1, y1));
|
||
LineTo(DoublePoint(x2, y2));
|
||
|
||
FCanvas.Pen.Style := psSolid;
|
||
FCanvas.Brush.Style := BSSolid;
|
||
if rowWhite then
|
||
begin
|
||
FCanvas.Brush.Color := clWhite;
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.Brush.Color := color;
|
||
end;
|
||
|
||
if row = 1 then
|
||
drawrow(x1, y1, x2, y2, true, rowL, rowH)
|
||
else
|
||
if row = 2 then
|
||
drawrow(x2, y2, x1, y1, true, rowL, rowH)
|
||
else
|
||
if row = 3 then
|
||
begin
|
||
drawrow(x2,y2,x1,y1,true,rowL,rowH);
|
||
drawrow(x1,y1,x2,y2,true,rowL,rowH)
|
||
end
|
||
else
|
||
if row = 4 then
|
||
drawrow(x1,y1,x2,y2,false,rowL,rowH)
|
||
else
|
||
if row = 5 then
|
||
drawrow(x2,y2,x1,y1,false)
|
||
else
|
||
if row = 6 then
|
||
begin
|
||
drawrow(x2,y2,x1,y1,false,rowL,rowH);
|
||
drawrow(x1,y1,x2,y2,false,rowL,rowH)
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawlinePixD(x1,y1,x2,y2: Double;color,aWidth,style,row: integer);
|
||
begin
|
||
drawlinePix(Round(x1),Round(y1),Round(x2),Round(y2),color,aWidth,style,row);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawlinePix(x1,y1,x2,y2,color,aWidth,style,row: integer);
|
||
var
|
||
rw,rh: Double;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.Brush.Style := BSSolid;
|
||
FCanvas.Brush.Color := color;
|
||
rw := 3.5;
|
||
rh := 1.2;
|
||
ConvertDim(rw);
|
||
ConvertDim(rh);
|
||
if row = 1 then
|
||
drawrowpix(x1,y1,x2,y2,Round(rh),Round(rw),true)
|
||
else
|
||
if row = 2 then
|
||
drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),true)
|
||
else
|
||
if row = 3 then
|
||
begin
|
||
drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),true);
|
||
drawrowPix(x1,y1,x2,y2,Round(rh),Round(rw),true)
|
||
end
|
||
else
|
||
if row = 4 then
|
||
drawrowPix(x1,y1,x2,y2,Round(rh),Round(rw),false)
|
||
else
|
||
if row = 5 then
|
||
drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),false)
|
||
else
|
||
if row = 6 then
|
||
begin
|
||
drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),false);
|
||
drawrowPix(x1,y1,x2,y2,Round(rh),Round(rw),false)
|
||
end;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
FCanvas.pen.style := penstyles[style];
|
||
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.moveto(x1,y1);
|
||
FCanvas.lineto(x2,y2);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.moveto(x1,y1);
|
||
FCanvas.lineto(x2,y2);
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawrow(x1,y1,x2,y2: Double; solid: Boolean;hl:double=5;hh:double=3);
|
||
var
|
||
pt : TDoublePointArr;
|
||
r:HRGN;
|
||
begin
|
||
r := 1;
|
||
SetLength(pt,3);
|
||
CalcRowPoints(x1,y1,x2,y2,hl,hh,pt[0],pt[1],pt[2]);
|
||
if solid then Polygon(pt,r) else PolyLine(pt);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawrowPix(x1,y1,x2,y2,h,w: integer; solid: Boolean);
|
||
VAR
|
||
xLineDelta : INTEGER;
|
||
yLineDelta : INTEGER;
|
||
pt : array [0..2] of Windows.TPoint;
|
||
p1,p2,p3 : Windows.TPoint;
|
||
a,Angle : integer;
|
||
begin
|
||
try
|
||
xLineDelta := x2 - x1;
|
||
yLineDelta := y2 - y1;
|
||
if (xLineDelta = 0) and (yLineDelta = 0) then exit;
|
||
if (h = 0) or (w=0) then exit;
|
||
|
||
p1.x := x2;
|
||
p1.y := y2;
|
||
|
||
if (xLineDelta < 0) and (yLineDelta = 0) then
|
||
begin
|
||
p2.x := p1.x + w;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - h;
|
||
p3.y := p1.y + h;
|
||
end
|
||
else if (xLineDelta > 0) and (yLineDelta = 0) then
|
||
begin
|
||
p2.x := p1.x - w;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - h;
|
||
p3.y := p1.y + h;
|
||
end
|
||
else if (xLineDelta = 0) and (yLineDelta > 0) then
|
||
begin
|
||
p2.x := p1.x - h;
|
||
p3.x := p1.x + h;
|
||
p2.y := p1.y - w;
|
||
p3.y := p1.y - w;
|
||
end
|
||
else if (xLineDelta = 0) and (yLineDelta < 0) then
|
||
begin
|
||
p2.x := p1.x - h;
|
||
p3.x := p1.x + h;
|
||
p2.y := p1.y + w;
|
||
p3.y := p1.y + w;
|
||
end
|
||
else if (xLineDelta > 0) and (yLineDelta > 0) then
|
||
begin
|
||
p2.x := p1.x - w;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - h;
|
||
p3.y := p1.y + h;
|
||
//rotate
|
||
Angle := Round(ArcTan( abs(yLineDelta) / abs(xLineDelta) )* (180/ PI)* 10);
|
||
p2 := getrelativepointbyangle(-angle,p1,p2);
|
||
p3 := getrelativepointbyangle(-angle,p1,p3);
|
||
end
|
||
else if (xLineDelta < 0) and (yLineDelta > 0) then
|
||
begin
|
||
p2.x := p1.x - h;
|
||
p3.x := p1.x + h;
|
||
p2.y := p1.y - w;
|
||
p3.y := p1.y - w;
|
||
// rotate
|
||
Angle := 900 - Round(ArcTan( abs(yLineDelta) / abs(xLineDelta) )* (180/ PI)* 10);
|
||
p2 := getrelativepointbyangle(-angle,p1,p2);
|
||
p3 := getrelativepointbyangle(-angle,p1,p3);
|
||
end
|
||
else if (xLineDelta < 0) and (yLineDelta < 0) then
|
||
begin
|
||
p2.x := p1.x + w;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - h;
|
||
p3.y := p1.y + h;
|
||
// rotate
|
||
Angle := Round(ArcTan( abs(yLineDelta) / abs(xLineDelta) )* (180/ PI)* 10);
|
||
p2 := getrelativepointbyangle(-angle,p1,p2);
|
||
p3 := getrelativepointbyangle(-angle,p1,p3);
|
||
end
|
||
else if (xLineDelta > 0) and (yLineDelta < 0) then
|
||
begin
|
||
p2.x := p1.x - h;
|
||
p3.x := p1.x + h;
|
||
p2.y := p1.y + w;
|
||
p3.y := p1.y + w;
|
||
// rotate
|
||
Angle := 900 - Round(ArcTan( abs(yLineDelta) / abs(xLineDelta) )* (180/ PI)* 10);
|
||
p2 := getrelativepointbyangle(-angle,p1,p2);
|
||
p3 := getrelativepointbyangle(-angle,p1,p3);
|
||
end ;
|
||
pt[0] := p2; pt[1] := p1; pt[2] := p3;
|
||
if solid then FCanvas.Polygon(pt) else FCanvas.PolyLine(pt);
|
||
except end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.Drawpolyline(points: TDoublePointArr;Closed: Boolean);
|
||
var r:HRGN;
|
||
begin
|
||
r := 1;
|
||
if closed then
|
||
polygon(points,r)
|
||
else
|
||
polyLine(points);
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.drawpolyline(points: TDoublePointArr; color,awidth,style,row: integer);
|
||
var a: integer;
|
||
xx,yy,y2:glnarray;
|
||
nbrPoint:Integer;
|
||
|
||
begin
|
||
nbrPoint := Length(Points);
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
if row = 1 then drawrow(points[nbrPoint-2].x,points[nbrPoint-2].y,points[nbrPoint-1].x,points[nbrPoint-1].y,true)
|
||
else if row = 2 then drawrow(points[1].x,points[1].y,points[0].x,points[0].y,true)
|
||
else if row = 3 then begin
|
||
drawrow(points[nbrPoint-2].x,points[nbrPoint-2].y,points[nbrPoint-1].x,points[nbrPoint-1].y,true);
|
||
drawrow(points[1].x,points[1].y,points[0].x,points[0].y,true)
|
||
end
|
||
else if row = 4 then drawrow(points[nbrPoint-2].x,points[nbrPoint-2].y,points[nbrPoint-1].x,points[nbrPoint-1].y,false)
|
||
else if row = 5 then drawrow(points[1].x,points[1].y,points[0].x,points[0].y,false)
|
||
else if row = 6 then begin
|
||
drawrow(points[nbrPoint-2].x,points[nbrPoint-2].y,points[nbrPoint-1].x,points[nbrPoint-1].y,false);
|
||
drawrow(points[1].x,points[1].y,points[0].x,points[0].y,false)
|
||
end;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
PolyLine(points);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawrect(x1,y1,x2,y2: Double;color,awidth,style,bc,bs: integer);
|
||
var p1,p2,p3,p4: TDoublePoint;
|
||
rgn: HRGN;
|
||
begin
|
||
rgn := 1;
|
||
p1 := DoublePoint(x1,y1);
|
||
p2 := DoublePoint(x2,y1);
|
||
p3 := DoublePoint(x2,y2);
|
||
p4 := DoublePoint(x1,y2);
|
||
drawrect(p1,p2,p3,p4,color,aWidth,style,bc,bs,rgn)
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawrect(p1,p2:TDoublePoint;color,awidth,style,bc,bs: integer);
|
||
var xp1,xp2: TDoublePoint;
|
||
rgn: HRGN;
|
||
begin
|
||
rgn := 1;
|
||
xp1 := DoublePoint(p2.x,p1.y);
|
||
xp2 := DoublePoint(p1.x,p2.y);
|
||
drawrect(p1,xp1,p2,xp2,color,aWidth,style,bc,bs,rgn)
|
||
end;
|
||
procedure TPCDrawEngine.drawrect(p1,p2,p3,p4:TDoublePoint;color,awidth,style,bc,bs: integer;var rgn:HRGN);
|
||
var points: TDoublePointArr;
|
||
begin
|
||
SetLength(points,4);
|
||
points[0] := p1;
|
||
points[1] := p2;
|
||
points[2] := p3;
|
||
points[3] := p4;
|
||
DrawPolygon(points,color,awidth,style,bc,bs,rgn);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawMathGraph(cRect:TDoubleRect;cx,cy:Double;
|
||
color,awidth,style,ScaleColor:Integer;
|
||
OneUnit:double;Source:String;
|
||
DrawTick,DrawNumbers,isPolar:Boolean;NumStep:Double);
|
||
|
||
var x1,x2,y1,y2,b,w: Double;
|
||
a: Integer;
|
||
v: double;
|
||
parser: TParser;
|
||
ClpRgn : HRGN;
|
||
xx,yy: double;
|
||
tx,px,py,pz : Double;
|
||
d1,d2 : Integer;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
aFont,oldFont : TFont;
|
||
aHeight,tLen,tStep: Double;
|
||
Numtext: string;
|
||
z: Double;
|
||
begin
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
|
||
x1 := cRect.left;
|
||
x2 := cRect.right;
|
||
y1 := crect.top;
|
||
y2 := crect.bottom;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
ConvertCoord(cx,cy,z);
|
||
ConvertDim(OneUnit);
|
||
|
||
if x1 > x2 then begin
|
||
tx := x1;
|
||
x1 := x2;
|
||
x2 := tx;
|
||
end;
|
||
|
||
if y1 > y2 then begin
|
||
tx := y1;
|
||
y1 := y2;
|
||
y2 := tx;
|
||
end;
|
||
|
||
parser := Tparser.Create(nil);
|
||
parser.Expression := Source;
|
||
|
||
w := abs(x2-x1);
|
||
if w = 0 then exit;
|
||
d1 := Round(x1-cx);
|
||
d2 := Round(x2-cx);
|
||
|
||
|
||
try
|
||
parser.X := d1/OneUnit;
|
||
v := parser.Value;
|
||
except end;
|
||
px := x1;
|
||
py := cy - round(v*OneUnit);
|
||
ClpRgn := CreateRectRgn(Round(x1),Round(y1),Round(x2),Round(y2));
|
||
SelectClipRgn(FCanvas.handle,clpRgn);
|
||
FCanvas.MoveTo(Round(px),Round(py));
|
||
|
||
for a := d1 to d2 do
|
||
begin
|
||
xx := a/OneUnit;
|
||
try
|
||
parser.X := xx;
|
||
v := parser.Value;
|
||
except end;
|
||
px := x1 + (a-d1);
|
||
py := cy - round(v*OneUnit);
|
||
FCanvas.LineTo(Round(px),Round(py));
|
||
end;
|
||
|
||
FCanvas.pen.color := ScaleColor;
|
||
|
||
oldFont := nil; //#From Oleg# //20.09.2010
|
||
aFont := nil; //#From Oleg# //20.09.2010
|
||
if DrawNumbers then
|
||
begin
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := 'Tahoma';
|
||
aFont.Style := [];
|
||
aFont.Color := ScaleColor;
|
||
aFont.Charset := 161;
|
||
FCanvas.Font := aFont;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
aHeight := 4;
|
||
ConvertDim(aHeight);
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
|
||
if NumStep < 1 then NumStep := 1;
|
||
|
||
if DrawTick or DrawNumbers then
|
||
begin
|
||
for a := 0 to Round((cy-y1)) do
|
||
begin
|
||
if (a mod Round(OneUnit)) = 0 then begin
|
||
if DrawTick then
|
||
begin
|
||
FCanvas.MoveTo(Round(cx)-2,Round(cy)-a);
|
||
FCanvas.LineTo(Round(cx)+2,Round(cy)-a);
|
||
end;
|
||
end;
|
||
if (a mod Round(OneUnit*NumStep)) = 0 then begin
|
||
if DrawNumbers and (a<>0) then
|
||
begin
|
||
NumText := inttostr(a div Round(OneUnit));
|
||
FCanvas.TextOut(Round(cx)+4,Round(cy)-a-Trunc(aHeight/2),NumText);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
for a := 0 to Round(y2-cy) do
|
||
begin
|
||
if (a mod Round(OneUnit)) = 0 then begin
|
||
if DrawTick then
|
||
begin
|
||
FCanvas.MoveTo(Round(cx)-2,Round(cy)+a);
|
||
FCanvas.LineTo(Round(cx)+2,Round(cy)+a);
|
||
end;
|
||
end;
|
||
if (a mod Round(OneUnit*NumStep)) = 0 then begin
|
||
if DrawNumbers and (a<>0) then
|
||
begin
|
||
NumText := inttostr(-a div Round(OneUnit));
|
||
FCanvas.TextOut(Round(cx)+4,Round(cy)+a-Trunc(aHeight / 2),NumText);
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
if IsPolar then
|
||
begin
|
||
tStep := round(oneUnit * (pi/2));
|
||
NumStep := NumStep * 2;
|
||
end
|
||
else
|
||
tStep := oneUnit;
|
||
|
||
for a := 0 to Round(x2-cx) do
|
||
begin
|
||
if (a mod Round(tStep)) = 0 then
|
||
begin
|
||
if DrawTick then begin
|
||
FCanvas.MoveTo(Round(cx)+a,Round(cy)-2);
|
||
FCanvas.LineTo(Round(cx)+a,Round(cy)+2);
|
||
end;
|
||
end;
|
||
if (a mod Round(tStep*NumStep)) = 0 then
|
||
begin
|
||
if DrawNumbers and (a <> 0) then
|
||
begin
|
||
if IsPolar then
|
||
//NumText := inttostr(a div Round(tStep*2))+chr(240)
|
||
NumText := String(inttostr(a div Round(tStep*2)) + AnsiChar(240)) // Tolik 27/03/2019 --
|
||
else
|
||
NumText := inttostr(a div Round(tStep));
|
||
tLen := fCanvas.TextWidth(NumText);
|
||
FCanvas.TextOut(Round(cx)+a-(Round(tLen) div 2),Round(cy)+2,NumText);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
for a := 0 to Round(cx-x1) do
|
||
begin
|
||
if (a mod Round(tStep)) = 0 then begin
|
||
if DrawTick then begin
|
||
FCanvas.MoveTo(Round(cx)-a,Round(cy)-2);
|
||
FCanvas.LineTo(Round(cx)-a,Round(cy)+2);
|
||
end;
|
||
end;
|
||
if (a mod Round(tStep*NumStep)) = 0 then begin
|
||
if DrawNumbers and (a <> 0) then
|
||
begin
|
||
if IsPolar then
|
||
//NumText := inttostr(-a div Round(tStep*2))+chr(240)
|
||
NumText := String(inttostr(-a div Round(tStep*2))+ AnsiChar(240))
|
||
else
|
||
NumText := inttostr(-a div Round(tStep));
|
||
tLen := fCanvas.TextWidth(NumText);
|
||
FCanvas.TextOut(Round(cx)-a-(Round(tLen) div 2),Round(cy)+2,NumText);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
if DrawNumbers then
|
||
begin
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
end;
|
||
|
||
SelectClipRgn(FCanvas.handle,0);
|
||
DeleteObject(ClpRgn);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawpolygon(p1,p2,p3,p4:TDoublePoint; color,awidth,style,bc,bs: integer;var rgn: HRGN);
|
||
var points: TdoublePointArr;
|
||
begin
|
||
SetLength(points,4);
|
||
points[0] := p1;
|
||
points[1] := p2;
|
||
points[2] := p3;
|
||
points[3] := p4;
|
||
DrawPolygon(points,Color,aWidth,Style,bc,bs,rgn);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawpolygon(p1,p2,p3,p4:TDoublePoint; color,awidth,style,bc,bs: integer);
|
||
var points: TdoublePointArr;
|
||
rgn:HRGN;
|
||
begin
|
||
rgn := 1;
|
||
SetLength(points,4);
|
||
points[0] := p1;
|
||
points[1] := p2;
|
||
points[2] := p3;
|
||
points[3] := p4;
|
||
DrawPolygon(points,Color,aWidth,Style,bc,bs,rgn);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.FillRgn(rgn:HRGN;bc,bs:Integer);
|
||
var cRgn: HRGN;
|
||
begin
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
Windows.FillRgn(FCanvas.Handle,rgn,FCanvas.Brush.Handle);
|
||
end;
|
||
|
||
//procedure TPCDrawEngine.DrawPie(x1, y1, x2, y2 : double; bc, bs, CutStyle: Integer; var rgn:HRGN; cp:TDoublePoint; Fangle, SAngle, Radius, aCutRadius: Double);
|
||
procedure TPCDrawEngine.DrawPie(bc, bs, CutStyle: Integer; var rgn:HRGN; cp:TDoublePoint; Fangle, SAngle, Radius, aCutRadius: Double);
|
||
Var p1, p2, p3, p4, cPoint : TDoublePoint;
|
||
z: Double;
|
||
pp1, pp2 : TDoublePoint;
|
||
points: array of TDoublePoint;
|
||
ipoints: array of TPoint;
|
||
angle1, angle2: Integer;
|
||
ArrayLength: Integer;
|
||
PointToRotate: TDoublePoint;
|
||
rgn1: HRGN;
|
||
|
||
LeftTopPoint, RightBottomPoint: TDoublePoint;
|
||
// Tolik 24/12/2019 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><>. <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20> <20><> <20> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
Procedure GetPiePoints;
|
||
var i, cutArrayLength: Integer;
|
||
cutRadius: double;
|
||
cutArray: Array of TDoublePoint;
|
||
p1: TDoublePoint;
|
||
CanDropAngle: Boolean;
|
||
begin
|
||
ArrayLength := 0;
|
||
SetLength(Points, 0);
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
if (Angle1 = 0) and (Angle2 = 360) then
|
||
CanDRopAngle := False
|
||
else
|
||
CanDropAngle := True;
|
||
|
||
if CanDropAngle then
|
||
begin
|
||
if Angle1 < Angle2 then
|
||
ArrayLength := Angle2 - Angle1
|
||
else
|
||
begin
|
||
ArrayLength := (360 - Angle1) + Angle2;
|
||
end;
|
||
end
|
||
else
|
||
ArrayLength := 360;
|
||
|
||
{ if Angle1 = 360 then
|
||
Angle1 := 0;
|
||
if Angle2 = 360 then
|
||
Angle2 := 0;}
|
||
|
||
// Buid PolyLine
|
||
// big arc
|
||
SetLength(Points, ArrayLength + 1);
|
||
ArrayLength := 0;
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
p1.x := cp.x + Radius;
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, (Angle1/180)*PI);
|
||
|
||
inc(ArrayLength);
|
||
//SetLength(Points, ArrayLength);
|
||
try
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
except
|
||
On E: Exception do
|
||
ShowMessage(inttostr(ArrayLength));
|
||
end;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
|
||
angle1 := angle1 + 1;
|
||
if CanDropAngle then
|
||
if angle1 = 360 then
|
||
if Angle2 <> 360 then
|
||
angle1 := 0;
|
||
end;
|
||
// Last arc Point
|
||
p1.x := cp.x + Radius;
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, Fangle);
|
||
|
||
{ if ((CompareValue(p1.x, Points[ArrayLength - 1].x) <> 0) or
|
||
(CompareValue(p1.y, Points[ArrayLength - 1].y) <> 0)) then
|
||
begin}
|
||
inc(ArrayLength);
|
||
//SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
// end;
|
||
|
||
// cutting PIESHADOW
|
||
if aCutRadius = 0 then // no cut -- add center Point
|
||
begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := cp.x;
|
||
Points[ArrayLength - 1].y := cp.y;
|
||
end
|
||
else
|
||
begin
|
||
if CutStyle = 0 then // Linear Cutting
|
||
begin
|
||
//p1.x := cp.x + acutRadius;
|
||
p1.x := cp.x + ABS(acutRadius/cos(2*PI - ABS(((FAngle-SAngle)/2))));
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, FAngle);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
|
||
//p1.x := cp.x + acutRadius;
|
||
//p1.x := cp.x + ABS(acutRadius/cos(ABS(((FAngle-SAngle)/180)/PI)));
|
||
p1.x := cp.x + ABS(acutRadius/cos(2*PI - ABS(((FAngle-SAngle)/2))));
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, SAngle);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
// to close PolyLine
|
||
{ begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := Points[0].x;
|
||
Points[ArrayLength - 1].y := Points[0].y;
|
||
end;
|
||
}
|
||
end
|
||
else
|
||
if CutStyle = 1 then // arc cutting
|
||
begin
|
||
// angles
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
{ if Angle1 = 360 then
|
||
Angle1 := 0;
|
||
if Angle2 = 360 then
|
||
Angle2 := 0;}
|
||
if (Angle1 = 0) and (Angle2 = 360) then
|
||
CanDropAngle := False
|
||
else
|
||
CanDropAngle := True;
|
||
if CanDropAngle then
|
||
begin
|
||
if Angle1 < Angle2 then
|
||
cutArrayLength := Angle2 - Angle1
|
||
else
|
||
cutArrayLength := (360 - Angle1) + Angle2;
|
||
end
|
||
else
|
||
cutArrayLength := 360;
|
||
//cutArrayLength := 0;
|
||
SetLength(cutArray,cutArrayLength + 1);
|
||
cutArrayLength := 0;
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
p1 := DoublePoint(CP.x + acutRadius, CP.y, 0);
|
||
p1 := RotatePoint(CP,p1,(Angle1/180)*PI);
|
||
inc(cutArrayLength);
|
||
//SetLength(cutArray, cutArrayLength);
|
||
cutArray[cutArrayLength - 1].x := p1.x;
|
||
cutArray[cutArrayLength - 1].y := p1.y;
|
||
angle1 := angle1 + 1;
|
||
if CanDropAngle then
|
||
if angle1 = 360 then
|
||
if Angle2 <> 360 then
|
||
angle1 := 0;
|
||
end;
|
||
|
||
if CutArrayLength > 0 then
|
||
begin
|
||
// Last arc Point
|
||
p1.x := cp.x + aCutRadius;
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, Fangle);
|
||
|
||
{ if ((CompareValue(p1.x, cutArray[CutArrayLength - 1].x) <> 0) or
|
||
(CompareValue(p1.y, cutArray[CutArrayLength - 1].y) <> 0)) then
|
||
begin}
|
||
inc(CutArrayLength);
|
||
SetLength(cutArray, ArrayLength);
|
||
cutArray[CutArrayLength - 1].x := p1.x;
|
||
cutArray[CutArrayLength - 1].y := p1.y;
|
||
// end;
|
||
|
||
SetLength(Points, ArrayLength + cutArrayLength);
|
||
for i := cutArrayLength - 1 downto 0 do
|
||
begin
|
||
inc(ArrayLength);
|
||
//SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := cutArray[i].x;
|
||
Points[ArrayLength - 1].y := cutArray[i].y;
|
||
end;
|
||
SetLength(cutArray, 0); // free mem
|
||
end;
|
||
// to close PolyLine
|
||
{begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := Points[0].x;
|
||
Points[ArrayLength - 1].y := Points[0].y;
|
||
end;
|
||
}
|
||
end;
|
||
end;
|
||
|
||
for i := 0 to ArrayLength - 1 do
|
||
begin
|
||
ConvertCoord(Points[i].x,Points[i].y,z);
|
||
end;
|
||
end;
|
||
(* Procedure GetPiePoints;
|
||
var i, cutArrayLength: Integer;
|
||
cutRadius: double;
|
||
cutArray: Array of TDoublePoint;
|
||
p1: TDoublePoint;
|
||
CanDropAngle: Boolean;
|
||
begin
|
||
ArrayLength := 0;
|
||
SetLength(Points, 0);
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
if (Angle1 = 0) and (Angle2 = 360) then
|
||
CanDRopAngle := False
|
||
else
|
||
CanDropAngle := True;
|
||
|
||
{ if Angle1 = 360 then
|
||
Angle1 := 0;
|
||
if Angle2 = 360 then
|
||
Angle2 := 0;}
|
||
|
||
// Buid PolyLine
|
||
// big arc
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
p1.x := cp.x + Radius;
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, (Angle1/180)*PI);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
|
||
angle1 := angle1 + 1;
|
||
if CanDropAngle then
|
||
if angle1 = 360 then
|
||
angle1 := 0;
|
||
end;
|
||
// Last arc Point
|
||
p1.x := cp.x + Radius;
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, Fangle);
|
||
|
||
{ if ((CompareValue(p1.x, Points[ArrayLength - 1].x) <> 0) or
|
||
(CompareValue(p1.y, Points[ArrayLength - 1].y) <> 0)) then
|
||
begin}
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
// end;
|
||
|
||
// cutting PIESHADOW
|
||
if aCutRadius = 0 then // no cut -- add center Point
|
||
begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := cp.x;
|
||
Points[ArrayLength - 1].y := cp.y;
|
||
end
|
||
else
|
||
begin
|
||
if CutStyle = 0 then // Linear Cutting
|
||
begin
|
||
//p1.x := cp.x + acutRadius;
|
||
p1.x := cp.x + ABS(acutRadius/cos(2*PI - ABS(((FAngle-SAngle)/2))));
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, FAngle);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
|
||
//p1.x := cp.x + acutRadius;
|
||
//p1.x := cp.x + ABS(acutRadius/cos(ABS(((FAngle-SAngle)/180)/PI)));
|
||
p1.x := cp.x + ABS(acutRadius/cos(2*PI - ABS(((FAngle-SAngle)/2))));
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, SAngle);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
// to close PolyLine
|
||
{ begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := Points[0].x;
|
||
Points[ArrayLength - 1].y := Points[0].y;
|
||
end;
|
||
}
|
||
end
|
||
else
|
||
if CutStyle = 1 then // arc cutting
|
||
begin
|
||
// angles
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
{ if Angle1 = 360 then
|
||
Angle1 := 0;
|
||
if Angle2 = 360 then
|
||
Angle2 := 0;}
|
||
if (Angle1 = 0) and (Angle2 = 360) then
|
||
CanDropAngle := False
|
||
else
|
||
CanDropAngle := True;
|
||
|
||
cutArrayLength := 0;
|
||
SetLength(cutArray,0);
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
p1 := DoublePoint(CP.x + acutRadius, CP.y, 0);
|
||
p1 := RotatePoint(CP,p1,(Angle1/180)*PI);
|
||
inc(cutArrayLength);
|
||
SetLength(cutArray, cutArrayLength);
|
||
cutArray[cutArrayLength - 1].x := p1.x;
|
||
cutArray[cutArrayLength - 1].y := p1.y;
|
||
angle1 := angle1 + 1;
|
||
if CanDropAngle then
|
||
if angle1 = 360 then
|
||
angle1 := 0;
|
||
end;
|
||
|
||
if CutArrayLength > 0 then
|
||
begin
|
||
// Last arc Point
|
||
p1.x := cp.x + aCutRadius;
|
||
p1.y := cp.y;
|
||
p1.z := 0;
|
||
p1 := RotatePoint(cp, p1, Fangle);
|
||
|
||
{ if ((CompareValue(p1.x, cutArray[CutArrayLength - 1].x) <> 0) or
|
||
(CompareValue(p1.y, cutArray[CutArrayLength - 1].y) <> 0)) then
|
||
begin}
|
||
inc(CutArrayLength);
|
||
SetLength(cutArray, ArrayLength);
|
||
cutArray[CutArrayLength - 1].x := p1.x;
|
||
cutArray[CutArrayLength - 1].y := p1.y;
|
||
// end;
|
||
|
||
for i := cutArrayLength - 1 downto 0 do
|
||
begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := cutArray[i].x;
|
||
Points[ArrayLength - 1].y := cutArray[i].y;
|
||
end;
|
||
SetLength(cutArray, 0); // free mem
|
||
end;
|
||
// to close PolyLine
|
||
{begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := Points[0].x;
|
||
Points[ArrayLength - 1].y := Points[0].y;
|
||
end;
|
||
}
|
||
end;
|
||
end;
|
||
|
||
for i := 0 to ArrayLength - 1 do
|
||
begin
|
||
ConvertCoord(Points[i].x,Points[i].y,z);
|
||
end;
|
||
end;
|
||
*)
|
||
Procedure GetPieBounds;
|
||
var i : Integer;
|
||
begin
|
||
if ArrayLength > 0 then
|
||
begin
|
||
LeftTopPoint.x := points[0].x;
|
||
LeftTopPoint.y := points[0].y;
|
||
|
||
RightBottomPoint.x := points[0].x;
|
||
RightBottomPoint.y := points[0].y;
|
||
|
||
for i := 1 to ArrayLength - 1 do
|
||
begin
|
||
if Comparevalue(LeftTopPoint.x, points[i].x) = 1 then
|
||
LeftTopPoint.x := points[i].x;
|
||
if Comparevalue(LeftTopPoint.y, points[i].y) = 1 then
|
||
LeftTopPoint.y := points[i].y;
|
||
if Comparevalue(RightBottomPoint.x, points[i].x) = -1 then
|
||
RightBottomPoint.x := points[i].x;
|
||
if Comparevalue(RightBottomPoint.y, points[i].y) = -1 then
|
||
RightBottomPoint.y := points[i].y;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Procedure GetCattedPieRegion;
|
||
var tReg: HRGN;
|
||
convRad,z: Double;
|
||
a: integer;
|
||
|
||
begin
|
||
SetLength(IPoints, ArrayLength);
|
||
|
||
for a := 0 to arrayLength - 1 do
|
||
ipoints[a] := DP2P(points[a]);
|
||
tReg := CreatePolygonRgn(ipoints[0],ArrayLength,WINDING);
|
||
|
||
SetLength(points, 0);
|
||
SetLength(ipoints, 0);
|
||
//CombineRgn(Rgn,Rgn,treg,RGN_OR);
|
||
CombineRgn(Rgn,Rgn,treg,RGN_AND);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
begin
|
||
z := 0;
|
||
FCanvas.brush.color := bc ; // brushColor
|
||
FCanvas.brush.style := TBrushStyle(bs); // brushStyle
|
||
|
||
cPoint.x := cp.x;
|
||
cPoint.y := cp.y;
|
||
|
||
|
||
if rgn = 0 then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
z := 0;
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
if (Angle1 = 0) and (Angle2 = 360) then // <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> ...
|
||
begin
|
||
pp1.x := cp.x - radius;
|
||
pp1.y := cp.y - radius;
|
||
pp1.z := 0;
|
||
pp2.x := cp.x + radius;
|
||
pp2.y := cp.y + radius;
|
||
pp2.z := 0;
|
||
ConvertCoord(pp1.x,pp1.y,pp1.z);
|
||
ConvertCoord(pp2.x,pp2.y,pp2.z);
|
||
Rgn := CreateEllipticRgn(Round(pp1.x), Round(pp1.y), Round(pp2.x), Round(pp2.y));
|
||
if aCutRadius <> 0 then
|
||
begin
|
||
pp1.x := cp.x - aCutRadius;
|
||
pp1.y := cp.y - aCutRadius;
|
||
pp1.z := 0;
|
||
pp2.x := cp.x + aCutRadius;
|
||
pp2.y := cp.y + aCutRadius;
|
||
pp2.z := 0;
|
||
ConvertCoord(pp1.x,pp1.y,pp1.z);
|
||
ConvertCoord(pp2.x,pp2.y,pp2.z);
|
||
rgn1 := CreateEllipticRgn(Round(pp1.x), Round(pp1.y), Round(pp2.x), Round(pp2.y));
|
||
CombineRgn(Rgn, Rgn, Rgn1, RGN_XOR);
|
||
DeleteObject(Rgn1); // Tolik 14/01/2025 --
|
||
end;
|
||
end
|
||
else
|
||
begin // <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ....
|
||
GetPiePoints; // <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
GetPieBounds; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
Rgn := CreateRectRgn(Round(LeftTopPoint.x), Round(LeftTopPoint.y), Round(RightBottomPoint.x), Round(RightBottomPoint.y));
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
GetCattedPieRegion;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawPieRGB(x1, y1, x2, y2, x3, y3, x4, y4 : double; bc, bs: Integer; var rgn:HRGN;cp,ap2,ap3:TDoublePoint;FAngle, SAngle, Rad: Double);
|
||
Var p1, p2, p3, p4, cPoint : TDoublePoint;
|
||
z: Double;
|
||
pp1, pp2 : TDoublePoint;
|
||
points: array of TDoublePoint;
|
||
ipoints: array of TPoint;
|
||
angle1, angle2, Angle3: Integer;
|
||
ArrayLength: Integer;
|
||
PointToRotate: TDoublePoint;
|
||
|
||
LeftTopPoint, RightBottomPoint: TDoublePoint;
|
||
|
||
Procedure GetPiePoints(aRad: Double);
|
||
var a: Integer;
|
||
begin
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
ArrayLength := 1;
|
||
SetLength(Points, 1);
|
||
points[0] := cP; // centerPoint
|
||
z := 0;
|
||
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
PointToRotate := DoublePoint(CP.x + aRad, CP.y, 0);
|
||
PointToRotate := RotatePoint(CP,PointToRotate,(Angle1/180)*PI);
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1 ].x := PointtoRotate.x;
|
||
Points[ArrayLength - 1 ].y := PointtoRotate.y;
|
||
Points[ArrayLength - 1 ].z := 0;
|
||
if angle1 = 360 then
|
||
angle1 := 0;
|
||
angle1 := angle1 + 1;
|
||
end;
|
||
|
||
for a := 0 to ArrayLength - 1 do
|
||
begin
|
||
ConvertCoord(Points[a].x,Points[a].y,z);
|
||
end;
|
||
end;
|
||
|
||
Procedure GetPieBounds;
|
||
var i : Integer;
|
||
|
||
begin
|
||
if ArrayLength > 0 then
|
||
begin
|
||
LeftTopPoint.x := points[0].x;
|
||
LeftTopPoint.y := points[0].y;
|
||
|
||
RightBottomPoint.x := points[0].x;
|
||
RightBottomPoint.y := points[0].y;
|
||
|
||
for i := 1 to ArrayLength - 1 do
|
||
begin
|
||
if Comparevalue(LeftTopPoint.x, points[i].x) = 1 then
|
||
LeftTopPoint.x := points[i].x;
|
||
if Comparevalue(LeftTopPoint.y, points[i].y) = 1 then
|
||
LeftTopPoint.y := points[i].y;
|
||
if Comparevalue(RightBottomPoint.x, points[i].x) = -1 then
|
||
RightBottomPoint.x := points[i].x;
|
||
if Comparevalue(RightBottomPoint.y, points[i].y) = -1 then
|
||
RightBottomPoint.y := points[i].y;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Procedure GetCattedPieRegion;
|
||
var tReg, tReg1, tReg2: HRGN;
|
||
convRad,z: Double;
|
||
a: integer;
|
||
|
||
begin
|
||
SetLength(IPoints, ArrayLength);
|
||
|
||
for a := 0 to arrayLength - 1 do
|
||
ipoints[a] := DP2P(points[a]);
|
||
|
||
tReg := CreatePolygonRgn(ipoints[0],ArrayLength,WINDING); // Big Pie to cut
|
||
fillRgn(FCanvas.Handle, treg, clBlue); // one big
|
||
|
||
SetLength(points, 0);
|
||
SetLength(ipoints, 0);
|
||
|
||
CombineRgn(Rgn,Rgn,treg,RGN_AND);
|
||
DeleteObject(tReg);
|
||
//CombineRgn(TReg,Rgn,treg,RGN_OR);
|
||
|
||
//fillRgn(Rgn, clBlue); // one big
|
||
|
||
GetPiePoints(Rad*0.5); // <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
GetPieBounds; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
SetLength(IPoints, ArrayLength);
|
||
|
||
for a := 0 to arrayLength - 1 do
|
||
ipoints[a] := DP2P(points[a]);
|
||
|
||
tReg1 := CreatePolygonRgn(ipoints[0],ArrayLength,WINDING); // Little Pie to cut
|
||
FillRgn(FCanvas.Handle,tReg1, clRed);
|
||
|
||
GetPiePoints(Rad*0.75); // <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
GetPieBounds; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
SetLength(IPoints, ArrayLength);
|
||
|
||
for a := 0 to arrayLength - 1 do
|
||
ipoints[a] := DP2P(points[a]);
|
||
|
||
tReg2 := CreatePolygonRgn(ipoints[0],ArrayLength,WINDING); // Middle Pie to cut
|
||
FillRgn(FCanvas.Handle, tReg2, clGreen);
|
||
|
||
CombineRgn(treg,Rgn,treg2,Rgn_Diff); // big part
|
||
CombineRgn(treg2, treg2, treg1, RGN_Diff); // middle part
|
||
CombineRgn(Rgn, treg1, treg2, RGN_OR);
|
||
CombineRgn(Rgn, Rgn, treg, RGN_OR);
|
||
|
||
DeleteObject(tReg);
|
||
DeleteObject(tReg1);
|
||
DeleteObject(tReg2);
|
||
end;
|
||
|
||
begin
|
||
z := 0;
|
||
FCanvas.brush.color := clskyBlue;//bc;
|
||
//FCanvas.brush.style := TBrushStyle(bs);
|
||
FCanvas.brush.style := bssolid;//bsClear;
|
||
p1.x := x1;
|
||
p1.y := y1;
|
||
p2.x := x2;
|
||
p2.y := y2;
|
||
p3.x := x3;
|
||
p3.y := y3;
|
||
p4.x := x4;
|
||
p4.y := y4;
|
||
|
||
cPoint.x := cp.x;
|
||
cPoint.y := cp.y;
|
||
|
||
if rgn = 0 then
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
z := 0;
|
||
|
||
GetPiePoints(Rad); // <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
GetPieBounds; // <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
Rgn := CreateRectRgn(Round(LeftTopPoint.x), Round(LeftTopPoint.y), Round(RightBottomPoint.x), Round(RightBottomPoint.y));
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
GetCattedPieRegion;
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawPieShadow(ap1: TDoublePoint; Radius, Sangle, Fangle, cutRadius: Double; cutStyle: integer);
|
||
|
||
var Points: TDoublePointArr;
|
||
ArrayLength: Integer;
|
||
i: Integer;
|
||
z: double;
|
||
p1: TDoublePoint;
|
||
|
||
procedure CalcPoints;
|
||
var i, Angle1, Angle2, cutArrayLength: Integer;
|
||
p1: TDoublePoint;
|
||
cutArray: array of TDoublePoint;
|
||
onePoint, twoPoints : boolean;
|
||
begin
|
||
ArrayLength := 0;
|
||
SetLength(Points, 0);
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
if Angle1 = 360 then
|
||
Angle1 := 0;
|
||
if Angle2 = 360 then
|
||
Angle2 := 0;
|
||
|
||
OnePoint := False;
|
||
TwoPoints := False;
|
||
|
||
if (Comparevalue(Fangle, Sangle) = 0) and (Radius = 0) then
|
||
OnePoint := True;
|
||
if not OnePoint then
|
||
if ((CompareValue(Fangle, Sangle) = 0) and (Radius <> 0)) then // if two points
|
||
TwoPoints := True;
|
||
|
||
if OnePoint then
|
||
begin
|
||
ArrayLength := 1;
|
||
SetLength(Points, 1);
|
||
// center Point to draw point
|
||
Points[0].x := ap1.x;
|
||
Points[0].y := ap1.y;
|
||
exit;
|
||
end;
|
||
|
||
if TwoPoints then
|
||
begin
|
||
ArrayLength := 2;
|
||
SetLength(Points, 2);
|
||
// center Point
|
||
Points[0].x := ap1.x;
|
||
Points[0].y := ap1.y;
|
||
// Next point to draw Line
|
||
p1.x := AP1.x + Radius;
|
||
p1.y := ap1.y;
|
||
p1 := RotatePoint(ap1, p1,Fangle); // does not mean (Fangle = Sangle)
|
||
Points[1].x := p1.x;
|
||
Points[1].y := p1.y;
|
||
exit;
|
||
end;
|
||
|
||
|
||
// else buid PolyLine
|
||
|
||
// big arc
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
p1.x := AP1.x + Radius;
|
||
p1.y := ap1.y;
|
||
p1 := RotatePoint(AP1, p1, (Angle1/180)*PI);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
|
||
angle1 := angle1 + 1;
|
||
if angle1 = 360 then
|
||
angle1 := 0;
|
||
end;
|
||
// Last arc Point
|
||
p1.x := AP1.x + Radius;
|
||
p1.y := ap1.y;
|
||
p1 := RotatePoint(AP1, p1, Fangle);
|
||
|
||
{if ((CompareValue(p1.x, Points[ArrayLength - 1].x) <> 0) or
|
||
(CompareValue(p1.y, Points[ArrayLength - 1].y) <> 0)) then
|
||
begin}
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
{end;}
|
||
|
||
// cutting PIESHADOW
|
||
if CutRadius = 0 then // no cut -- add center Point
|
||
begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := ap1.x;
|
||
Points[ArrayLength - 1].y := ap1.y;
|
||
end
|
||
else
|
||
begin
|
||
if CutStyle = 0 then // Linear Cutting
|
||
begin
|
||
p1.x := ap1.x + cutRadius;
|
||
p1.y := ap1.y;
|
||
p1 := RotatePoint(ap1, p1, FAngle);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
|
||
p1.x := ap1.x + cutRadius;
|
||
p1.y := ap1.y;
|
||
|
||
p1 := RotatePoint(ap1, p1, SAngle);
|
||
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := p1.x;
|
||
Points[ArrayLength - 1].y := p1.y;
|
||
// to close PolyLine
|
||
{ begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := Points[0].x;
|
||
Points[ArrayLength - 1].y := Points[0].y;
|
||
end;
|
||
}
|
||
end
|
||
else
|
||
if CutStyle = 1 then // arc cutting
|
||
begin
|
||
// angles
|
||
Angle1 := Round((180/pi)*Sangle);
|
||
Angle2 := Round((180/pi)*Fangle);
|
||
|
||
if Angle1 = 360 then
|
||
Angle1 := 0;
|
||
if Angle2 = 360 then
|
||
Angle2 := 0;
|
||
|
||
cutArrayLength := 0;
|
||
SetLength(cutArray,0);
|
||
while Angle1 <> Angle2 do
|
||
begin
|
||
p1 := DoublePoint(ap1.x + cutRadius, ap1.y, 0);
|
||
p1 := RotatePoint(ap1,p1,(Angle1/180)*PI);
|
||
inc(cutArrayLength);
|
||
SetLength(cutArray, cutArrayLength);
|
||
cutArray[cutArrayLength - 1].x := p1.x;
|
||
cutArray[cutArrayLength - 1].y := p1.y;
|
||
angle1 := angle1 + 1;
|
||
if angle1 = 360 then
|
||
angle1 := 0;
|
||
end;
|
||
|
||
if CutArrayLength > 0 then
|
||
begin
|
||
// Last arc Point
|
||
p1.x := AP1.x + CutRadius;
|
||
p1.y := ap1.y;
|
||
p1 := RotatePoint(AP1, p1, Fangle);
|
||
|
||
{ if ((CompareValue(p1.x, cutArray[CutArrayLength - 1].x) <> 0) or
|
||
(CompareValue(p1.y, cutArray[CutArrayLength - 1].y) <> 0)) then
|
||
begin}
|
||
inc(CutArrayLength);
|
||
SetLength(cutArray, ArrayLength);
|
||
cutArray[CutArrayLength - 1].x := p1.x;
|
||
cutArray[CutArrayLength - 1].y := p1.y;
|
||
// end;
|
||
|
||
for i := cutArrayLength - 1 downto 0 do
|
||
begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := cutArray[i].x;
|
||
Points[ArrayLength - 1].y := cutArray[i].y;
|
||
end;
|
||
SetLength(cutArray, 0); // free mem
|
||
end;
|
||
// to close PolyLine
|
||
{begin
|
||
inc(ArrayLength);
|
||
SetLength(Points, ArrayLength);
|
||
Points[ArrayLength - 1].x := Points[0].x;
|
||
Points[ArrayLength - 1].y := Points[0].y;
|
||
end;
|
||
}
|
||
end;
|
||
end;
|
||
end;
|
||
begin
|
||
CalcPoints;
|
||
if ArrayLength > 0 then
|
||
begin
|
||
FCanvas.Pen.Style := psDash;
|
||
FCanvas.Pen.Width := 1;
|
||
FCanvas.Pen.Color := ClLime;
|
||
|
||
if ArrayLength = 1 then
|
||
DrawPoint(Points[0], clLime)
|
||
else
|
||
if ArrayLength = 2 then
|
||
begin
|
||
FCanvas.Pen.Style := psDash;
|
||
FCanvas.Pen.Width := 1;
|
||
FCanvas.Pen.Color := ClLime;
|
||
z := 0;
|
||
DrawLine(Points[0], Points[1]);
|
||
end
|
||
else
|
||
if ArrayLength > 2 then
|
||
begin
|
||
FCanvas.Pen.Style := psDash;
|
||
FCanvas.Pen.Width := 1;
|
||
FCanvas.Pen.Color := ClLime;
|
||
//drawpolyline(points, False);
|
||
drawpolyline(points, True);
|
||
end;
|
||
end;
|
||
SetLength(Points,0);
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.drawpolygon(Const points:TDoublePointArr; color,awidth,style,bc,bs: integer;var rgn: HRGN;brsBmp:TBitmap=nil; ADrawPoints: Pointer=nil);
|
||
var a: integer;
|
||
hbr,oldbr: HBRUSH;
|
||
Begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
hbr := 0;
|
||
oldBr := 0;
|
||
if assigned(brsBmp) then begin
|
||
hbr := CreatePatternBrush(brsBmp.Handle);
|
||
oldBr := SelectObject(FCanvas.Handle,hBr);
|
||
end;
|
||
|
||
PolyGon(points,rgn, ADrawPoints);
|
||
if assigned(brsBmp) then
|
||
begin
|
||
SelectObject(FCanvas.Handle,oldBr);
|
||
DeleteObject(hbr);
|
||
end;
|
||
End;
|
||
|
||
procedure TPCDrawEngine.drawCurve(points: TDoublePointArr;color,awidth,style: integer);
|
||
var i,size: Integer;
|
||
Begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.style := bsClear;
|
||
size := Length(points);
|
||
for i := 0 to size -2 do
|
||
DrawCurveSegment(points[i],points[i+1]);
|
||
|
||
End;
|
||
|
||
|
||
procedure TPCDrawEngine.DrawCircle(cx,cy,rad:Double;color,awidth,style,bc,bs: integer;var rgn:HRGN;inCombined:Boolean;hatched:Boolean=False);
|
||
begin
|
||
DrawCircle(DoublePOint(cx,cy),rad,color,awidth,style,bc,bs,rgn,Hatched);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawCircle(cp:TDoublePoint;rad:Double;color,awidth,style,bc,bs: integer;var rgn:HRGN;Hatched:Boolean=False);
|
||
var cx,cy,cz: Double;
|
||
done: Boolean;
|
||
p1,p2,xp1,xp2: TDoublePoint;
|
||
xrad: Double;
|
||
icnt: Integer;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
With FCanvas do
|
||
begin
|
||
Pen.Style := TPenStyle(style);
|
||
Pen.Width := aWidth;
|
||
Pen.Color := color;
|
||
FCanvas.Brush.Color := bc;
|
||
FCanvas.Brush.Style:= TBrushStyle(bs);
|
||
|
||
cx := cp.x;
|
||
cy := cp.y;
|
||
cz := cp.z;
|
||
ConvertCoord(cx,cy,cz);
|
||
xRad := rad;
|
||
ConvertDim(xrad);
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
Ellipse(Round(cx-xrad),Round(cy-xrad),Round(cx+xrad),Round(cy+xrad));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
Ellipse(Round(cx-xrad),Round(cy-xrad),Round(cx+xrad),Round(cy+xrad));
|
||
end;
|
||
|
||
|
||
if rgn = 0 then begin
|
||
rgn := CreateEllipticRgn(Round(cx-xrad),Round(cy-xrad),Round(cx+xrad),Round(cy+xrad));
|
||
end;
|
||
|
||
if (hatched) and (rgn <> 1) and (rgn <> 0) then
|
||
begin
|
||
SelectClipRgn(Fcanvas.Handle,rgn);
|
||
p1 := MOvePoint(cp,-rad,-rad);
|
||
p2 := MOvePoint(cp,rad,-rad);
|
||
repeat
|
||
xp1 := p1;
|
||
xp2 := p2;
|
||
xp1 := RotatePoint(cp,xp1,pi/4);
|
||
xp2 := RotatePoint(cp,xp2,pi/4);
|
||
ExtendLine(xp1,xp2,10);
|
||
GetLineCircleIntersection(xp1,xp2,cp,rad,xp1,xp2,icnt,true);
|
||
if icnt = 2 then begin
|
||
DrawLine(xp1,xp2,color,1,ord(psSolid),0);
|
||
ShrinkLine(xp1,xp2,0.4);
|
||
end;
|
||
|
||
p1 := MovePoint(p1,0,1.2);
|
||
p2 := MovePoint(p2,0,1.2);
|
||
until p2.y > (cp.y+rad+1.2);
|
||
SelectClipRgn(Fcanvas.Handle,0);
|
||
end;
|
||
end;
|
||
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawOverLappedCircle(ap1x, ap1y, ap2x, ap2y, radius, CutRadius: Double; acolor, aawidth, style, bcolor, GDIbrs: Integer;var RegHandle:Hrgn; InCombined: Boolean; Hatched: Boolean = False);
|
||
var treg: HRGN;
|
||
begin
|
||
FCanvas.Brush.Style := TBrushStyle(1);
|
||
FCanvas.Brush.Color := bcolor;
|
||
RegHandle := CreateEllipticRgn(Round(ap1x - radius), Round(ap1y - radius), Round(ap1x + radius), Round(ap1y + radius));
|
||
if CutRadius > 0 then
|
||
if CompareValue(CutRadius, radius) = -1 then
|
||
begin
|
||
treg := CreateEllipticRgn(Round(ap2x - Cutradius), Round(ap2y - Cutradius), Round(ap2x + Cutradius), Round(ap2y + Cutradius));
|
||
CombineRgn(RegHandle, RegHandle,treg,RGN_XOR);
|
||
DeleteObject(Treg);
|
||
Windows.FillRgn(FCanvas.Handle,RegHandle, FCanvas.Brush.Handle);
|
||
end;
|
||
end;
|
||
Procedure TPCDrawEngine.DrawOverLappedEllipse(ap1x, ap1y, ap2x, ap2y, radius,radius1, CutRadius,CutRadius1: Double; acolor, aawidth,style,bcolor,GDIbrs: integer;var RegHandle: HRGN);
|
||
var treg: HRGN;
|
||
cp: TDoublePoint;
|
||
LPoint, RPoint: TDoublePoint;
|
||
z: Double;
|
||
begin
|
||
|
||
FCanvas.Brush.Style := TBrushStyle(1);
|
||
FCanvas.Brush.Color := bcolor;
|
||
|
||
cp.x := ap1x;
|
||
cp.y := ap1y;
|
||
z := 0;
|
||
|
||
LPoint.x := Round(ap1x - radius);
|
||
LPoint.y := Round(ap1y - radius1);
|
||
RPoint.x := Round(ap1x + radius);
|
||
RPoint.y := Round(ap1y + radius1);
|
||
|
||
ConvertCoord(LPoint.x,LPoint.y,z);
|
||
ConvertCoord(RPoint.x,RPoint.y,z);
|
||
|
||
RegHandle := CreateEllipticRgn(Round(LPoint.x), Round(LPoint.y), Round(RPoint.x), Round(RPoint.y));
|
||
|
||
if CutRadius > 0 then
|
||
if CutRadius1 > 0 then
|
||
if CompareValue(CutRadius, radius) = -1 then
|
||
if CompareValue(CutRadius1, radius1) = -1 then
|
||
begin
|
||
cp.x := ap2x;
|
||
cp.y := ap2y;
|
||
|
||
LPoint.x := Round(ap2x - CutRadius);
|
||
LPoint.y := Round(ap2y - CutRadius1);
|
||
RPoint.x := Round(ap2x + CutRadius);
|
||
RPoint.y := Round(ap2y + CutRadius1);
|
||
|
||
ConvertCoord(LPoint.x,LPoint.y,z);
|
||
ConvertCoord(RPoint.x,RPoint.y,z);
|
||
|
||
treg := CreateEllipticRgn(Round(LPoint.x), Round(LPoint.y), Round(RPoint.x), Round(RPoint.y));
|
||
CombineRgn(RegHandle, RegHandle,treg,RGN_XOR);
|
||
DeleteObject(Treg);
|
||
end;
|
||
|
||
Windows.FillRgn(FCanvas.Handle,RegHandle, FCanvas.Brush.Handle);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawCircle(p1: TDoublePoint;rad: Double);
|
||
var cx,cy,z: Double;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
cx := p1.x;
|
||
cy := p1.y;
|
||
z :=p1.z;
|
||
ConvertCoord(cx,cy,z);
|
||
ConvertDim(rad);
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.Ellipse(Round(cx-rad),Round(cy-rad),Round(cx+rad),Round(cy+rad));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.Ellipse(Round(cx-rad),Round(cy-rad),Round(cx+rad),Round(cy+rad));
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawCross(p:TdoublePoint;color,awidth,style:Integer;Dim:Double;Rotated:Boolean=True);
|
||
var ap1,ap2: TDoublePoint;
|
||
begin
|
||
ap1 := DoublePOint(p.x,p.y-Dim);
|
||
ap2 := DoublePOint(p.x,p.y+Dim);
|
||
if rotated then ap1 := RotatePoint(p,ap1,pi/4);
|
||
if rotated then ap2 := RotatePoint(p,ap2,pi/4);
|
||
DrawLine(ap1,ap2,color,aWidth,style,0);
|
||
ap1 := DoublePOint(p.x-Dim,p.y);
|
||
ap2 := DoublePOint(p.x+Dim,p.y);
|
||
if rotated then ap1 := RotatePoint(p,ap1,pi/4);
|
||
if rotated then ap2 := RotatePoint(p,ap2,pi/4);
|
||
DrawLine(ap1,ap2,color,aWidth,style,0);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawPoint(p1: TDoublePoint);
|
||
var cx,cy,z: Double;
|
||
begin
|
||
cx := p1.x;
|
||
cy := p1.y;
|
||
z:= 0;
|
||
ConvertCoord(cx,cy,z);
|
||
FCanvas.Ellipse(Round(cx-1),Round(cy-1),Round(cx+1),round(cy+1));
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawPoint(p1: TDoublePoint;color:TColor);
|
||
begin
|
||
Fcanvas.Pen.Color := color;
|
||
Fcanvas.Brush.Color := color;
|
||
Fcanvas.Brush.Style := bsSolid;
|
||
Fcanvas.Pen.Style := psSolid;
|
||
DrawPoint(p1);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawCirclePix(cx,cy,rad,color,awidth,style,bc,bs: integer;var rgn:HRGN);
|
||
begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
FCanvas.Ellipse(cx-rad,cy-rad,cx+rad,cy+rad);
|
||
if rgn = 0 then begin
|
||
rgn := CreateEllipticRgn(cx-rad,cy-rad,cx+rad,cy+rad);
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawbezierellipse(cx,cy,radA,radB,angle:Double;color,awidth,style,bc,bs:Integer;
|
||
var rgn:HRGN; inCombined:Boolean);
|
||
var Points: T2DPointArray;
|
||
P: TDoublePointArr;
|
||
I: integer;
|
||
cnt : integer;
|
||
r: Integer;
|
||
xRect:TDoubleRect;
|
||
closed: Boolean;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
BezierElpArcPoints(Points,cx,cy,Rada,Radb,angle,0,2*pi);
|
||
cnt := Length(Points);
|
||
SetLength(p,cnt);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
DrawBezier(P,cnt,color,awidth,style,bc,bs,True,inCombined,nil,Rgn,0,0,0);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
BezierElpArcPoints(Points,cx,cy,Rada,Radb,angle,0,2*pi);
|
||
cnt := Length(Points);
|
||
SetLength(p,cnt);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
DrawBezier(P,cnt,color,awidth,style,bc,bs,True,inCombined,nil,Rgn,0,0,0);
|
||
end;
|
||
|
||
end;
|
||
|
||
|
||
|
||
Procedure TPCDrawEngine.drawBezElpArc(cx,cy,radA,radB,a1,a2,angle:Double;color,awidth,style,bc,bs,arcstyle: integer;
|
||
var rgn:HRGN; var p1,p2: TDoublePoint;inCombined:Boolean;row:Integer);
|
||
var Points: T2DPointArray;
|
||
P: TDoublePointArr;
|
||
I: integer;
|
||
cnt,cntA : integer;
|
||
r: Integer;
|
||
xRect:TDoubleRect;
|
||
closed: Boolean;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
Closed := (a1 = a2) or (abs(a2-a1) = 2*pi) or (arcStyle <> 0);
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
BezierElpArcPoints(Points,cx,cy,Rada,Radb,angle,a1,a2);
|
||
cnt := Length(Points);
|
||
|
||
cntA := 0;
|
||
if arcStyle = 1 then cntA := 6
|
||
else if ArcStyle = 2 then cntA := 3;
|
||
SetLength(p,cnt+cntA);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
|
||
if arcStyle = 1 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := DoublePoint(cx,cy);
|
||
P[cnt-1+3] := DoublePoint(cx,cy);
|
||
P[cnt-1+4] := DoublePoint(cx,cy);
|
||
P[cnt-1+5] := P[0];
|
||
P[cnt-1+6] := P[0];
|
||
cntA := 6;
|
||
end else if ArcStyle = 2 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := P[0];
|
||
P[cnt-1+3] := P[0];
|
||
cntA := 3;
|
||
end;
|
||
|
||
p1 := DoublePoint(p[0].x,p[0].y);
|
||
p2 := DoublePoint(p[cnt-1].x,p[cnt-1].y);
|
||
|
||
DrawBezier(P,cnt+cntA,color,awidth,style,bc,bs,True,inCombined,nil,Rgn,row,3.5,1.2);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
BezierElpArcPoints(Points,cx,cy,Rada,Radb,angle,a1,a2);
|
||
cnt := Length(Points);
|
||
|
||
cntA := 0;
|
||
if arcStyle = 1 then cntA := 6
|
||
else if ArcStyle = 2 then cntA := 3;
|
||
SetLength(p,cnt+cntA);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
|
||
if arcStyle = 1 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := DoublePoint(cx,cy);
|
||
P[cnt-1+3] := DoublePoint(cx,cy);
|
||
P[cnt-1+4] := DoublePoint(cx,cy);
|
||
P[cnt-1+5] := P[0];
|
||
P[cnt-1+6] := P[0];
|
||
cntA := 6;
|
||
end else if ArcStyle = 2 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := P[0];
|
||
P[cnt-1+3] := P[0];
|
||
cntA := 3;
|
||
end;
|
||
|
||
p1 := DoublePoint(p[0].x,p[0].y);
|
||
p2 := DoublePoint(p[cnt-1].x,p[cnt-1].y);
|
||
|
||
DrawBezier(P,cnt+cntA,color,awidth,style,bc,bs,True,inCombined,nil,Rgn,row,3.5,1.2);
|
||
end;
|
||
end;
|
||
// Tolik 24/11/2019 --
|
||
//Function TPCDrawEngine.BezierRegion(bPoints:TDoublePointArr):Integer;
|
||
Function TPCDrawEngine.BezierRegion(bPoints:TDoublePointArr): HRGN;
|
||
//
|
||
var I,a: integer;
|
||
cnt: Integer;
|
||
x,y,z: Double;
|
||
iPoints: Array of TPoint;
|
||
begin
|
||
cnt := Length(bPoints);
|
||
|
||
z := 0;
|
||
SetLength(iPoints,cnt);
|
||
for a := 0 to cnt-1 do
|
||
begin
|
||
x := bPoints[a].x;y := bPoints[a].y;
|
||
ConvertCoord(x,y,z);
|
||
iPoints[a] := DP2P(x,y);
|
||
end;
|
||
|
||
BeginPath(FCanvas.Handle);
|
||
FCanvas.PolyBezier(iPoints);
|
||
EndPath(FCanvas.Handle);
|
||
Result := PathToRegion(FCanvas.Handle);
|
||
end;
|
||
// Tolik 24/11/2019 --
|
||
//Function TPCDrawEngine.CreateDoubleArcRegion(cx,cy,rad1,rad2,a1,a2,a3,a4:Double):Integer;
|
||
Function TPCDrawEngine.CreateDoubleArcRegion(cx,cy,rad1,rad2,a1,a2,a3,a4:Double):HRGN;
|
||
//
|
||
var Points: T2DPointArray;
|
||
P: TDoublePointArr;
|
||
I,a: integer;
|
||
cnt,pcnt : integer;
|
||
r: Integer;
|
||
x,y,z: Double;
|
||
iPoints: Array of TPoint;
|
||
begin
|
||
BezierArcPoints(Points,cx,cy,Rad1,a1,a2);
|
||
cnt := Length(Points);
|
||
SetLength(p,cnt);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
|
||
BezierArcPoints(Points,cx,cy,Rad2,a3,a4);
|
||
pcnt := Length(Points);
|
||
|
||
SetLength(p,cnt+2);
|
||
|
||
P[Cnt-2+2] := P[Cnt-1];
|
||
P[Cnt-1+2] := DoublePoint(Points[pcnt-1].x,Points[pcnt-1].y);
|
||
|
||
cnt := cnt+2;
|
||
|
||
SetLength(p,cnt+pcnt);
|
||
for I := 0 to pcnt-1 do
|
||
begin
|
||
P[cnt+I].X := Points[pcnt-1-I].X;
|
||
P[cnt+I].Y := Points[pcnt-1-I].Y;
|
||
end;
|
||
|
||
cnt := cnt+pCnt;
|
||
SetLength(p,cnt+3);
|
||
P[Cnt-3+3] := P[Cnt-1];
|
||
P[Cnt-2+3] := P[0];
|
||
P[Cnt-1+3] := P[0];
|
||
cnt := cnt+3;
|
||
SetLength(iPoints,cnt);
|
||
for a := 0 to cnt-1 do
|
||
begin
|
||
x := p[a].x;y := p[a].y;
|
||
z := 0;
|
||
ConvertCoord(x,y,z);
|
||
iPoints[a] := DP2P(x,y);
|
||
end;
|
||
//FCanvas.Pen.Color := clRed;
|
||
//FCanvas.Pen.Style := psSolid;
|
||
//Fcanvas.Pen.Mode := pmCopy;
|
||
//FCanvas.PolyBezier(iPoints);
|
||
//FCanvas.Polygon(iPoints);
|
||
BeginPath(FCanvas.Handle);
|
||
FCanvas.PolyBezier(iPoints);
|
||
EndPath(FCanvas.Handle);
|
||
Result := PathToRegion(FCanvas.Handle);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.AddBezArcPoints(var dPoints:TDoublePointArr; cp:TDoublePoint;rad,a1,a2:Double; dirPoint:TDoublePoint);
|
||
var cnt,bcnt,i,index: Integer;
|
||
Points: T2DPointArray;
|
||
inverted : Boolean;
|
||
d1,d2: Double;
|
||
begin
|
||
cnt := Length(dPoints);
|
||
BezierArcPoints(Points,cp.x,cp.y,Rad,a1,a2);
|
||
inverted := false;
|
||
bcnt := Length(Points);
|
||
if (bcnt > 1) then begin
|
||
d1 := GetLineLenght(dirPoint,DoublePOint(points[0].x,points[0].y));
|
||
d2 := GetLineLenght(dirPoint,DoublePOint(points[bcnt-1].x,points[bcnt-1].y));
|
||
if d2 > d1 then inverted := true;
|
||
end;
|
||
SetLength(dPoints,cnt+bcnt);
|
||
for i:= 0 to bcnt-1 do
|
||
begin
|
||
index := i;
|
||
if inverted then index := bcnt-1-i;
|
||
dPoints[cnt+i] := DoublePOint(Points[index].X,Points[index].Y);
|
||
end;
|
||
|
||
end;
|
||
// Tolik 24/11/2019 --
|
||
//Function TPCDrawEngine.CreateArcRegion(cx,cy,rad,a1,a2:Double):Integer;
|
||
Function TPCDrawEngine.CreateArcRegion(cx,cy,rad,a1,a2:Double): HRGN;
|
||
//
|
||
var Points: T2DPointArray;
|
||
P: TDoublePointArr;
|
||
I,a: integer;
|
||
cnt : integer;
|
||
r: Integer;
|
||
x,y,z: Double;
|
||
iPoints: Array of TPoint;
|
||
begin
|
||
BezierArcPoints(Points,cx,cy,Rad,a1,a2);
|
||
cnt := Length(Points);
|
||
|
||
SetLength(p,cnt+6);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := DoublePoint(cx,cy);
|
||
P[cnt-1+3] := DoublePoint(cx,cy);
|
||
P[cnt-1+4] := DoublePoint(cx,cy);
|
||
P[cnt-1+5] := P[0];
|
||
P[cnt-1+6] := P[0];
|
||
|
||
cnt := cnt+6;
|
||
SetLength(iPoints,cnt);
|
||
for a := 0 to cnt-1 do
|
||
begin
|
||
x := p[a].x;y := p[a].y;
|
||
z := 0;
|
||
ConvertCoord(x,y,z);
|
||
iPoints[a] := DP2P(x,y);
|
||
end;
|
||
|
||
BeginPath(FCanvas.Handle);
|
||
FCanvas.PolyBezier(iPoints);
|
||
|
||
EndPath(FCanvas.Handle);
|
||
Result := PathToRegion(FCanvas.Handle);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.drawbezarc(cx,cy,rad,a1,a2:Double;color,awidth,style,bc,bs,arcstyle: integer;
|
||
var rgn:HRGN; var p1,p2: TDoublePoint; Incombined:Boolean;row:Integer; rowL:double=3.5;rowH:double=1.2);
|
||
var Points: T2DPointArray;
|
||
P: TDoublePointArr;
|
||
I: integer;
|
||
cnt,cntA : integer;
|
||
r: Integer;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
// Tolik 05/09/2017 --
|
||
CanvasPenColor, CanvasBrushColor: Integer;
|
||
//
|
||
begin
|
||
// Tolik 05/09/2017 --
|
||
CanvasPenColor := FCanvas.pen.color;
|
||
CanvasBrushColor := FCanvas.brush.color;
|
||
//
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
BezierArcPoints(Points,cx,cy,Rad,a1,a2);
|
||
cnt := Length(Points);
|
||
|
||
cntA := 0;
|
||
if arcStyle = 1 then cntA := 6
|
||
else if ArcStyle = 2 then cntA := 3;
|
||
SetLength(p,cnt+cntA);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
|
||
if arcStyle = 1 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := DoublePoint(cx,cy);
|
||
P[cnt-1+3] := DoublePoint(cx,cy);
|
||
P[cnt-1+4] := DoublePoint(cx,cy);
|
||
P[cnt-1+5] := P[0];
|
||
P[cnt-1+6] := P[0];
|
||
cntA := 6;
|
||
end else if ArcStyle = 2 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := P[0];
|
||
P[cnt-1+3] := P[0];
|
||
cntA := 3;
|
||
end;
|
||
|
||
p1 := DoublePoint(p[0].x,p[0].y);
|
||
p2 := DoublePoint(p[cnt-1].x,p[cnt-1].y);
|
||
|
||
DrawBezier(P,cnt+cntA,color,awidth,style,bc,bs,True,inCombined,nil,Rgn,row,rowL,rowH);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
BezierArcPoints(Points,cx,cy,Rad,a1,a2);
|
||
cnt := Length(Points);
|
||
|
||
cntA := 0;
|
||
if arcStyle = 1 then cntA := 6
|
||
else if ArcStyle = 2 then cntA := 3;
|
||
SetLength(p,cnt+cntA);
|
||
for I := 0 to cnt-1 do
|
||
begin
|
||
P[I].X := Points[I].X;
|
||
P[I].Y := Points[I].Y;
|
||
end;
|
||
|
||
if arcStyle = 1 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := DoublePoint(cx,cy);
|
||
P[cnt-1+3] := DoublePoint(cx,cy);
|
||
P[cnt-1+4] := DoublePoint(cx,cy);
|
||
P[cnt-1+5] := P[0];
|
||
P[cnt-1+6] := P[0];
|
||
cntA := 6;
|
||
end else if ArcStyle = 2 then begin
|
||
P[cnt-1+1] := P[cnt-1];
|
||
P[cnt-1+2] := P[0];
|
||
P[cnt-1+3] := P[0];
|
||
cntA := 3;
|
||
end;
|
||
|
||
try
|
||
p1 := DoublePoint(p[0].x,p[0].y);
|
||
p2 := DoublePoint(p[cnt-1].x,p[cnt-1].y);
|
||
except
|
||
end;
|
||
|
||
try //07.10.2011
|
||
DrawBezier(P,cnt+cntA,color,awidth,style,bc,bs,True,inCombined,nil,Rgn,row,rowL,rowH);
|
||
except
|
||
on E: Exception do AddExceptionToLogEx('TPCDrawEngine.drawbezarc', E.Message);
|
||
end;
|
||
end;
|
||
// Tolik -- 05/09/2017 --
|
||
//FCanvas.pen.color := CanvasPenColor;
|
||
//FCanvas.brush.color := CanvasBrushColor;
|
||
//
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.DrawEllipse(x,y, // center
|
||
a,b, // axis length
|
||
xangle: Double; // rotation angle in radiant
|
||
lines: integer; // number of lines
|
||
color,awidth,style,bc,bs: integer;
|
||
var regHandle: HRGN;
|
||
var BoundRect: TDoubleRect);
|
||
var sinAngle : real;
|
||
cosAngle : real;
|
||
theta : real;
|
||
xp,yp : real;
|
||
xr, yr : Double;
|
||
li : integer;
|
||
points : TDoublePointArr;
|
||
z: Double;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
|
||
sinAngle := sin (xangle);
|
||
cosAngle := cos (xangle);
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
|
||
if xangle = 0 then
|
||
begin
|
||
BoundRect := DoubleRect(x-a,y-b,x+a,y+b);
|
||
end;
|
||
|
||
if xangle = 0 then
|
||
begin
|
||
z := 0;
|
||
ConvertCoord(x,y,z);ConvertDim(a);ConvertDim(b);
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
FCanvas.Ellipse(Round(x-a),Round(y-b),round(x+a),Round(y+b));
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
FCanvas.Ellipse(Round(x-a),Round(y-b),round(x+a),Round(y+b));
|
||
end;
|
||
|
||
if RegHandle = 0 then
|
||
RegHandle := CreateEllipticRgn(Round(x-a),Round(y-b),round(x+a),Round(y+b));
|
||
end
|
||
else
|
||
begin
|
||
BoundRect.Left := x;
|
||
BoundRect.Right := x;
|
||
BoundRect.Top := y;
|
||
BoundRect.Bottom := y;
|
||
SetLength(points,lines+1);
|
||
for li := 0 to lines
|
||
do begin
|
||
theta := (li/lines) * 2*PI; // angle step
|
||
xp := a * cos(theta); // ellipse point
|
||
yp := b * sin(theta);
|
||
// rotate ellipse point around center
|
||
xr := (x - xp * cosAngle + yp * sinAngle);
|
||
yr := (y + xp * sinAngle + yp * cosAngle);
|
||
points[li].x := xr;
|
||
points[li].y := yr;
|
||
|
||
if xr > BoundRect.Right then BoundRect.Right := xr
|
||
else if xr< BoundRect.Left then BoundRect.Left := xr;
|
||
if yr > BoundRect.Bottom then BoundRect.Bottom := yr
|
||
else if yr < BoundRect.Top then BoundRect.Top := yr;
|
||
end;
|
||
Polygon(points,RegHandle);
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawFigureIcon(fRect: TDoubleRect; ix,iy: Double;vpos: TIconVertPos;hPos: TIconHorzPos; Icon: Tbitmap);
|
||
var x,y,xx,yy,z: Double;
|
||
mRect: Trect;
|
||
sx,sy,pw,ph: Integer;
|
||
begin
|
||
z := 0;
|
||
x := fRect.Left; y := fRect.Top; ConvertCoord(x,y,z);
|
||
xx := fRect.Right; yy := fRect.Bottom; ConvertCoord(xx,yy,z);
|
||
ConvertDim(ix);ConvertDim(iy);
|
||
pw := Icon.Width;
|
||
ph := Icon.Height;
|
||
if x > xx then begin
|
||
mRect.Left := Round(xx);
|
||
mRect.Right := Round(x);
|
||
end else begin
|
||
mRect.Right := Round(xx);
|
||
mRect.Left := Round(x);
|
||
end;
|
||
if y > yy then begin
|
||
mRect.Top := Round(yy);
|
||
mRect.Bottom := Round(y);
|
||
end else begin
|
||
mRect.Bottom := Round(yy);
|
||
mRect.Top := Round(y);
|
||
end;
|
||
|
||
case vPos of
|
||
vposTop : sy := mRect.Top+Round(iy);
|
||
vposBottom: sy := mRect.Bottom-ph-Round(iy);
|
||
vposMiddle: sy := (mRect.Bottom+mRect.Top) div 2 - (ph div 2) - Round(iy);
|
||
end;
|
||
case hPos of
|
||
hposLeft : sx := mRect.Left+Round(ix);
|
||
hposRight : sx := mRect.Right-pw-Round(ix);
|
||
hposMiddle: sx := (mRect.Right+mRect.Left) div 2 - (pw div 2) - Round(ix);
|
||
end;
|
||
Fcanvas.Draw(sx,sy,Icon);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawEllipticArc( x,y, // center
|
||
a,b, // axis length
|
||
xangle: Double; // rotation angle in radiant
|
||
startangle : Double;
|
||
drawangle : double;
|
||
lines: integer; // number of lines
|
||
color,awidth,style,bc,bs,arcstyle: integer;
|
||
var lp1,lp2: TPoint;
|
||
var regHandle: HRGN;
|
||
var BoundRect: TDoubleRect);
|
||
var sinAngle : real;
|
||
cosAngle : real;
|
||
tanAngle : real;
|
||
angle : real;
|
||
theta : real;
|
||
xp,yp : real;
|
||
xr, yr : Double;
|
||
li : integer;
|
||
stpoint,enpoint: Tpoint;
|
||
points : TDoublePointArr;
|
||
begin
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
if arcstyle <> 0 then
|
||
begin
|
||
FCanvas.Brush.Color := bc;
|
||
FCanvas.Brush.Style := TBrushStyle(bs);
|
||
end;
|
||
sinAngle := sin (angle);
|
||
cosAngle := cos (angle);
|
||
tanAngle := tan (angle);
|
||
|
||
If arcstyle = 1 then
|
||
SetLength(points,lines+1)
|
||
else
|
||
SetLength(points,lines);
|
||
|
||
for li := 0 to lines-1
|
||
do begin
|
||
|
||
theta := ((li/(lines-1)) * ((DrawAngle)*(PI/1800))) + (StartAngle+1800)* (PI/1800); // angle step
|
||
xp := a * cos(theta); // ellipse point
|
||
yp := b * sin(theta);
|
||
// rotate ellipse point around center
|
||
xr := x - xp * cosAngle + yp * sinAngle;
|
||
yr := y + xp * sinAngle + yp * cosAngle;
|
||
|
||
if li = 0 then BoundRect := DoubleRect(xr,yr,xr,yr);
|
||
|
||
points[li].x := xr;
|
||
points[li].y := yr;
|
||
if xr > BoundRect.Right then BoundRect.Right := xr
|
||
else if xr< BoundRect.Left then BoundRect.Left := xr;
|
||
|
||
if yr > BoundRect.Bottom then BoundRect.Bottom := yr
|
||
else if yr < BoundRect.Top then BoundRect.Top := yr;
|
||
|
||
end;
|
||
If arcstyle = 1 then
|
||
begin
|
||
points[lines].x := x;
|
||
points[lines].y := y;
|
||
if x > BoundRect.Right then BoundRect.Right := x
|
||
else if x< BoundRect.Left then BoundRect.Left := x;
|
||
if y > BoundRect.Bottom then BoundRect.Bottom := y
|
||
else if y < BoundRect.Top then BoundRect.Top := y;
|
||
PolyGon(points,RegHandle);
|
||
end
|
||
else if arcstyle = 2 then
|
||
Polygon(points,regHandle)
|
||
else if arcstyle = 0 then
|
||
PolyLine(points);
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.drawpatbezier(points:TDoublePointArr;
|
||
nbrPoint,color,awidth,style,brc,brs:integer;Filled:Boolean;
|
||
pattern:Tobject);
|
||
var a: integer;
|
||
tx,px,py : real;
|
||
t : array[1..4] of real;
|
||
mcol,mrow: integer;
|
||
pntx,pnty: array[1..4] of integer;
|
||
|
||
rDist,difDist,pDist: Double;
|
||
x,y,i,k,b: Integer;
|
||
sPoint: Tpoint;
|
||
cPoints: array of TPoint;
|
||
conP:Tpoint;
|
||
p1,p2,p3,p4: TDoublePoint;
|
||
li,pi,pf:TDoublePoint;
|
||
LastIndex : Integer;
|
||
xPattern: Tpattern;
|
||
pa,pb: TDoublePoint;
|
||
ang: real;
|
||
r:Integer;
|
||
pCnt,xCnt: Integer;
|
||
res: Integer;
|
||
iPoints: Array of TPoint;
|
||
rem,lLen,cWidth,gw,pw: Double;
|
||
isLine: Boolean;
|
||
|
||
procedure FlushLine(isObjects:Boolean);
|
||
var n: Integer;Scale:Double;
|
||
pwOld: Double;
|
||
begin
|
||
pwOld := pW;
|
||
lLen := GetLineLenght(p1,p4);
|
||
xCnt := Trunc((lLen+gw) / pDist);
|
||
if xcnt = 0 then begin
|
||
pw := lLen;
|
||
xcnt := 1;
|
||
end
|
||
else begin
|
||
rem := lLen - (xCnt*pw) - ((xcnt-1)*gw);
|
||
pW := pw + (rem / xCnt);
|
||
end;
|
||
pi := p1;
|
||
cWidth := 0;
|
||
Scale := pw/pwOld;
|
||
for n := 1 to xCnt do
|
||
begin
|
||
rDist := GetLinePatch(p1,p4,pw+gw,cWidth,pi,pf);
|
||
if isObjects then
|
||
xPattern.DrawObjects(Self,pi,pf,Scale)
|
||
else
|
||
xPattern.Draw(Self,pi,pf,Scale);
|
||
pi := pf;
|
||
end;
|
||
end;
|
||
|
||
procedure FlushBezier(isObjects:Boolean);
|
||
begin
|
||
LastIndex := 0;
|
||
xCnt := 0;
|
||
pCnt := 0;
|
||
repeat
|
||
rDist := GetBezierPatch(p1,p2,p3,p4,pDist,LastIndex,pi,pf,false,res);
|
||
pCnt := pCnt +1;
|
||
Until LastIndex = res;
|
||
|
||
if (pCnt > 1) and (rDist < (pdist * 0.9)) then
|
||
begin
|
||
pCnt := pCnt -1;
|
||
if rDist < (pdist / 2) then begin
|
||
pDist := pDist + round(rDist/pCnt);
|
||
end else begin
|
||
pDist := ((pDist * pCnt)+rDist) / (pcnt+1);
|
||
pCnt := pCnt+1;
|
||
end;
|
||
end;
|
||
|
||
LastIndex := 0;
|
||
xCnt := 0;
|
||
repeat
|
||
xCnt := xCnt +1;
|
||
if xCnt = pCnt then
|
||
rDist := GetBezierPatch(p1,p2,p3,p4,pDist,LastIndex,pi,pf,True,res)
|
||
else
|
||
rDist := GetBezierPatch(p1,p2,p3,p4,pDist,LastIndex,pi,pf,False,res);
|
||
if isObjects then
|
||
xPattern.DrawObjects(Self,pi,pf,rDist/pDist)
|
||
else
|
||
xPattern.Draw(Self,pi,pf,rDist/pDist);
|
||
Until LastIndex = res;
|
||
|
||
end;
|
||
|
||
begin
|
||
res := 500;
|
||
xPattern := Tpattern(pattern);
|
||
FCanvas.pen.style := psSolid;
|
||
pDist := xPattern.pWidth+xPattern.Gap;
|
||
if pDist > 0 then
|
||
begin
|
||
if xPattern.Vector.Segments.Count > 0 then
|
||
begin
|
||
a := 0;
|
||
xPattern.StartDraw(Self,Points[0]);
|
||
repeat
|
||
p1 := Points[a];inc(a);p2 := Points[a];inc(a);p3 := Points[a];inc(a);
|
||
p4 := Points[a];
|
||
gw := xPattern.Gap;
|
||
pw := xPattern.pWidth;
|
||
|
||
if (p1.x = p2.x) and (p1.y = p2.y) and
|
||
(p3.x = p4.x) and (p3.y = p4.y) then
|
||
FlushLine(false)
|
||
else
|
||
FlushBezier(false);
|
||
until a >= nbrPoint-1;
|
||
end;
|
||
if xPattern.Vector.Objects.Count > 0 then
|
||
begin
|
||
a := 0;
|
||
xPattern.StartDraw(Self,Points[0]);
|
||
repeat
|
||
p1 := Points[a];inc(a);p2 := Points[a];inc(a);p3 := Points[a];inc(a);
|
||
p4 := Points[a];
|
||
gw := xPattern.Gap;
|
||
pw := xPattern.pWidth;
|
||
|
||
if (p1.x = p2.x) and (p1.y = p2.y) and
|
||
(p3.x = p4.x) and (p3.y = p4.y) then
|
||
FlushLine(true)
|
||
else
|
||
FlushBezier(true);
|
||
until a >= nbrPoint-1;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawbezier(points:TDoublePointArr; color,awidth,style:integer);
|
||
var rgn: HRGN;
|
||
begin
|
||
rgn := 1;
|
||
DrawBezier(Points,Length(Points),color,aWidth,style,0,ord(bsClear),False,False,nil,rgn,0,0,0);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawbezier(points:TDoublePointArr;
|
||
nbrPoint,color,awidth,style,brc,brs:integer;Filled,InCombined:Boolean;
|
||
pattern:Tobject;var RegHandle:HRGN; row:Integer;rowL,rowH:Double;brsBmp:TBitmap=nil);
|
||
var a: integer;
|
||
iPoints: Array of TPoint;
|
||
x,y,z: Double;
|
||
usepath: Boolean;
|
||
p: TDoublePoint;
|
||
rt: Integer;
|
||
oldbr,hbr: HBRUSH;
|
||
|
||
begin
|
||
//usepath := filled and (not inCombined);
|
||
usepath := (not inCombined);
|
||
hbr := 0;
|
||
if filled and assigned(brsBmp) then begin
|
||
hbr := CreatePatternBrush(brsBmp.Handle);
|
||
end;
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.Brush.Style := bsClear;
|
||
SetLength(iPoints,nbrPoint);
|
||
|
||
for a := 0 to nbrPoint-1 do
|
||
begin
|
||
x := points[a].x;y := points[a].y;z := 0;
|
||
ConvertCoord(x,y,z);
|
||
iPoints[a] := DP2P(x,y);
|
||
end;
|
||
|
||
if usepath then BeginPath(FCanvas.Handle);
|
||
|
||
|
||
|
||
rt := 0;
|
||
if row in [1,2,3] then rt := 1
|
||
else if row in [4,5,6] then rt := 4;
|
||
|
||
if row in [2,3,5,6] then begin
|
||
p:= GetBezierBegin(points[0],points[1],points[2],points[3],5,500);
|
||
DrawLine(p.x,p.y,points[0].x,points[0].y,color,1,ord(psDot),rt,rowL,rowH);
|
||
end;
|
||
|
||
if row in [1,3,4,6] then begin
|
||
p:= GetBezierEnd(points[nbrPoint-4],points[nbrPoint-3],points[nbrPoint-2],points[nbrPoint-1],5,500);
|
||
DrawLine(p.x,p.y,points[nbrPoint-1].x,points[nbrPoint-1].y,color,1,ord(psDot),rt,rowL,rowH);
|
||
end;
|
||
|
||
if Pattern = nil then
|
||
begin
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.PolyBezier(iPoints);
|
||
end
|
||
else begin
|
||
drawpatbezier(points,nbrPoint,color,awidth,style,brc,brs,Filled,
|
||
pattern);
|
||
end;
|
||
|
||
|
||
if (usepath) then
|
||
begin
|
||
EndPath(FCanvas.Handle);
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.Brush.Color := brc;
|
||
FCanvas.Brush.Style := TBrushStyle(brs);
|
||
if hbr <> 0 then begin
|
||
oldBr := SelectObject(FCanvas.Handle,hbr);
|
||
end;
|
||
if FCanvas.Brush.Style = bsClear then
|
||
begin
|
||
StrokePath(FCanvas.Handle);
|
||
end else begin
|
||
StrokeAndFillPath(FCanvas.Handle);
|
||
end;
|
||
if hbr <> 0 then begin
|
||
SelectObject(FCanvas.Handle,oldBr);
|
||
DeleteObject(hbr);
|
||
end;
|
||
end;
|
||
if usepath and (RegHandle = 0) then begin
|
||
BeginPath(FCanvas.Handle);
|
||
FCanvas.PolyBezier(iPoints);
|
||
EndPath(FCanvas.Handle);
|
||
RegHandle := PathToRegion(FCanvas.Handle);
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawTransparentMetafile(p1,p2,p3,p4: TDoublepoint;
|
||
color,awidth,style: Integer;
|
||
metafile: TMetafile;var RegHandle: HRGN);
|
||
Var xmax,ymax,xmin,ymin: Double;
|
||
tP,pn: TDoublePoint;
|
||
ang: real;
|
||
flipMode:TFlipModes;
|
||
xRect:Trect;
|
||
ptr: Pointer;
|
||
iPoints: Array [0..4] of TPoint;
|
||
x,y,z: Double;
|
||
Begin
|
||
flipMode := [];
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.Pen.Mode := pmCopy;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.color := color;
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.Brush.Style := bsClear;
|
||
|
||
if p1.x > p2.x then begin
|
||
tp := p1;
|
||
p1 := p2;
|
||
p2 := tp;
|
||
////////
|
||
tp := p3;
|
||
p3 := p4;
|
||
p4 := tp;
|
||
flipMode := flipMode + [fmHorz];
|
||
end;
|
||
|
||
if p1.y > p4.y then begin
|
||
tp := p1;
|
||
p1 := p4;
|
||
p4 := tp;
|
||
////////
|
||
tp := p3;
|
||
p3 := p2;
|
||
p2 := tp;
|
||
flipMode := flipMode + [fmVert];
|
||
end;
|
||
|
||
if RegHandle = 0 then
|
||
begin
|
||
z := 0;
|
||
x := p1.x; y := p1.y; ConvertCoord(x,y,z); iPoints[0] := DP2P(x,y);
|
||
x := p2.x; y := p2.y; ConvertCoord(x,y,z); iPoints[1] := DP2P(x,y);
|
||
x := p3.x; y := p3.y; ConvertCoord(x,y,z); iPoints[2] := DP2P(x,y);
|
||
x := p4.x; y := p4.y; ConvertCoord(x,y,z); iPoints[3] := DP2P(x,y);
|
||
RegHandle := CreatePolyGonRgn(iPoints,4,1);
|
||
end;
|
||
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
ConvertCoord(p2.x,p2.y,z);
|
||
ConvertCoord(p3.x,p3.y,z);
|
||
ConvertCoord(p4.x,p4.y,z);
|
||
ang := getRadOfLine(p1,p2);
|
||
|
||
if ang <> 0 then begin
|
||
RotateCanvas(FCanvas.handle,ang);
|
||
p1 := RotatePoint(DoublePoint(0,0),DoublePoint(p1.x,p1.y),-1*ang);
|
||
p2 := RotatePoint(DoublePoint(0,0),DoublePoint(p2.x,p2.y),-1*ang);
|
||
p3 := RotatePoint(DoublePoint(0,0),DoublePoint(p3.x,p3.y),-1*ang);
|
||
p4 := RotatePoint(DoublePoint(0,0),DoublePoint(p4.x,p4.y),-1*ang);
|
||
end;
|
||
|
||
xmax := MaxValue([p1.x,p2.x,p3.x,p4.x]);
|
||
ymax := MaxValue([p1.y,p2.y,p3.y,p4.y]);
|
||
xmin := MinValue([p1.x,p2.x,p3.x,p4.x]);
|
||
ymin := MinValue([p1.y,p2.y,p3.y,p4.y]);
|
||
|
||
//if flipMode = [fmHorz] then
|
||
// xrect := DR2R(xmax,ymin,xmin,ymax)
|
||
//else if flipMode = [fmVert] then
|
||
// xrect := DR2R(xmin,ymax,xmax,ymin)
|
||
//else if flipMode = [fmVert,fmHorz] then
|
||
// xrect := DR2R(xmax,ymax,xmin,ymin)
|
||
//else
|
||
|
||
xrect := Dr2R(xmin,ymin,xmax,ymax);
|
||
FirstEMRText := False;
|
||
EnumEnhMetafile(FCanvas.Handle,Metafile.handle,@ProcessRichRecord,ptr,xRect);
|
||
|
||
if ang <> 0 then begin
|
||
ResetCanvas(FCanvas.handle)
|
||
end;
|
||
|
||
End;
|
||
|
||
|
||
Procedure TPCDrawEngine.DrawMetafile(p1, p2, p3, p4: TDoublepoint; color,awidth, style: integer;
|
||
metafile: TMetafile; stretch: Boolean; var RegHandle: HRGN);
|
||
Var
|
||
xmax,ymax,xmin,ymin:Double;
|
||
tP,pn: TDoublePoint;
|
||
ang: real;
|
||
flipMode:TFlipModes;
|
||
xRect:TRect;
|
||
iPoints: Array [0..4] of TPoint;
|
||
x,y,z: Double;
|
||
Begin
|
||
flipMode := [];
|
||
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.Pen.Mode := pmCopy;
|
||
FCanvas.pen.width := awidth;
|
||
|
||
FCanvas.pen.color := color;
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.Brush.Style := bsClear;
|
||
|
||
ConvertCoord(p1.x, p1.y, z);
|
||
ConvertCoord(p2.x, p2.y, z);
|
||
ConvertCoord(p3.x, p3.y, z);
|
||
ConvertCoord(p4.x, p4.y, z);
|
||
|
||
// IGOR -- 19/12/2018 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 90(180, 270, 0, 360...) <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
// <20><>! <20><><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>" <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
//if (p1.x - p2.x) > 0.0001 then
|
||
if (p1.x - p2.x) > 0.01 then
|
||
begin
|
||
tp := p1;
|
||
p1 := p2;
|
||
p2 := tp;
|
||
////////
|
||
tp := p3;
|
||
p3 := p4;
|
||
p4 := tp;
|
||
flipMode := flipMode + [fmHorz];
|
||
end;
|
||
// IGOR -- 19/12/2018 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> 90(180, 270, 0, 360...) <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
// <20><>! <20><><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>" <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
//if (p1.y - p4.y) > 0.0001 then
|
||
if (p1.y - p4.y) > 0.01 then
|
||
begin
|
||
tp := p1;
|
||
p1 := p4;
|
||
p4 := tp;
|
||
////////
|
||
tp := p3;
|
||
p3 := p2;
|
||
p2 := tp;
|
||
flipMode := flipMode + [fmVert];
|
||
end;
|
||
|
||
if RegHandle = 0 then
|
||
begin
|
||
iPoints[0] := DP2P(p1);
|
||
iPoints[1] := DP2P(p2);
|
||
iPoints[2] := DP2P(p3);
|
||
iPoints[3] := DP2P(p4);
|
||
RegHandle := CreatePolyGonRgn(iPoints, 4, 1);
|
||
end;
|
||
|
||
// flipMode := [];
|
||
|
||
ang := getRadOfLine(p1,p2);
|
||
if ang <> 0 then
|
||
begin
|
||
RotateCanvas(FCanvas.handle,ang);
|
||
p1 := RotatePoint(DoublePoint(0,0), p1, -ang);
|
||
p2 := RotatePoint(DoublePoint(0,0), p2, -ang);
|
||
p3 := RotatePoint(DoublePoint(0,0), p3, -ang);
|
||
p4 := RotatePoint(DoublePoint(0,0), p4, -ang);
|
||
end;
|
||
|
||
xmax := MaxValue([p1.x, p2.x, p3.x, p4.x]);
|
||
ymax := MaxValue([p1.y, p2.y, p3.y, p4.y]);
|
||
xmin := MinValue([p1.x, p2.x, p3.x, p4.x]);
|
||
ymin := MinValue([p1.y, p2.y, p3.y, p4.y]);
|
||
if flipMode = [fmHorz] then
|
||
xrect := DR2R(xmax,ymin,xmin,ymax)
|
||
else
|
||
if flipMode = [fmVert] then
|
||
xrect := DR2R(xmin,ymax,xmax,ymin)
|
||
else
|
||
if flipMode = [fmVert,fmHorz] then
|
||
xrect := DR2R(xmax,ymax,xmin,ymin)
|
||
else
|
||
xrect := Dr2R(xmin,ymin,xmax,ymax);
|
||
|
||
xrect.right :=xRect.right + 2;
|
||
xrect.Bottom :=xRect.Bottom + 2;
|
||
|
||
if stretch then
|
||
begin
|
||
FCanvas.StretchDraw(xRect, Metafile);
|
||
// Metafile.SaveToFile('C:\Projects\<5C><><EFBFBD>\!WmfTest\megagovno.wmf');
|
||
end
|
||
else
|
||
FCanvas.Draw(Round(xmin), Round(ymin), Metafile);
|
||
|
||
if ang <> 0 then
|
||
begin
|
||
ResetCanvas(FCanvas.handle);
|
||
end;
|
||
|
||
End;
|
||
|
||
Procedure TPCDrawEngine.DrawBitmap(p1,p2,p3,p4: TDoublepoint;color,awidth,style: integer;
|
||
isTransparent: Boolean;
|
||
Bitmap : TBitmap);
|
||
var xRect: TRect;
|
||
z: Double;
|
||
Begin
|
||
z := 0;
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
ConvertCoord(p2.x,p2.y,z);
|
||
ConvertCoord(p3.x,p3.y,z);
|
||
ConvertCoord(p4.x,p4.y,z);
|
||
xRect := DR2R(p1.x,p1.y,p3.x,p3.y);
|
||
|
||
Bitmap.Transparent := isTransparent;
|
||
if isPrinting then
|
||
begin
|
||
if isTransparent then begin
|
||
comp.Width := Bitmap.width;
|
||
comp.Height := Bitmap.height;
|
||
BitBlt(comp.canvas.handle,0,0,comp.width,comp.height,PrintBmp.canvas.handle,0,0,SRCCOPY);
|
||
comp.canvas.StretchDraw(Rect(0,0,comp.width,comp.height),bitmap);
|
||
PrintBitmap(FCanvas,xRect,comp,SRCCOPY);
|
||
end else begin
|
||
PrintBitmap(FCanvas,xRect,Bitmap,SRCCOPY);
|
||
end;
|
||
end else begin
|
||
FCanvas.StretchDraw(xRect,Bitmap);
|
||
end;
|
||
|
||
end;
|
||
|
||
|
||
//Tolik 20/10/2021 --
|
||
{
|
||
Procedure TPCDrawEngine.DrawPicture(ap1,ap2,ap3,ap4: TDoublepoint;
|
||
color,awidth,style: integer;
|
||
isTransparent: Boolean;
|
||
var Modified: Boolean; Picture : TBitmap;
|
||
Var Image: TBitmap;
|
||
var aImageEdited: Boolean; // Tolik 20/04/20108 --
|
||
doFlip: Boolean;isDeformed: Boolean; var RegHandle: HRGN;Tiled:Boolean=False);
|
||
}
|
||
Procedure TPCDrawEngine.DrawPicture(ap1,ap2,ap3,ap4: TDoublepoint;
|
||
color,awidth,style: integer;
|
||
isTransparent: Boolean;
|
||
var Modified: Boolean; Picture : TBitmap;
|
||
Var Image: TBitmap;
|
||
var aImageEdited: Boolean; // Tolik 20/04/20108 --
|
||
doFlip: Boolean;isDeformed: Boolean; var RegHandle: HRGN;Tiled:Boolean=False;
|
||
GrayColor: TColor = -1);
|
||
//
|
||
|
||
Var
|
||
p1,p2,p3,p4: TPoint;
|
||
xmax,ymax,xmin,ymin,rop: integer;
|
||
cRect: TRect;
|
||
NB,NG,NR: Integer;
|
||
RowOriginal : pRGBArray;
|
||
bitmap: TBitmap;
|
||
tP: TPoint;
|
||
clpcreated :Boolean;
|
||
UseImage,rotated: Boolean;
|
||
parr: Array [0..3] of Tpoint;
|
||
z: Double;
|
||
xRect: Trect;
|
||
rad: Double;
|
||
xp1,xp2,xp3,xp4: TDoublePoint;
|
||
outofscr : Boolean;
|
||
tmpImg: TBitmap;
|
||
useimg: TBitmap;
|
||
xw,xh: Integer;
|
||
r: Double;
|
||
iw,ih,dx,dy: Integer;
|
||
ixmin,ixmax,iymin,iymax: Integer;
|
||
oxmin,oymin,oxmax,oymax: Integer;
|
||
clprgn:HRGN;
|
||
|
||
Begin
|
||
z := 0;
|
||
Rotated := False; // Tolik 17/11/2017 --
|
||
|
||
ConvertCoord(ap1.x,ap1.y,z);
|
||
ConvertCoord(ap2.x,ap2.y,z);
|
||
ConvertCoord(ap3.x,ap3.y,z);
|
||
ConvertCoord(ap4.x,ap4.y,z);
|
||
|
||
p1 := DP2P(ap1);
|
||
p2 := DP2P(ap2);
|
||
p3 := DP2P(ap3);
|
||
p4 := DP2P(ap4);
|
||
|
||
// Tolik 17/11/2017 --
|
||
if p1.x >= p2.x then
|
||
Rotated := true;
|
||
//
|
||
if p1.x > p2.x then
|
||
begin
|
||
tp := p1;
|
||
p1 := p2;
|
||
p2 := tp;
|
||
////////
|
||
tp := p3;
|
||
p3 := p4;
|
||
p4 := tp;
|
||
end;
|
||
if p1.y > p4.y then
|
||
begin
|
||
tp := p1;
|
||
p1 := p4;
|
||
p4 := tp;
|
||
////////
|
||
tp := p3;
|
||
p3 := p2;
|
||
p2 := tp;
|
||
end;
|
||
|
||
|
||
|
||
clpcreated := false;
|
||
parr[0] := p1;
|
||
parr[1] := p2;
|
||
parr[2] := p3;
|
||
parr[3] := p4;
|
||
if RegHandle = 0 then
|
||
RegHandle := CreatePolygonRgn(parr,4,ALTERNATE);
|
||
|
||
clprgn := CreatePolygonRgn(parr,4,ALTERNATE);
|
||
|
||
if (Picture = nil) then exit;
|
||
|
||
// Tolik 20/12/2019 --
|
||
//FCanvas.pen.style := penstyles[style];
|
||
if Style = -1 then
|
||
FCanvas.pen.style := penstyles[0]
|
||
else
|
||
if ((Style > -1) and (Style > (Length(Penstyles) - 1))) then
|
||
FCanvas.pen.style := penstyles[0]
|
||
else
|
||
FCanvas.pen.style := penstyles[style];
|
||
//
|
||
FCanvas.Pen.Mode := pmCopy;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.color := color;
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.Brush.Style := bsClear;
|
||
|
||
|
||
|
||
Picture.Transparent := False;
|
||
UseImage := False;
|
||
// Tolik 17/11/2017 --
|
||
if not Rotated then
|
||
//
|
||
Rotated := IsRotated(p1,p2,p3,p4);
|
||
|
||
if isDeformed then
|
||
begin
|
||
If modified then
|
||
begin
|
||
SkewBitmap(p1,p2,p3,p4,Picture,Image,isTransParent);
|
||
image.Transparent := isTransparent;
|
||
end;
|
||
end
|
||
else
|
||
//Tolik 20/10/2021 --
|
||
//if Rotated then
|
||
begin
|
||
// If modified then // -- Tolik 17/11/2017 --
|
||
if aImageEdited then // Tolik 20/04/2018 --
|
||
begin
|
||
//Tolik 17/11/2017 --
|
||
// MakeBitmap(p1,p2,p3,p4,Picture,Image,isTransParent);
|
||
MakeBitmap(DP2P(ap1),DP2P(ap2),DP2P(ap3),DP2P(ap4),Picture,Image,isTransParent, GrayColor);
|
||
//
|
||
image.Transparent := isTransparent;
|
||
aImageEdited := False; // Tolik 20/04/2018 --
|
||
end;
|
||
end;
|
||
|
||
//Tolik 20/10/2021 --
|
||
//UseImage := Rotated or isDeformed;
|
||
UseImage := Rotated or isDeformed or (GrayColor <> -1);
|
||
//
|
||
|
||
if not useImage then
|
||
Picture.Transparent := isTransparent;
|
||
|
||
xmax := MaxIntValue([p1.x,p2.x,p3.x,p4.x]);
|
||
ymax := MaxIntValue([p1.y,p2.y,p3.y,p4.y]);
|
||
xmin := MinIntValue([p1.x,p2.x,p3.x,p4.x]);
|
||
ymin := MinIntValue([p1.y,p2.y,p3.y,p4.y]);
|
||
|
||
outofscr := false;
|
||
xRect := FCanvas.ClipRect;
|
||
|
||
if ((xMin < 0) and (xMax < 0)) or
|
||
((xmin > xRect.right) and (xMax > xRect.right)) or
|
||
((yMin < 0) and (yMax < 0)) or
|
||
((yMin > xRect.bottom) and (yMax > xRect.bottom)) then outofscr := true;
|
||
|
||
if useImage then
|
||
useimg := image
|
||
else
|
||
useimg := picture;
|
||
tmpimg := nil;
|
||
if (not outofscr) and
|
||
((xMin < 0) or (xMax > xRect.Right) or (yMin < 0) or (yMax > xRect.Bottom))
|
||
then begin
|
||
xw := xMax - xMin;
|
||
xh := yMax - yMin;
|
||
tmpimg := TBitmap.Create;
|
||
tmpimg.Assign(useimg);
|
||
oxmin := xmin;
|
||
oymin := ymin;
|
||
oymax := ymax;
|
||
oxmax := xmax;
|
||
if xMin < 0 then xMin := 0;
|
||
if xMax > xRect.Right then xMax := xRect.Right;
|
||
if yMin < 0 then yMin := 0;
|
||
if yMax > xRect.Bottom then yMax := xRect.Bottom;
|
||
dx := xmin-oxmin;
|
||
r := dx/xw;
|
||
ixmin := 0+ round(useimg.width * r);
|
||
dx := oxmax-xmax;
|
||
r := dx/xw;
|
||
ixmax := useimg.width-round(useimg.width * r);
|
||
dy := ymin-oymin;
|
||
r := dy/xh;
|
||
iymin := 0+ round(useimg.height * r);
|
||
dy := oymax-ymax;
|
||
r := dy/xh;
|
||
iymax := useimg.height-round(useimg.height * r);
|
||
|
||
r := (xmax-xmin)/xw;
|
||
tmpimg.Width := round(tmpimg.Width *r);
|
||
r := (ymax-ymin)/xh;
|
||
tmpimg.height := round(tmpimg.height *r);
|
||
|
||
tmpimg.Canvas.CopyRect(Rect(0,0,tmpimg.Width,tmpimg.Height),useimg.Canvas,Rect(ixmin,iymin,ixmax,iymax));
|
||
|
||
useimg := tmpimg;
|
||
end;
|
||
|
||
if not outofscr then begin
|
||
ClipAnd(ClpRgn);
|
||
//SelectClipRgn(FCanvas.handle,clprgn);
|
||
if isPrinting then
|
||
begin
|
||
if isTransparent then begin
|
||
comp.Width := useimg.width;
|
||
comp.Height := useimg.height;
|
||
BitBlt(comp.canvas.handle,0,0,comp.width,comp.height,PrintBmp.canvas.handle,0,0,SRCCOPY);
|
||
comp.canvas.StretchDraw(Rect(0,0,comp.width,comp.height),useimg);
|
||
PrintBitmap(FCanvas,Rect(xmin,ymin,xmax,ymax),comp,SRCCOPY);
|
||
end else begin
|
||
PrintBitmap(FCanvas,Rect(xmin,ymin,xmax,ymax),useimg,SRCCOPY);
|
||
end;
|
||
end else begin
|
||
FCanvas.StretchDraw(Rect(xmin,ymin,xmax,ymax),useimg);
|
||
end;
|
||
ClipBack;
|
||
//SelectClipRgn(FCanvas.handle,0);
|
||
end;
|
||
if assigned(tmpImg) then tmpImg.Free;
|
||
DeleteObject(clprgn);
|
||
FCanvas.PolyLine([p1,p2,p3,p4,p1]);
|
||
if modified then modified := false;
|
||
End;
|
||
|
||
|
||
|
||
Function TPCDrawEngine.isRotated(p1,p2,p3,p4: TPoint):Boolean;
|
||
Begin
|
||
if p2.y = p1.y then isRotated := False
|
||
else isRotated := True;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.Clip(clpRgn:HRGN);
|
||
begin
|
||
ClipRgn := clpRgn;
|
||
SelectClipRgn(FCanvas.Handle,clpRgn);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.SetUpOpenGL(Wnd:HWND);
|
||
var
|
||
DC:HDC;
|
||
RC:HGLRC;
|
||
begin
|
||
//dc := GetDc(Wnd);
|
||
//SetupPixelFormat(DC);
|
||
//RC:=wglCreateContext(DC); //makes OpenGL window out of DC
|
||
//wglMakeCurrent(DC, RC); //makes OpenGL window active
|
||
//GLInit; //initialize OpenGL
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.GLInit;
|
||
begin
|
||
// set viewing projection
|
||
glMatrixMode(GL_PROJECTION);
|
||
glFrustum(-0.4, 0.4, -0.4, 0.4, 0.3, 25.0);
|
||
// position viewer
|
||
glMatrixMode(GL_MODELVIEW);
|
||
glEnable(GL_DEPTH_TEST);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.GLPaint;
|
||
begin
|
||
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
|
||
glLoadIdentity;
|
||
SwapBuffers(wglGetCurrentDC);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.ClearPens;
|
||
var
|
||
i: Integer;
|
||
begin
|
||
for i := 0 to FPens.Count - 1 do
|
||
begin
|
||
try
|
||
DeleteObject(TExtPen(FPens.Objects[i]).FhPen);
|
||
FPens.Objects[i].Free;
|
||
except
|
||
on E: Exception do AddExceptionToLogExt(ClassName, 'ClearPens', E.Message);
|
||
end;
|
||
end;
|
||
FPens.Clear;
|
||
end;
|
||
|
||
procedure GetDeviceSettings;
|
||
var
|
||
retval: integer;
|
||
PixX, PixY: Integer;
|
||
begin
|
||
|
||
FDeviceName := Printer.Printers[Printer.PrinterIndex]; {<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>}
|
||
FPageHeightPixel := Printer.PageHeight; {<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
FPageWidthPixel := Printer.PageWidth; {<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
FOrientation := Printer.Orientation;
|
||
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
|
||
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (<28><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>)}
|
||
FPrintOffsetPixels.X := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETX);
|
||
FPrintOffsetPixels.Y := GetDeviceCaps(Printer.Handle, PHYSICALOFFSETY);
|
||
|
||
{<7B><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>}
|
||
PixX := GetDeviceCaps(Printer.Handle, LOGPIXELSX);
|
||
PixY := GetDeviceCaps(Printer.Handle, LOGPIXELSY);
|
||
FPixelsPerMMX := INCHES_PER_MILIMETER * PixX;
|
||
FPixelsPerMMY := INCHES_PER_MILIMETER * PixY;
|
||
FPageHeightMM := Round(FPageHeightPixel / FPixelsPerMMY);
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.DefinePrinting;
|
||
begin
|
||
FPrinting := false;
|
||
if Printer.Printing then
|
||
begin
|
||
try
|
||
if FCanvas.Handle = Printer.Canvas.Handle then
|
||
begin
|
||
if FDeviceName <> Printer.Printers[Printer.PrinterIndex] then
|
||
GetDeviceSettings;
|
||
FPrinting := True;
|
||
end;
|
||
except
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
function TPCDrawEngine.ExtractExtPenByCanvas: HPEN;
|
||
var
|
||
StrKey: String;
|
||
LogPen: TLogPen;
|
||
lb: TLogBrush;
|
||
aHan: HPEN;
|
||
ExtPenIdx: Integer;
|
||
ExtPen: TExtPen;
|
||
begin
|
||
Result := 0;
|
||
LogPen.lopnStyle := Ord(ExtPenStyles[FCanvas.Pen.Style]);
|
||
LogPen.lopnWidth.X := FCanvas.Pen.Width;
|
||
LogPen.lopnColor := ColorToRGB(FCanvas.Pen.Color);
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width>1) then
|
||
begin
|
||
lb.lbStyle := BS_SOLID;
|
||
lb.lbColor := ColorToRGB(FCanvas.Pen.Color);
|
||
lb.lbHatch := 0;
|
||
end
|
||
else
|
||
ZeroMemory(@lb, SizeOf(lb));
|
||
|
||
|
||
if FCachePen then
|
||
begin
|
||
StrKey := IntToStr(LogPen.lopnStyle) +'_'+ IntToStr(LogPen.lopnWidth.X) +'_'+ IntToStr(LogPen.lopnColor)+'_'+
|
||
IntToStr(lb.lbStyle) +'_'+ IntToStr(lb.lbColor) +'_'+ IntToStr(Integer(FCanvas));
|
||
ExtPenIdx := FPens.IndexOf(StrKey);
|
||
if ExtPenIdx <> -1 then
|
||
Result := TExtPen(FPens.Objects[ExtPenIdx]).FhPen;
|
||
end;
|
||
|
||
|
||
if Result = 0 then
|
||
begin
|
||
try
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width>1) then
|
||
begin
|
||
aHan := ExtCreatePen(PS_GEOMETRIC or LogPen.lopnStyle or
|
||
PS_ENDCAP_SQUARE or PS_JOIN_MITER {PS_JOIN_BEVEL}, FCanvas.pen.width ,lb, 0, nil);
|
||
result := aHan;
|
||
end
|
||
else
|
||
begin
|
||
result := CreatePenIndirect(LogPen);
|
||
end;
|
||
except
|
||
end;
|
||
if FCachePen then
|
||
begin
|
||
ExtPen := TExtPen.Create;
|
||
ExtPen.FhPen := Result;
|
||
FPens.AddObject(StrKey, ExtPen);
|
||
//GProcCnt := GProcCnt + 1;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
function TPCDrawEngine.IsPointInRegion(aReg: Integer; pt: PDoublePoint): Boolean;
|
||
var
|
||
ipt, tpt: TPoint;
|
||
dx,dy,z: Double;
|
||
begin
|
||
Result := false;
|
||
dx := pt^.x;
|
||
dy := pt^.y;
|
||
z := 0;
|
||
ConvertPoint(dx,dy,z);
|
||
ipt := Point(round(dx),round(dy));
|
||
Result := ptInRegion(aReg, ipt.x, ipt.y);
|
||
end;
|
||
|
||
Function TPCDrawEngine.SkewBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap;isTrans:Boolean): Boolean;
|
||
var i,k: Integer;
|
||
RowOriginal : pRGBArray;
|
||
RowRotated : pRGBArray;
|
||
pa,pb: TDoublepoint;
|
||
px: Tpoint;
|
||
bRect: Trect;
|
||
x,y,h,w: Integer;
|
||
CalCPoints: array of array of TPoint;
|
||
|
||
begin
|
||
Screen.Cursor := crHourGlass;
|
||
|
||
if (p1.x = p4.x) and (p2.x = p3.x) and (p1.y = p2.y) and (p4.y = p3.y) then
|
||
begin
|
||
ResultBmp.Width := pic.width;
|
||
ResultBmp.Height := pic.Height;
|
||
ResultBmp.PixelFormat := pf24bit;
|
||
Resultbmp.Canvas.Draw(0,0,pic);
|
||
ResultBmp.Transparent := isTrans;
|
||
Screen.Cursor := crDefault;
|
||
exit;
|
||
end;
|
||
|
||
bRect.TopLeft := p1;
|
||
bRect.BottomRight := p3;
|
||
if p1.x < bRect.Left then bRect.Left := p1.x;
|
||
if p2.x < bRect.Left then bRect.Left := p2.x;
|
||
if p3.x < bRect.Left then bRect.Left := p3.x;
|
||
if p4.x < bRect.Left then bRect.Left := p4.x;
|
||
if p1.x > bRect.Right then bRect.Right := p1.x;
|
||
if p2.x > bRect.Right then bRect.Right := p2.x;
|
||
if p3.x > bRect.Right then bRect.Right := p3.x;
|
||
if p4.x > bRect.Right then bRect.Right := p4.x;
|
||
if p1.y < bRect.top then bRect.top := p1.y;
|
||
if p2.y < bRect.top then bRect.top := p2.y;
|
||
if p3.y < bRect.top then bRect.top := p3.y;
|
||
if p4.y < bRect.top then bRect.top := p4.y;
|
||
if p1.y > bRect.bottom then bRect.bottom := p1.y;
|
||
if p2.y > bRect.bottom then bRect.bottom := p2.y;
|
||
if p3.y > bRect.bottom then bRect.bottom := p3.y;
|
||
if p4.y > bRect.bottom then bRect.bottom := p4.y;
|
||
|
||
|
||
ResultBmp.Width := bRect.right-bRect.left;
|
||
ResultBmp.Height := bRect.bottom-bRect.top;
|
||
ResultBmp.PixelFormat := pf24bit;
|
||
|
||
if isTrans then begin
|
||
ResultBmp.Canvas.Brush.Color := pic.Canvas.Pixels[0,pic.Height-1];
|
||
ResultBmp.Canvas.Brush.Style := bsSolid;
|
||
ResultBmp.Canvas.FillRect(Rect(0,0,ResultBmp.Width,ResultBmp.Height));
|
||
end;
|
||
|
||
SetLength(CalcPoints,ResultBmp.Width);
|
||
for i := 0 to ResultBmp.Width-1 do begin
|
||
SetLength(CalcPoints[i],ResultBmp.Height);
|
||
for k := 0 to ResultBmp.Height-1 do CalcPoints[i,k] := Point(-1,-1);
|
||
end;
|
||
|
||
for i := 0 to pic.Height-1 do
|
||
begin
|
||
pa := GetLineSegmentPoint(DoublePoint(p1),DoublePoint(p4),(i/(pic.Height-1)));
|
||
pb := GetLineSegmentPoint(DoublePoint(p2),DoublePoint(p3),(i/(pic.Height-1)));
|
||
for k := 0 to pic.Width-1 do
|
||
begin
|
||
px := DP2P(GetLineSegmentPoint(pa,pb,(k/(pic.Width-1))));
|
||
px.x := px.x-bRect.left;
|
||
px.y := px.y-bRect.top;
|
||
if px.y < 0 then px.y := 0;
|
||
if px.y > ResultBmp.Height-1 then px.y := ResultBmp.Height-1;
|
||
if px.x < 0 then px.x := 0;
|
||
if px.x > ResultBmp.Width-1 then px.x := ResultBmp.Width-1;
|
||
CalcPoints[px.x,px.y] := Point(k,i);
|
||
end;
|
||
end;
|
||
|
||
h := ResultBmp.Height-1;
|
||
w := ResultBmp.Width-1;
|
||
for i := 0 to ResultBmp.Height -1 do
|
||
begin
|
||
RowRotated := ResultBmp.Scanline[i];
|
||
for k := 0 to ResultBmp.Width -1 do
|
||
begin
|
||
px := CalcPoints[k,i];
|
||
if (px.y = -1) and (i > 0) then px := CalcPoints[k,i-1];
|
||
if (px.y = -1) and (k > 0) then px := CalcPoints[k-1,i];
|
||
if (px.y = -1) and (k > 0) and (i > 0) then px := CalcPoints[k-1,i-1];
|
||
if (px.y = -1) and (i < h) then px := CalcPoints[k,i+1];
|
||
if (px.y = -1) and (k < w) then px := CalcPoints[k+1,i];
|
||
if (px.y = -1) and (k < w) and (i < h) then px := CalcPoints[k+1,i+1];
|
||
if (px.y = -1) and (k < w) and (i > 0) then px := CalcPoints[k+1,i-1];
|
||
if (px.y = -1) and (k > 0) and (i < h) then px := CalcPoints[k-1,i+1];
|
||
if (px.y <> -1) then
|
||
begin
|
||
RowOriginal := pic.ScanLine[px.y];
|
||
RowRotated[k] := RowOriginal[px.x];
|
||
end;
|
||
end;
|
||
end;
|
||
ResultBmp.Transparent := isTrans;
|
||
Screen.Cursor := crDefault;
|
||
end;
|
||
//Tolik 20/10/2021 --
|
||
//Function TPCDrawEngine.MakeBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap; isTrans: Boolean): Boolean;
|
||
Function TPCDrawEngine.MakeBitmap(p1,p2,p3,p4: TPoint; pic: TBitmap; var ResultBmp: TBitmap; isTrans: Boolean; GrColor: TColor = -1): Boolean;
|
||
//
|
||
var twidth,theight : integer;
|
||
teta: real;
|
||
RegNbr : Integer;
|
||
ap1,ap2 : TPoint;
|
||
bufbitmap : tbitmap ;
|
||
r: double;
|
||
// Tolik 20/10/2021 -*-
|
||
i, j: integer;
|
||
ColorRgb: Integer;
|
||
ColorR, ColorG, ColorB: Byte;
|
||
ColorIndex: integer;
|
||
|
||
Begin
|
||
Result := False; //#From Oleg# //20.09.2010
|
||
|
||
twidth := round(sqrt(sqr(p1.x-p2.x)+ sqr(p1.y-p2.y)));
|
||
theight := round(sqrt(sqr(p1.x-p4.x)+ sqr(p1.y-p4.y)));
|
||
r := tWidth/tHeight;
|
||
|
||
bufbitmap := Tbitmap.Create;
|
||
bufBitmap.PixelFormat := pf24bit;
|
||
bufBitmap.Width := round(pic.height*r);
|
||
bufbitmap.height := pic.height;
|
||
bufbitmap.Canvas.StretchDraw(Rect(0,0,bufbitmap.width,bufbitmap.height),pic);
|
||
//Tolik 20/10/2021 - -
|
||
if grColor <> -1 then
|
||
begin
|
||
ColorIndex := -1;
|
||
for i := 0 to 59 do
|
||
begin
|
||
if GrayedColors[i] = GrColor then
|
||
begin
|
||
ColorIndex := i;
|
||
break;
|
||
end;
|
||
end;
|
||
|
||
if colorIndex <> -1 then
|
||
begin
|
||
{
|
||
for i := 0 to bufbitmap.Height - 1 do
|
||
begin
|
||
p := bufbitmap.ScanLine[Y];
|
||
for j := 0 to bufbitmap.Width - 1 do
|
||
begin
|
||
P^.rgbReserved:=Round(255*j/(B.Height-1));
|
||
P^.rgbBlue:=Round(P^.rgbBlue*P^.rgbReserved/255);
|
||
P^.rgbGreen:=Round(P^.rgbGreen*P^.rgbReserved/255);
|
||
P^.rgbRed:=Round(P^.rgbRed*P^.rgbReserved/255);
|
||
Inc(P);
|
||
end;
|
||
end;
|
||
}
|
||
{for i := 0 to bufbitmap.Height - 1 do
|
||
begin
|
||
for j := 0 to bufbitmap.Width - 1 do
|
||
begin
|
||
bufbitmap.Canvas.Pixels[i, j] := grColor;
|
||
end;
|
||
end;
|
||
}
|
||
if ResultBmp <> nil then
|
||
ResultBmp.free;
|
||
ResultBmp := Tbitmap.Create;
|
||
ResultBmp.PixelFormat := pf32bit;
|
||
ResultBmp.width := bufBitmap.Width;
|
||
ResultBmp.Height := bufbitmap.Height;
|
||
//ResultBmp.Transparent := True;
|
||
//ResultBmp.TransparentColor := clFuchsia;//grColor;
|
||
bufbitmap.Transparent := True;
|
||
bufbitmap.TransparentColor := clFuchsia;//grColor;
|
||
|
||
Resultbmp.TransparentMode := tmAuto;
|
||
//ResultBmp.Canvas.StretchDraw(Rect(0, 0, bufbitmap.width, bufbitmap.height), bufbitmap);
|
||
//DrawAlphaAPI(bufbitmap, ResultBmp.Canvas, 0, 0, 255 - Round(ColorIndex * 4.2));
|
||
|
||
//Tolik 25/01/2022 --
|
||
//DrawAlphaAPI(bufbitmap, ResultBmp.Canvas, 0, 0, 255 - Round(F_LayersDialog.tbGrayed.Position * 4.32));
|
||
if F_LayersDialog.Showing then
|
||
DrawAlphaAPI(bufbitmap, ResultBmp.Canvas, 0, 0, 255 - Round(F_LayersDialog.tbGrayed.Position * 4.32))
|
||
else
|
||
begin
|
||
DrawAlphaAPI(bufbitmap, ResultBmp.Canvas, 0, 0, 255 - Round((Length(GrayedColors) - 1 - colorIndex) * 4.32));
|
||
end;
|
||
//
|
||
end
|
||
else
|
||
begin
|
||
ResultBmp.Canvas.StretchDraw(Rect(0, 0, bufbitmap.width, bufbitmap.height), bufbitmap);
|
||
end;
|
||
end;
|
||
|
||
|
||
//DrawOpacityBrush(ResultBmp.Canvas, xRect, 0, 0, ResultBmp.brush.color, 100 );
|
||
{
|
||
for i := 0 to ResultBmp.Height - 1 do
|
||
begin
|
||
for j := 0 to ResultBmp.Width - 1 do
|
||
begin
|
||
ColorRgb := ColorToRGB(ResultBmp.Canvas.Pixels[j,i]);
|
||
ColorR := GetRValue(ColorRgb);
|
||
ColorG := GetGValue(ColorRgb);
|
||
ColorB := GetBValue(ColorRgb);
|
||
ResultBmp.Canvas.Pixels[j,i] := GdiPapi.MakeColor(100 , ColorR, ColorG, ColorB);
|
||
end;
|
||
end;
|
||
}
|
||
//
|
||
ap1 := p1;
|
||
ap2 := p2;
|
||
|
||
|
||
if ap2.y = ap1.y then
|
||
Teta := 0
|
||
else if ap2.x = ap1.x then
|
||
Teta := pi/2
|
||
else
|
||
Teta := ArcTan(abs(ap2.y - ap1.y) / abs(ap2.x - ap1.x));
|
||
if ap1.x < ap2.x then
|
||
begin
|
||
if ap1.y >= ap2.y then
|
||
RegNbr := 1
|
||
else
|
||
RegNbr := 4;
|
||
end
|
||
else
|
||
begin
|
||
if ap1.y > ap2.y then
|
||
RegNbr := 2
|
||
else
|
||
RegNbr := 3;
|
||
end;
|
||
If RegNbr = 1 then Teta := Teta
|
||
else if RegNbr = 2 then Teta := pi - teta
|
||
else if RegNbr = 3 then Teta := pi + teta
|
||
else if RegNbr = 4 then Teta := 2*pi - teta;
|
||
|
||
if Teta <> 0 then
|
||
begin
|
||
RotateBitmap(BufBitmap,ResultBmp,Teta,isTrans);
|
||
Result := True;
|
||
end;
|
||
bufbitmap.free;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.RotateBitmap(var BitmapOriginal,BitmapRotated: TBitmap; Teta: Double; isTrans: Boolean);
|
||
VAR
|
||
cosTheta : DOUBLE;
|
||
i : INTEGER;
|
||
iRotationAxis : INTEGER;
|
||
iOriginal : INTEGER;
|
||
iPrime : INTEGER;
|
||
iPrimeRotated : INTEGER;
|
||
j : INTEGER;
|
||
jRotationAxis : INTEGER;
|
||
jOriginal : INTEGER;
|
||
jPrime : INTEGER;
|
||
jPrimeRotated : INTEGER;
|
||
RowOriginal : pRGBArray;
|
||
RowRotated : pRGBArray;
|
||
sinTheta : DOUBLE;
|
||
Theta : DOUBLE; // radians
|
||
|
||
OldHeight : integer;
|
||
OldWidth : integer;
|
||
NewWidth : integer;
|
||
NewHeight : integer;
|
||
NB : INTEGER;
|
||
NG : INTEGER;
|
||
NR : INTEGER;
|
||
add: integer;
|
||
|
||
begin
|
||
|
||
RowOriginal := BitmapOriginal.Scanline[0];
|
||
NB:=RowOriginal[0].rgbtBlue;
|
||
NG:=RowOriginal[0].rgbtGreen;
|
||
NR:=RowOriginal[0].rgbtRed;
|
||
|
||
Theta := teta;
|
||
sinTheta := SIN(Theta);
|
||
cosTheta := COS(Theta);
|
||
|
||
OldWidth := BitmapOriginal.Width;
|
||
OldHeight := BitmapOriginal.Height;
|
||
|
||
NewWidth := abs(round(OldHeight * sinTheta)) + abs(round(OldWidth *cosTheta));
|
||
NewHeight := abs(round(OldWidth * sinTheta)) + abs(round(OldHeight *cosTheta));
|
||
|
||
BitmapRotated.Width := NewWidth;
|
||
BitmapRotated.Height := NewHeight;
|
||
BitmapRotated.PixelFormat := pf24bit;
|
||
|
||
iRotationAxis := OldWidth div 2;
|
||
jRotationAxis := OldHeight div 2;
|
||
|
||
|
||
// Step through each row of rotated image.
|
||
FOR j := BitmapRotated.Height-1 DOWNTO 0 DO
|
||
BEGIN
|
||
RowRotated := BitmapRotated.Scanline[j];
|
||
jPrime := 2*(j - (NewHeight - OldHeight) div 2 - jRotationAxis) + 1 ;
|
||
|
||
FOR i := BitmapRotated.Width-1 DOWNTO 0 DO
|
||
BEGIN
|
||
// offset origin by the growth factor (NewWidth - OldWidth) div 2
|
||
iPrime := 2*(i - (NewWidth - OldWidth) div 2 - iRotationAxis) + 1;
|
||
|
||
iPrimeRotated := ROUND(iPrime * CosTheta - jPrime * sinTheta);
|
||
jPrimeRotated := ROUND(iPrime * sinTheta + jPrime * cosTheta);
|
||
|
||
// Transform back to pixel coordinates of image, including translation
|
||
// of origin from axis of rotation to origin of image.
|
||
iOriginal := (iPrimeRotated - 1) DIV 2 + iRotationAxis;
|
||
jOriginal := (jPrimeRotated - 1) DIV 2 + jRotationAxis;
|
||
|
||
// Make sure (iOriginal, jOriginal) is in BitmapOriginal. If not,
|
||
// assign blue color to corner points.
|
||
IF (iOriginal >= 0) AND (iOriginal <= BitmapOriginal.Width-1) AND
|
||
(jOriginal >= 0) AND (jOriginal <= BitmapOriginal.Height-1)
|
||
THEN
|
||
BEGIN
|
||
// Assign pixel from rotated space to current pixel in BitmapRotated
|
||
RowOriginal := BitmapOriginal.Scanline[jOriginal];
|
||
RowRotated[i] := RowOriginal[iOriginal]
|
||
END
|
||
ELSE
|
||
BEGIN
|
||
if isTrans then
|
||
add := 0
|
||
else
|
||
add := 100;
|
||
|
||
// Tolik 24/12/2019 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>....
|
||
{RowRotated[i].rgbtBlue := NB + add; // assign "corner" color
|
||
RowRotated[i].rgbtGreen := NG + add;
|
||
RowRotated[i].rgbtRed := NR + add;}
|
||
if (NB + add) > 255 then
|
||
RowRotated[i].rgbtBlue := 255
|
||
else
|
||
RowRotated[i].rgbtBlue := NB + add; // assign "corner" color
|
||
if (NG + add) > 255 then
|
||
RowRotated[i].rgbtGreen := 255
|
||
else
|
||
RowRotated[i].rgbtGreen := NG + add;
|
||
if (NR + add) > 255 then
|
||
RowRotated[i].rgbtRed := 255
|
||
else
|
||
RowRotated[i].rgbtRed := NR + add;
|
||
//
|
||
|
||
END;
|
||
END;
|
||
END;
|
||
END;
|
||
|
||
Procedure TPCDrawEngine.TextToRect(p1,p2,p3,p4: TDoublePoint; aText: String; aFont: TFont; CSpace:Double;
|
||
var w,h: Double);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
txSize: TSize;
|
||
CWidth,CHeight: Double;
|
||
wChar: Integer;
|
||
x1,y1: Double;
|
||
tw,th: Double;
|
||
rad: Double;
|
||
z: Double;
|
||
begin
|
||
FCanvas.Font := aFont;
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
x1 := p1.x;
|
||
y1 := p1.y;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
rad := GetRadOfLine(p1,p2);
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
|
||
// Set Angle
|
||
if rad <> 0 then begin
|
||
FontRecord.lfEscapement := Round(-1*(rad/pi)*1800);
|
||
end;
|
||
|
||
// Set Font Height
|
||
th := abs(GetLineLenght(p1,p4));
|
||
CHeight := th;
|
||
ConvertDim(CHeight);
|
||
FontRecord.lfHeight := Round(CHeight);
|
||
|
||
tw := Abs(GetLineLenght(p1,p2));
|
||
ConvertDim(tw);
|
||
ConvertDim(CSpace);
|
||
CWidth := ((tw) / length(aText)) - Round(CSpace);
|
||
wChar := round(CWidth)+1;
|
||
FontRecord.lfWidth := wChar;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
SetTextCharacterExtra(FCanvas.Handle,Round(CSpace));
|
||
|
||
GetTextExtentPoint(FCanvas.Handle,pchar(aText),length(aText),txSize);
|
||
while (txSize.cx > tw) And (wChar > 0) do
|
||
begin
|
||
wChar := wChar - 1;
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := wChar;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
GetTextExtentPoint(FCanvas.Handle,pchar(aText),length(aText),txSize);
|
||
end;
|
||
if wChar < 0 then wChar := 0;
|
||
w := wChar;
|
||
DeConvertDim(w);
|
||
h := th;
|
||
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawLabel(r1,r2:TDoublePoint;aText: String; afont: Tfont;
|
||
aheight:Double;pcolor,awidth,style,bc,bs: integer;var RGn:HRGN);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
Leading : LongInt;
|
||
ap : TPoint;
|
||
txSize: TSize;
|
||
wChar: Integer;
|
||
x1,y1,x2,y2,sw: Double;
|
||
tx,ty: Integer;
|
||
leftAl:Boolean;
|
||
z: Double;
|
||
begin
|
||
FCanvas.Font := aFont;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
x1 := r1.x;
|
||
y1 := r1.y;
|
||
x2 := r2.x;
|
||
y2 := r2.y;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
ConvertDim(aHeight);
|
||
LeftAl := False;
|
||
if x1 > x2 then begin
|
||
//sw := x1;
|
||
//x1 := x2;
|
||
//x2 := sw;
|
||
LeftAl := True;
|
||
end;
|
||
if y1 > y2 then begin
|
||
sw := y1;
|
||
y1 := y2;
|
||
y2 := sw;
|
||
end;
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
//dFont := FCanvas.Font.handle;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
If Not LeftAl then
|
||
begin
|
||
tx := Round(x1)+4;
|
||
end else begin
|
||
tx := Round(x1) - Fcanvas.TextWidth(aText) - 4;
|
||
end;
|
||
|
||
ty := Round((y1+y2) / 2) - (Round(aHeight / 2))-2;
|
||
|
||
|
||
|
||
FCanvas.pen.color := pcolor;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
|
||
FCanvas.rectangle(tx-4,ty-2,tx+Fcanvas.TextWidth(aText)+4,ty+Round(aHeight)+4);
|
||
{ if rgn = 0 then
|
||
begin
|
||
rgn := CreateRectRgn(tx-4,ty-2,tx+Fcanvas.TextWidth(aText)+4,ty+Round(aHeight)+4);
|
||
end;}
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
FCanvas.textout(tx,ty,atext);
|
||
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawCenteredText(p1: TDoublePoint;Color:TColor;Text,FontName:String;
|
||
FontSize:Double;Angle:Double);
|
||
var tWidth,tHeight:Integer;
|
||
FontRecord : TLogFont;
|
||
z,tw,th: Double;
|
||
ap1,ap2,ap3,ap4: TDoublePoint;
|
||
fSize: Double;
|
||
nh,nl: Integer;
|
||
begin
|
||
FSize := FontSize;
|
||
ConvertDim(FSize);
|
||
if FSize < 4 then exit;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
Canvas.Font.Name := FontName;
|
||
|
||
if Eqd(Angle,pi) or eqd(Angle,-pi) then Angle := 0
|
||
else if (Angle > pi) and (Angle < 3*(pi/2)) then Angle := Angle-pi
|
||
else if (Angle > pi/2) and (Angle < pi) then Angle := Angle+pi;
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(FSize);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
tw := Canvas.TextWidth(text);
|
||
th := Canvas.TextHeight(text);
|
||
DeConvertDim(tw);
|
||
DeConvertDim(th);
|
||
ap1 := DoublePoint(p1.x-(tw/2),p1.y-(th/2));
|
||
ap2 := DoublePoint(ap1.x+tw,ap1.y);
|
||
ap3 := DoublePoint(ap2.x,ap2.y+th);
|
||
ap4 := DoublePoint(ap1.x,ap1.y+th);
|
||
|
||
if Angle <> 0 then begin
|
||
//ap1 := RotatePoint(p1,ap1,2*pi-Angle);
|
||
ap1 := RotatePoint(p1,ap1,Angle);
|
||
ap2 := RotatePoint(p1,ap2,Angle);
|
||
ap3 := RotatePoint(p1,ap3,Angle);
|
||
ap4 := RotatePoint(p1,ap4,Angle);
|
||
end;
|
||
|
||
DrawText(ap1,ap2,ap3,ap4,Angle,Text,FontName,Color,FontSize,0,0,nh,nl);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawCenteredText(p1: TDoublePoint;Color:TColor;Text,FontName:String;
|
||
FontSize:Integer;Angle:Double);
|
||
var tWidth,tHeight:Integer;
|
||
z: Double;
|
||
FontRecord : TLogFont;
|
||
begin
|
||
if FontSize < 4 then exit;
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
z := 0;
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
Canvas.Font.Name := FontName;
|
||
Canvas.Font.Color := Color;
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := FontSize;
|
||
// Create Modified Font
|
||
//dFont := FCanvas.Font.handle;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
tWidth := Canvas.TextWidth(text);
|
||
tHeight := Canvas.TextHeight(text);;
|
||
Canvas.TextOut(Round(p1.x)-(tWidth div 2),Round(p1.y)-(tHeight div 2),Text);
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.TraceText(p1:TDoublePOint;Color:TColor;Text,FontName:String;FontSize:Integer);
|
||
var z: Double;
|
||
begin
|
||
z := 0;
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
DrawTraceText(Round(p1.x),Round(p1.y),Color,Text,FontName,FontSize,Canvas);
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawtext(ap1,ap2,ap3,a4: TDoublePoint;angle:Double; atext: string;
|
||
afont: Tfont;
|
||
aHeight:Double;
|
||
CWidth,CSpace:double;
|
||
Var nH,nL: Integer);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
Leading : LongInt;
|
||
ap : TPoint;
|
||
txSize: TSize;
|
||
wChar: Integer;
|
||
x1,y1,z: Double;
|
||
olDFont: TFont;
|
||
begin
|
||
nh := 0;
|
||
nl := 0;
|
||
ConvertDim(aHeight);
|
||
if aheight < 4 then exit;
|
||
OldFont := Fcanvas.Font;
|
||
FCanvas.Font := aFont;
|
||
Fcanvas.Font.Height := Round(aHeight);
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
x1 := ap1.x;
|
||
y1 := ap1.y;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
|
||
if Angle <> 0 then begin
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Angle
|
||
angle := -1*(angle/pi)*1800;
|
||
FontRecord.lfEscapement := Round(angle);
|
||
FontRecord.lfOrientation := Round(angle);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
// Calculate Zero Point
|
||
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
if CWidth <> 0 then begin
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
ConvertDim(CWidth);
|
||
wChar := round(CWidth);
|
||
FontRecord.lfWidth := wchar;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
Leading := TM.tmInternalLeading;
|
||
if angle <> 0 then begin
|
||
ap := getRelativePointbyAngle(Round(angle),DP2P(x1,y1),Dp2P(x1,y1-Leading div 3));
|
||
y1 := ap.y;
|
||
x1 := ap.x;
|
||
end;
|
||
|
||
if CSpace <> 0 then begin
|
||
ConvertDim(CSpace);
|
||
SetTextCharacterExtra(FCanvas.Handle,round(CSpace));
|
||
end;
|
||
|
||
FCanvas.textout(round(x1),Round(y1),atext);
|
||
|
||
|
||
GetTextExtentPoint(FCanvas.Handle,pchar(aText),length(aText),txSize);
|
||
nh := txSize.cy;
|
||
nL := txSize.cx;
|
||
nL := nl-round(cSpace);
|
||
if CSpace <> 0 then begin
|
||
SetTextCharacterExtra(FCanvas.Handle,0);
|
||
end;
|
||
Fcanvas.Font := oldFont;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawAlignedText(xp1,xp2:TdoublePoint; atext: string;
|
||
FontName: TFontName; aColor: integer;aheight:double);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
Leading : LongInt;
|
||
ap : TPoint;
|
||
aFont,oldFont: TFont;
|
||
r: Trect;
|
||
t,z: double;
|
||
xp:TDoublePoint;
|
||
Angle:Double;
|
||
delta: Double;
|
||
begin
|
||
ConvertCoord(xp1.x,xp1.y,xp1.z);
|
||
ConvertCoord(xp2.x,xp2.y,xp2.z);
|
||
delta := 3.0;
|
||
ConvertDim(delta);
|
||
GetParallelPOints(xp1,xp2,xp1,xp2,delta);
|
||
xp := MPoint(xp1,xp2);
|
||
|
||
if EQD(xp1.x,xp2.x) then Angle := 3*(pi/2)
|
||
else if EQD(xp1.y,xp2.y) then Angle := 0
|
||
else Angle := GetRadOfLine(xp1,xp2);
|
||
DrawCenteredText(DP2P(xp),acolor,atext,FontName,aHeight,Angle);
|
||
|
||
end;
|
||
|
||
Function TPCDrawEngine.CreateRectRegion(x1,y1,x2,y2:Double):HRGN;
|
||
begin
|
||
result := CreateRectRgn(round(x1),round(y1),round(x2),round(y2));
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawHDim(ap1,ap2,ap3:TDoublePoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:THDimLabelStyle; TextPos: TDimTextPos; et: TEndType;
|
||
var RegHandle: HRGN);
|
||
var
|
||
x1,x2,x3,y1,y2,y3,z: Double;
|
||
d,nickD,t: Double;
|
||
rt,textLen:Integer;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
aFont: TFont;
|
||
r: Trect;
|
||
OutLen,headLen: Double;
|
||
rg,reg:HRGN;
|
||
oldFont : TFont;
|
||
|
||
Procedure AddRegion(rx1,ry1,rx2,ry2: Double);
|
||
var tReg: HRGN;
|
||
begin
|
||
tReg := CreateRectRegion(rx1,ry1,rx2,ry2);
|
||
CombineRgn(Reg,reg,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
begin
|
||
|
||
z := 0;
|
||
x1 := ap1.x; y1 := ap1.y;
|
||
x2 := ap2.x; y2 := ap2.y;
|
||
x3 := ap3.x; y3 := ap3.y;
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
ConvertCoord(x3,y3,z);
|
||
Outlen := 8;
|
||
ConvertDim(Outlen);
|
||
HeadLen := HeadLength;
|
||
ConvertDim(HeadLen);
|
||
nickD := 1;
|
||
ConvertDim(nickD);
|
||
TextLen := 0;
|
||
if x1 > x2 then
|
||
begin
|
||
t := x1; x1 := x2; x2 := t;
|
||
t := y1; y1 := y2; y2 := t;
|
||
end;
|
||
|
||
aFont := nil; //#From Oleg# //20.09.2010
|
||
oldFont := nil;
|
||
if dLabel <> '' then
|
||
begin
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := TextColor;
|
||
FCanvas.Font := aFont;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
ConvertDim(aHeight);
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
if (LStyle <> hlsInner) and (LStyle <> hlsLeft) and (LStyle <> hlsRight) then
|
||
FontRecord.lfEscapement := 900;
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
// Set Font Width
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
textLen := FCanvas.TextWidth(Dlabel);
|
||
end;
|
||
|
||
// Draw Guides
|
||
if ap3.y > ap1.y then
|
||
d := 1
|
||
else
|
||
d := -1;
|
||
drawline(ap1.x,ap1.y+d,ap1.x,ap3.y+d,acolor,1,0,0);
|
||
ConvertDim(d);
|
||
if reghandle = 0 then
|
||
begin
|
||
reg := CreateRectRegion(x1-2,y1+d,x1+2,y3+d);
|
||
end;
|
||
if ap3.y > ap2.y then
|
||
d := 1
|
||
else
|
||
d := -1;
|
||
drawline(ap2.x,ap2.y+d,ap2.x,ap3.y+d,acolor,1,0,0);
|
||
ConvertDim(d);
|
||
if reghandle = 0 then
|
||
AddRegion(x2-2,y2+d,x2+2,y3+d);
|
||
|
||
t := -1;
|
||
if x1 <> x2 then
|
||
begin
|
||
if LStyle = hlsInner then
|
||
begin
|
||
if et = etRow then
|
||
rt := 3
|
||
else
|
||
rt := 0;
|
||
Drawline(ap1.x,ap3.y,ap2.x,ap3.y,acolor,1,0,rt);
|
||
if reghandle = 0 then
|
||
AddRegion(x1,y3-2,x2,y3+2);
|
||
end
|
||
else
|
||
if (LStyle = hlsLeft) or (LStyle = hlsLeftTop) or (LStyle = hlsLeftBottom) then
|
||
begin
|
||
if et = etRow then
|
||
rt := 2
|
||
else
|
||
rt := 0;
|
||
drawlinepixD(x2,y3,x2+Outlen,y3,acolor,1,0,rt);
|
||
if reghandle = 0 then
|
||
AddRegion(x2,y3-2,x2+Outlen,y3+2);
|
||
|
||
if (LStyle = hlsLeft) then
|
||
begin
|
||
if et = etRow then
|
||
rt := 1
|
||
else
|
||
rt := 0;
|
||
drawlinepixD(x1-Outlen-TextLen,y3,x1,y3,acolor,1,0,rt);
|
||
if reghandle = 0 then
|
||
AddRegion(x1-Outlen-TextLen,y3-2,x1,y3+2);
|
||
end
|
||
else
|
||
if (LStyle = hlsLeftBottom) then
|
||
begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x1-OutLen,y3,x1,y3,acolor,1,0,rt);
|
||
drawlinepixD(x1-OutLen,y3,x1-Outlen,y3+TextLen+OutLen/2,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x1-OutLen,y3-2,x1,y3+2);
|
||
if reghandle = 0 then AddRegion(x1-OutLen-2,y3,x1+2,y3+TextLen+OutLen/2);
|
||
end
|
||
else
|
||
if (LStyle = hlsLeftTop) then
|
||
begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x1-OutLen,y3,x1,y3,acolor,1,0,rt);
|
||
drawlinepixD(x1-OutLen,y3-TextLen-OutLen / 2,x1-Outlen,y3,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x1-OutLen,y3-2,x1,y3+2);
|
||
if reghandle = 0 then AddRegion(x1-OutLen-2,y3,x1+2,y3-TextLen-OutLen/2);
|
||
end;
|
||
|
||
end
|
||
else
|
||
if (LStyle = hlsRight) or (LStyle = hlsRightTop) or (LStyle = hlsRightBottom) then
|
||
begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x1-Outlen,y3,x1,y3,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x1-Outlen,y3-2,x1,y3+2);
|
||
if (LStyle = hlsRight) then
|
||
begin
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
drawlinepixD(x2,y3,x2+Outlen+TextLen,y3,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x2,y3-2,x2+Outlen+TextLen,y3+2);
|
||
end
|
||
else
|
||
if (LStyle = hlsRightTop) then
|
||
begin
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
drawlinepixD(x2,y3,x2+Outlen,y3,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x2,y3-2,x2+Outlen,y3+2);
|
||
drawlinepixD(x2+OutLen,y3,x2+Outlen,y3-TextLen-OutLen / 2,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x2+OutLen-2,y3,x2+Outlen+2,y3-TextLen-OutLen / 2);
|
||
end
|
||
else
|
||
if (LStyle = hlsRightBottom) then
|
||
begin
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
drawlinepixD(x2,y3,x2+Outlen,y3,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x2,y3-2,x2+Outlen,y3+2);
|
||
drawlinepixD(x2+OutLen,y3,x2+Outlen,y3+TextLen+OutLen / 2,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x2+OutLen-2,y3,x2+Outlen+2,y3+TextLen+OutLen/2);
|
||
end;
|
||
end;
|
||
|
||
rg := 1;
|
||
if et = etDot then
|
||
begin
|
||
DrawCircle(ap1.x,ap3.y,1,acolor,1,0,acolor,0,rg,false);
|
||
DrawCircle(ap2.x,ap3.y,1,acolor,1,0,acolor,0,rg,false);
|
||
end
|
||
else
|
||
if et = etNick then
|
||
begin
|
||
drawlinepixD(x1+NickD,y3-NickD,x1-NickD,y3+NickD,acolor,1,0,0);
|
||
drawlinepixD(x2+NickD,y3-NickD,x2-NickD,y3+NickD,acolor,1,0,0);
|
||
end;
|
||
end;
|
||
|
||
SetBkMode(FCanvas.Handle,TRANSPARENT);
|
||
if (Textpos <> tpAbove) and (TextPos <> tpBelow) then
|
||
begin
|
||
SetbkColor(FCanvas.Handle,clWhite);
|
||
SetBkMode(FCanvas.Handle,OPAQUE);
|
||
end;
|
||
|
||
Case LStyle of
|
||
hlsInner,hlsLeft,hlsRight:
|
||
begin
|
||
if TextPos = tpAbove then
|
||
begin
|
||
y1 := y3 - aHeight;
|
||
y2 := y3 ;
|
||
end
|
||
else
|
||
if TextPos = tpBelow then
|
||
begin
|
||
y1 := y3 ;
|
||
y2 := y3 + aHeight;
|
||
end
|
||
else
|
||
begin
|
||
y1 := y3 - (aHeight / 2);
|
||
y2 := y3 + (aHeight / 2);
|
||
end;
|
||
|
||
if LStyle = hlsInner then
|
||
begin
|
||
r := DR2R(x1,y1,x2,y2);
|
||
Windows.DrawText(FCanvas.Handle,pChar(DLabel),length(DLabel),R ,DT_CENTER);
|
||
if reghandle = 0 then AddRegion(((x1+x2) / 2) - (TextLen / 2),y1,
|
||
((x1+x2) / 2) + (TextLen / 2),y2);
|
||
end
|
||
else
|
||
if LStyle = hlsLeft then
|
||
begin
|
||
r := DR2R(x1-Outlen-TextLen+4,y1,x1,y2);
|
||
Windows.DrawText(FCanvas.Handle,pChar(DLabel),length(DLabel),R ,DT_LEFT);
|
||
if reghandle = 0 then AddRegion(x1-Outlen-TextLen+4,y1,
|
||
x1-Outlen+4,y2);
|
||
end
|
||
else
|
||
if Lstyle = hlsRight then
|
||
begin
|
||
r := DR2R(x2+headLen+4,y1,x2+Outlen+TextLen,y2);
|
||
Windows.DrawText(FCanvas.Handle,pChar(DLabel),length(DLabel),R ,DT_LEFT);
|
||
if reghandle = 0 then AddRegion(x2+headLen+4,y1,
|
||
x2+headLen+4+TextLen,y2);
|
||
end;
|
||
end;
|
||
|
||
hlsLeftBottom:
|
||
begin
|
||
y1 := y3+TextLen+OutLen / 2 - 6;
|
||
if TextPos = tpAbove then x1 := x1-OutLen-aHeight
|
||
else if TextPos = tpBelow then x1 := x1-OutLen
|
||
else x1 := x1-OutLen-aHeight / 2;
|
||
Windows.TextOut(FCanvas.Handle,Round(x1),Round(y1),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(x1,y1,x1+aHeight,y1-TextLen);
|
||
end;
|
||
|
||
|
||
hlsLeftTop:
|
||
begin
|
||
y1 := y3- OutLen / 2 + 6;
|
||
if TextPos = tpAbove then x1 := x1-OutLen-aHeight
|
||
else if TextPos = tpBelow then x1 := x1-OutLen
|
||
else x1 := x1-OutLen-aHeight / 2;
|
||
Windows.TextOut(FCanvas.Handle,Round(x1),Round(y1),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(x1,y1,x1+aHeight,y1-TextLen);
|
||
end;
|
||
|
||
hlsRightTop:
|
||
begin
|
||
y1 := y3- OutLen / 2 + 6;
|
||
if TextPos = tpAbove then x2 := x2+OutLen-aHeight
|
||
else if TextPos = tpBelow then x2 := x2+OutLen
|
||
else x2 := x2+OutLen-aHeight / 2;
|
||
Windows.TextOut(FCanvas.Handle,Round(x2),Round(y1),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(x2,y1,x2+aHeight,y1-TextLen);
|
||
end;
|
||
|
||
hlsRightBottom:
|
||
begin
|
||
y1 := y3 + TextLen+OutLen / 2 - 6;
|
||
if TextPos = tpAbove then x2 := x2+OutLen-aHeight
|
||
else if TextPos = tpBelow then x2 := x2+OutLen
|
||
else x2 := x2+OutLen-aHeight / 2;
|
||
Windows.TextOut(FCanvas.Handle,Round(x2),Round(y1),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(x2,y1,x2+aHeight,y1-TextLen);
|
||
end;
|
||
end;
|
||
|
||
if regHandle = 0 then RegHandle := Reg;
|
||
if dLabel <> '' then
|
||
begin
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.DrawVDim(ap1,ap2,ap3:TDoublepoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:TVDimLabelStyle; TextPos: TDimTextPos; et: TEndType;
|
||
var RegHandle: HRGN);
|
||
var x1,x2,x3,y1,y2,y3,z: Double;
|
||
d,t,tx,ty,nickD: Double;
|
||
textLen,rt: Integer;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
aFont: TFont;
|
||
r: Trect;
|
||
OutLen,headLen:Double;
|
||
rg,reg:HRGN;
|
||
oldFont : TFont;
|
||
|
||
Procedure AddRegion(rx1,ry1,rx2,ry2: Double);
|
||
var tReg: HRGN;
|
||
begin
|
||
tReg := CreateRectRegion(rx1,ry1,rx2,ry2);
|
||
CombineRgn(Reg,reg,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure ArrangeBkMode;
|
||
begin
|
||
SetbkColor(FCanvas.Handle,clWhite);
|
||
SetBkMode(FCanvas.Handle,TRANSPARENT);
|
||
if (Textpos = tpOnline) then
|
||
begin
|
||
SetbkColor(FCanvas.Handle,clWhite);
|
||
SetBkMode(FCanvas.Handle,OPAQUE);
|
||
end;
|
||
end;
|
||
begin
|
||
|
||
z := 0;
|
||
x1 := ap1.x; y1 := ap1.y;
|
||
x2 := ap2.x; y2 := ap2.y;
|
||
x3 := ap3.x; y3 := ap3.y;
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
ConvertCoord(x3,y3,z);
|
||
Outlen := 8;
|
||
ConvertDim(Outlen);
|
||
HeadLen := HeadLength;
|
||
ConvertDim(HeadLen);
|
||
nickD := 1;
|
||
ConvertDim(nickD);
|
||
TextLen := 0;
|
||
if y1 > y2 then begin t := y1; y1 := y2; y2 := t;
|
||
t := x1; x1 := x2; x2 := t; end;
|
||
|
||
oldFont := nil;//#From Oleg# //20.09.2010
|
||
afont := nil;//#From Oleg# //20.09.2010
|
||
if dLabel <> '' then
|
||
begin
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := TextColor;
|
||
FCanvas.Font := aFont;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
ConvertDim(aHeight);
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
if (LStyle = vlsInner) or (LStyle = vlsTop) or
|
||
(LStyle = vlsBottom) then
|
||
FontRecord.lfEscapement := 900;
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
// Set Font Width
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
textLen := FCanvas.TextWidth(Dlabel);
|
||
end;
|
||
|
||
// Draw Guides
|
||
if ap3.x > ap1.x then d := 1 else d := -1;
|
||
drawline(ap1.x+d,ap1.y,ap3.x+d,ap1.y,acolor,1,0,0);
|
||
ConvertDim(d);
|
||
if reghandle = 0 then begin
|
||
reg := CreateRectRegion(x1+d,y1-2,x3+d,y1+2);
|
||
end;
|
||
if ap3.x > ap2.x then d := 1 else d := -1;
|
||
drawline(ap2.x+d,ap2.y,ap3.x+d,ap2.y,acolor,1,0,0);
|
||
ConvertDim(d);
|
||
if reghandle = 0 then AddRegion(x2+d,y2-2,x3+d,y2+2);
|
||
|
||
t := -1;
|
||
|
||
if y1 <> y2 then
|
||
begin
|
||
|
||
SetBkMode(FCanvas.Handle,TRANSPARENT);
|
||
|
||
if LStyle = vlsInner then
|
||
begin
|
||
// DrawLine
|
||
if et = etRow then rt := 3 else rt := 0;
|
||
Drawline(ap3.x,ap1.y,ap3.x,ap2.y,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y1,x3+2,y2);
|
||
|
||
// DrawText
|
||
ty := y3+TextLen div 2;
|
||
if TextPos = tpAbove then tx := x3-aHeight
|
||
else if TextPos = tpBelow then tx := x3
|
||
else tx := x3-aHeight / 2;
|
||
ArrangeBkMode;
|
||
|
||
Windows.TextOut(FCanvas.Handle,round(tx),Round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+aHeight,ty-TextLen);
|
||
|
||
end else if (LStyle = vlsTop) or (LStyle = vlsTopLeft)
|
||
or (LStyle = vlsTopRight) then
|
||
begin
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
drawlinepixD(x3,y2,x3,y2+Outlen,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y2+Outlen,x3+2,y2);
|
||
if (LStyle = vlsTop) then
|
||
begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x3,y1-Outlen-TextLen,x3,y1,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y1-Outlen-TextLen,x3+2,y1);
|
||
|
||
// DrawText
|
||
ty := y1-Outlen+4;
|
||
if TextPos = tpAbove then tx := x3-aHeight
|
||
else if TextPos = tpBelow then tx := x3
|
||
else tx := x3-aHeight / 2;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(tx),Round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+aHeight,ty-TextLen);
|
||
|
||
end else if (LStyle = vlstopLeft) then begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x3,y1-Outlen,x3,y1,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y1-Outlen,x3+2,y1);
|
||
drawlinepixD(x3,y1-Outlen,x3-TextLen - OutLen / 2,y1-Outlen,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x3,y1-Outlen-2,x3-TextLen-OutLen / 2,y1-Outlen+2);
|
||
// DrawText
|
||
tx := x3-TextLen-OutLen / 2+4;
|
||
if TextPos = tpAbove then ty := y1-OutLen-aHeight
|
||
else if TextPos = tpBelow then ty := y1-OutLen
|
||
else ty := y1-OutLen-aHeight / 2;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(tx),Round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+TextLen,ty+AHeight);
|
||
|
||
end else if (LStyle = vlsTopright) then begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x3,y1-Outlen,x3,y1,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y1-Outlen,x3+2,y1);
|
||
drawlinepixD(x3,y1-Outlen,x3+TextLen+OutLen / 2,y1-Outlen,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x3,y1-Outlen-2,x3+TextLen+OutLen / 2,y1-Outlen+2);
|
||
// DrawText
|
||
tx := x3+4;
|
||
if TextPos = tpAbove then ty := y1-OutLen-aHeight
|
||
else if TextPos = tpBelow then ty := y1-OutLen
|
||
else ty := y1-OutLen-aHeight / 2;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(tx),Round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+TextLen,ty+AHeight);
|
||
end;
|
||
|
||
end else if (LStyle = vlsBottom) or (LStyle = vlsBottomRight) or
|
||
(LStyle = vlsBottomLeft) then
|
||
begin
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
drawlinepixD(x3,y1,x3,y1-Outlen,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y1-Outlen,x3+2,y1);
|
||
|
||
if (LStyle = vlsBottom) then
|
||
begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x3,y2+OutLen+TextLen,x3,y2,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y2+Outlen+TextLen,x3+2,y2);
|
||
// DrawText
|
||
ty := y2+Outlen+TextLen-4;
|
||
if TextPos = tpAbove then tx := x3-aHeight
|
||
else if TextPos = tpBelow then tx := x3
|
||
else tx := x3-aHeight / 2;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(tx),Round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+aHeight,ty-TextLen);
|
||
|
||
end else if (LStyle = vlsBottomLeft) then begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x3,y2+Outlen,x3,y2,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y2+Outlen,x3+2,y2);
|
||
drawlinepixD(x3,y2+Outlen,x3-TextLen-OutLen / 2,y2+Outlen,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x3,y2+Outlen-2,x3-TextLen-OutLen / 2,y2+Outlen+2);
|
||
// DrawText
|
||
tx := x3-TextLen-OutLen / 2+4;
|
||
if TextPos = tpAbove then ty := y2+OutLen-aHeight
|
||
else if TextPos = tpBelow then ty := y2+OutLen
|
||
else ty := y2+OutLen-aHeight / 2;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(tx),round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+TextLen,ty+AHeight);
|
||
|
||
end else if (LStyle = vlsBottomRight) then begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
drawlinepixD(x3,y2+Outlen,x3,y2,acolor,1,0,rt);
|
||
if reghandle = 0 then AddRegion(x3-2,y2+Outlen,x3+2,y2);
|
||
drawlinepixD(x3,y2+Outlen,x3+TextLen+OutLen / 2,y2+Outlen,acolor,1,0,0);
|
||
if reghandle = 0 then AddRegion(x3,y2+Outlen-2,x3+TextLen+OutLen / 2,y2+Outlen+2);
|
||
// DrawText
|
||
tx := x3+4;
|
||
if TextPos = tpAbove then ty := y2+OutLen-aHeight
|
||
else if TextPos = tpBelow then ty := y2+OutLen
|
||
else ty := y2+OutLen-aHeight / 2;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,round(tx),round(ty),pChar(DLabel),length(DLabel));
|
||
if reghandle = 0 then AddRegion(tx,ty,tx+TextLen,ty+AHeight);
|
||
end;
|
||
end;
|
||
rg := 1;
|
||
if et = etDot then begin
|
||
DrawCircle(ap3.x,ap1.y,1,acolor,1,0,acolor,0,rg,false);
|
||
DrawCircle(ap3.x,ap2.y,1,acolor,1,0,acolor,0,rg,false);
|
||
end else if et = etNick then begin
|
||
drawlinepixD(x3+NickD,y1-NickD,x3-NickD,y1+NickD,acolor,1,0,0);
|
||
drawlinepixD(x3+NickD,y2-NickD,x3-NickD,y2+NickD,acolor,1,0,0);
|
||
end;
|
||
end;
|
||
|
||
if regHandle = 0 then RegHandle := Reg;
|
||
|
||
//fcanvas.brush.style := bsSolid;
|
||
//fcanvas.brush.color := clred;
|
||
//FillRgn(fcanvas.handle,RegHandle,fcanvas.brush.handle);
|
||
|
||
if dLabel <> '' then
|
||
begin
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawAlignedDim(ap1,ap2,ap3:TDoublePoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:TADimLabelStyle; TextPos: TDimTextPos; et: TEndType;
|
||
tHorz: Boolean;var RegHandle: HRGN);
|
||
var x1,x2,x3,y1,y2,y3,tx,ty: Double;
|
||
d,t,nickD,TH: Double;
|
||
textLen,rt: Integer;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
aFont: TFont;
|
||
r: Trect;
|
||
OutLen,headLen: Double;
|
||
rg,reg:HRGN;
|
||
oldFont : TFont;
|
||
p1,p2,p3: TdOUBLEPoint;
|
||
rad,z: double;
|
||
ang: integer;
|
||
|
||
Procedure AddTextRegion(p1:TDoublepoint);
|
||
var tReg: HRGN;
|
||
ang: double;
|
||
begin
|
||
if tHorz then ang := 0 else ang := rad;
|
||
tReg := CreateRotatedRgn(p1,TextLen,aHeight,ang);
|
||
CombineRgn(Reg,reg,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure AddRegion(p1,p2:TDoublepoint);
|
||
var tReg: HRGN;
|
||
begin
|
||
tReg := CreateLinearRgn(p1,p2);
|
||
CombineRgn(Reg,reg,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure ArrangeBkMode;
|
||
begin
|
||
if (Textpos = tpOnline) or ((LStyle = alsInner) and (tHorz)) then
|
||
begin
|
||
SetbkColor(FCanvas.Handle,clWhite);
|
||
SetBkMode(FCanvas.Handle,OPAQUE);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
|
||
reg := 0;
|
||
p1 := ap1;
|
||
p2 := ap2;
|
||
p3 := ap3;
|
||
z:= 0;
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
ConvertCoord(p2.x,p2.y,z);
|
||
ConvertCoord(p3.x,p3.y,z);
|
||
|
||
if p1.x > p2.x then begin
|
||
ap1 := p1;
|
||
p1 := p2;
|
||
p2 := ap1;
|
||
end;
|
||
|
||
rad := GetRadOfLine(p1,p2);
|
||
ang := Round((rad/pi)*1800);
|
||
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
p3 := RotatePoint(p1,p3,-rad);
|
||
p3.x := (p1.x+p2.x) / 2;
|
||
|
||
x1 := p1.x; y1 := p1.y;
|
||
x2 := p2.x; y2 := p2.y;
|
||
x3 := p3.x; y3 := p3.y;
|
||
|
||
Outlen := 8;
|
||
ConvertDim(Outlen);
|
||
HeadLen := HeadLength;
|
||
ConvertDim(HeadLen);
|
||
nickD := 1;
|
||
ConvertDim(nickD);
|
||
TextLen := 0;
|
||
|
||
oldFont := nil; //#From Oleg# //20.09.2010
|
||
aFont := nil; //#From Oleg# //20.09.2010
|
||
if dLabel <> '' then
|
||
begin
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := TextColor;
|
||
FCanvas.Font := aFont;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
ConvertDim(aHeight);
|
||
FontRecord.lfHeight := round(aHeight);
|
||
if not tHorz then FontRecord.lfEscapement := -ang;
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
// Set Font Width
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
textLen := FCanvas.TextWidth(Dlabel);
|
||
end;
|
||
|
||
// Draw Guides
|
||
|
||
if y3 > y1 then d := 1 else d := -1;
|
||
ConvertDim(d);
|
||
p1 := DoublePoint(x1,y1+d);
|
||
p2 := DoublePoint(x1,y3+d);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,aColor,1,0,0);
|
||
if RegHandle = 0 then Reg := CreateLinearRgn(p1,p2);
|
||
|
||
if y3 > y2 then d := 1 else d := -1;
|
||
ConvertDim(d);
|
||
p1 := DoublePoint(x2,y2+d);
|
||
p2 := DoublePoint(x2,y3+d);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,aColor,1,0,0);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
|
||
|
||
SetBkMode(FCanvas.Handle,TRANSPARENT);
|
||
|
||
t := -1;
|
||
if x1 <> x2 then
|
||
begin
|
||
if LStyle = alsInner then
|
||
begin
|
||
if et = etRow then rt := 3 else rt := 0;
|
||
p1 := DoublePoint(x1,y3);
|
||
p2 := DoublePoint(x2,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
|
||
if tHorz then
|
||
begin
|
||
tx := (x1+x2) / 2;
|
||
ty := y3-(aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
p1.x := p1.x - (Textlen / 2);
|
||
end else begin
|
||
tx := ((x1+x2) / 2) - (Textlen / 2);
|
||
if TextPos = tpAbove then ty := y3 - aHeight
|
||
else if TextPos = tpBelow then ty := y3
|
||
else if TextPos = tpOnline then ty := y3 - (aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
end;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(P1.x),Round(P1.y),pChar(DLabel),length(DLabel));
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
|
||
end else if (LStyle = alsLeft) then
|
||
begin
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
if tHorz then
|
||
p1 := DoublePoint(x1-OutLen,y3)
|
||
else
|
||
p1 := DoublePoint(x1-OutLen-TextLen,y3);
|
||
p2 := DoublePoint(x1,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x1-OutLen,y3),rad);
|
||
p2 := DoublePoint(p1.x-TextLen-OutLen / 2,p1.y);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
p1 := DoublePoint(x2,y3);
|
||
p2 := DoublePoint(x2+Outlen,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x1-OutLen,y3),rad);
|
||
p1 := DoublePoint(p1.x-TextLen-OutLen / 2+4,p1.y);
|
||
if TextPos = tpAbove then p1.y := p1.y - aHeight
|
||
else if TextPos = tpBelow then p1.y := p1.y
|
||
else if TextPos = tpOnline then p1.y := p1.y - (aHeight / 2);
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
end else begin
|
||
tx := (x1 - Textlen-Outlen+4);
|
||
if TextPos = tpAbove then ty := y3 - aHeight
|
||
else if TextPos = tpBelow then ty := y3
|
||
else if TextPos = tpOnline then ty := y3 - (aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
end;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(P1.x),Round(P1.y),pChar(DLabel),length(DLabel));
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
|
||
end else if (LStyle = alsRight) then begin
|
||
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
p1 := DoublePoint(x1-OutLen,y3);
|
||
p2 := DoublePoint(x1,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
p1 := DoublePoint(x2,y3);
|
||
if tHorz then
|
||
p2 := DoublePoint(x2+Outlen,y3)
|
||
else
|
||
p2 := DoublePoint(x2+Outlen+TextLen,y3);
|
||
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x2+OutLen,y3),rad);
|
||
p2 := DoublePoint(p1.x+TextLen+OutLen / 2,p1.y);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x2+OutLen,y3),rad);
|
||
p1 := DoublePoint(p1.x+4,p1.y);
|
||
if TextPos = tpAbove then p1.y := p1.y - aHeight
|
||
else if TextPos = tpBelow then p1.y := p1.y
|
||
else if TextPos = tpOnline then p1.y := p1.y - (aHeight / 2);
|
||
|
||
end else begin
|
||
tx := (x2+OutLen-4);
|
||
if TextPos = tpAbove then ty := y3 - aHeight
|
||
else if TextPos = tpBelow then ty := y3
|
||
else if TextPos = tpOnline then ty := y3 - (aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
end;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(P1.x),Round(P1.y),pChar(DLabel),length(DLabel));
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
end;
|
||
rg := 1;
|
||
if et = etDot then begin
|
||
p1 := DoublePoint(x1,y3);
|
||
p2 := DoublePoint(x2,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
DrawCirclePix(Round(p1.x),Round(p1.y),Round(NickD),acolor,1,0,acolor,0,rg);
|
||
DrawCirclePix(Round(p2.x),Round(p2.y),Round(NickD),acolor,1,0,acolor,0,rg);
|
||
end else if et = etNick then begin
|
||
p1 := DoublePoint(x1+NickD,y3-NickD);
|
||
p2 := DoublePoint(x1-NickD,y3+NickD);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
p1 := DoublePoint(x2+NickD,y3-NickD);
|
||
p2 := DoublePoint(x2-NickD,y3+NickD);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
end;
|
||
end;
|
||
|
||
if regHandle = 0 then RegHandle := Reg;
|
||
|
||
|
||
if dLabel <> '' then begin
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawCircleDim(ap1,ap2:TDoublePoint; dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight: Double; LStyle:TCDimLabelStyle; TextPos: TDimTextPos; et: TEndType;
|
||
tHorz: Boolean;DrawOuterGuide,DrawInnerGuide:Boolean;var RegHandle: HRGN);
|
||
var x1,x2,x3,y1,y2,y3,tx,ty: Double;
|
||
d,t,nickD,TH: Double;
|
||
textLen,rt: Integer;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
aFont: TFont;
|
||
r: Trect;
|
||
OutLen,headLen: Double;
|
||
rg,reg:HRGN;
|
||
oldFont : TFont;
|
||
p1,p2,p3: TdOUBLEPoint;
|
||
rad,z: double;
|
||
ang: integer;
|
||
|
||
Procedure AddTextRegion(p1:TDoublepoint);
|
||
var tReg: HRGN;
|
||
ang: double;
|
||
begin
|
||
if tHorz then ang := 0 else ang := rad;
|
||
tReg := CreateRotatedRgn(p1,TextLen,aHeight,ang);
|
||
CombineRgn(Reg,reg,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure AddRegion(p1,p2:TDoublepoint);
|
||
var tReg: HRGN;
|
||
begin
|
||
tReg := CreateLinearRgn(p1,p2);
|
||
CombineRgn(Reg,reg,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure ArrangeBkMode;
|
||
begin
|
||
if (Textpos = tpOnline) or ((LStyle = clsInner) and (tHorz)) then
|
||
begin
|
||
SetbkColor(FCanvas.Handle,clWhite);
|
||
SetBkMode(FCanvas.Handle,OPAQUE);
|
||
end;
|
||
end;
|
||
|
||
begin
|
||
|
||
reg := 0;
|
||
p1 := ap1;
|
||
p2 := ap2;
|
||
p3 := MPoint(p1,p2);
|
||
z:=0;
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
ConvertCoord(p2.x,p2.y,z);
|
||
ConvertCoord(p3.x,p3.y,z);
|
||
|
||
if p1.x > p2.x then begin
|
||
ap1 := p1;
|
||
p1 := p2;
|
||
p2 := ap1;
|
||
end;
|
||
|
||
rad := GetRadOfLine(p1,p2);
|
||
ang := Round((rad/pi)*1800);
|
||
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
p3 := RotatePoint(p1,p3,-rad);
|
||
p3.x := (p1.x+p2.x) / 2;
|
||
|
||
x1 := p1.x; y1 := p1.y;
|
||
x2 := p2.x; y2 := p2.y;
|
||
x3 := p3.x; y3 := p3.y;
|
||
|
||
Outlen := 8;
|
||
ConvertDim(Outlen);
|
||
HeadLen := HeadLength;
|
||
ConvertDim(HeadLen);
|
||
nickD := 1;
|
||
ConvertDim(nickD);
|
||
TextLen := 0;
|
||
|
||
oldFont := nil; //#From Oleg# //20.09.2010
|
||
aFont := nil; //#From Oleg# //20.09.2010
|
||
if dLabel <> '' then
|
||
begin
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := TextColor;
|
||
FCanvas.Font := aFont;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
ConvertDim(aHeight);
|
||
FontRecord.lfHeight := round(aHeight);
|
||
if not tHorz then FontRecord.lfEscapement := -ang;
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
// Set Font Width
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
textLen := FCanvas.TextWidth(Dlabel);
|
||
end;
|
||
|
||
if RegHandle = 0 then Reg := CreateLinearRgn(p1,p1);
|
||
|
||
SetBkMode(FCanvas.Handle,TRANSPARENT);
|
||
|
||
t := -1;
|
||
if x1 <> x2 then
|
||
begin
|
||
|
||
if DrawInnerGuide then begin
|
||
if et = etRow then rt := 3 else rt := 0;
|
||
p1 := DoublePoint(x1,y3);
|
||
p2 := DoublePoint(x2,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
|
||
if (LStyle = clsInner) then
|
||
begin
|
||
if et = etRow then rt := 3 else rt := 0;
|
||
p1 := DoublePoint(x1,y3);
|
||
p2 := DoublePoint(x2,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
if not DrawInnerGuide then begin
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
if tHorz then
|
||
begin
|
||
tx := (x1+x2) / 2;
|
||
ty := y3-(aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
p1.x := p1.x - (Textlen / 2);
|
||
end else begin
|
||
tx := ((x1+x2) / 2) - (Textlen / 2);
|
||
if TextPos = tpAbove then ty := y3 - aHeight
|
||
else if TextPos = tpBelow then ty := y3
|
||
else if TextPos = tpOnline then ty := y3 - (aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
end;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(P1.x),Round(P1.y),pChar(DLabel),length(DLabel));
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
end else if (LStyle = clsLeft) then
|
||
begin
|
||
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
if drawInnerGuide then rt := 0;
|
||
if tHorz then
|
||
p1 := DoublePoint(x1-OutLen,y3)
|
||
else
|
||
p1 := DoublePoint(x1-OutLen-TextLen,y3);
|
||
p2 := DoublePoint(x1,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x1-OutLen,y3),rad);
|
||
p2 := DoublePoint(p1.x-TextLen-OutLen / 2,p1.y);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
if DrawInnerGuide then rt := 0;
|
||
p1 := DoublePoint(x2,y3);
|
||
p2 := DoublePoint(x2+Outlen,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
if DrawOuterGuide then begin
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x1-OutLen,y3),rad);
|
||
p1 := DoublePoint(p1.x-TextLen-OutLen / 2+4,p1.y);
|
||
if TextPos = tpAbove then p1.y := p1.y - aHeight
|
||
else if TextPos = tpBelow then p1.y := p1.y
|
||
else if TextPos = tpOnline then p1.y := p1.y - (aHeight / 2);
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
end else begin
|
||
tx := (x1 - Textlen-Outlen+4);
|
||
if TextPos = tpAbove then ty := y3 - aHeight
|
||
else if TextPos = tpBelow then ty := y3
|
||
else if TextPos = tpOnline then ty := y3 - (aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
end;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(P1.x),Round(P1.y),pChar(DLabel),length(DLabel));
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
|
||
end else if (LStyle = clsRight) then begin
|
||
|
||
if et = etRow then rt := 1 else rt := 0;
|
||
if DrawInnerGuide then rt := 0;
|
||
p1 := DoublePoint(x1-OutLen,y3);
|
||
p2 := DoublePoint(x1,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
if DrawOuterGuide then begin
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
|
||
if et = etRow then rt := 2 else rt := 0;
|
||
if DrawInnerGuide then rt := 0;
|
||
p1 := DoublePoint(x2,y3);
|
||
if tHorz then
|
||
p2 := DoublePoint(x2+Outlen,y3)
|
||
else
|
||
p2 := DoublePoint(x2+Outlen+TextLen,y3);
|
||
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,rt);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x2+OutLen,y3),rad);
|
||
p2 := DoublePoint(p1.x+TextLen+OutLen / 2,p1.y);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
if RegHandle = 0 then AddRegion(p1,p2);
|
||
end;
|
||
|
||
if tHorz then
|
||
begin
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(x2+OutLen,y3),rad);
|
||
p1 := DoublePoint(p1.x+4,p1.y);
|
||
if TextPos = tpAbove then p1.y := p1.y - aHeight
|
||
else if TextPos = tpBelow then p1.y := p1.y
|
||
else if TextPos = tpOnline then p1.y := p1.y - (aHeight / 2);
|
||
end else begin
|
||
tx := (x2+OutLen-4);
|
||
if TextPos = tpAbove then ty := y3 - aHeight
|
||
else if TextPos = tpBelow then ty := y3
|
||
else if TextPos = tpOnline then ty := y3 - (aHeight / 2);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),DoublePoint(tx,ty),rad);
|
||
end;
|
||
ArrangeBkMode;
|
||
Windows.TextOut(FCanvas.Handle,Round(P1.x),Round(P1.y),pChar(DLabel),length(DLabel));
|
||
if RegHandle = 0 then AddTextRegion(p1);
|
||
end;
|
||
rg := 1;
|
||
if et = etDot then begin
|
||
p1 := DoublePoint(x1,y3);
|
||
p2 := DoublePoint(x2,y3);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
DrawCirclePix(Round(p1.x),Round(p1.y),Round(NickD),acolor,1,0,acolor,0,rg);
|
||
DrawCirclePix(Round(p2.x),Round(p2.y),Round(NickD),acolor,1,0,acolor,0,rg);
|
||
end else if et = etNick then begin
|
||
p1 := DoublePoint(x1+NickD,y3-NickD);
|
||
p2 := DoublePoint(x1-NickD,y3+NickD);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
p1 := DoublePoint(x2+NickD,y3-NickD);
|
||
p2 := DoublePoint(x2-NickD,y3+NickD);
|
||
p1 := RotatePoint(DoublePoint(x1,y1),p1,rad);
|
||
p2 := RotatePoint(DoublePoint(x1,y1),p2,rad);
|
||
drawlinepixD(p1.x,p1.y,p2.x,p2.y,acolor,1,0,0);
|
||
end;
|
||
end;
|
||
|
||
if regHandle = 0 then RegHandle := Reg;
|
||
|
||
|
||
if dLabel <> '' then begin
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
end;
|
||
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawArcDim(ap1: TDoublePoint;Radius,SAngle,FAngle:Double;dLabel: String;
|
||
fontName: TFontName; Styles:TFontStyles;aColor,TextColor: integer;
|
||
aheight,GuideLen: Double; LStyle:TArcDimLabelStyle;var Reghandle: HRGN; var p1,p2: TDoublePoint);
|
||
var x1,x2,x3,y1,y2,y3,tx,ty,per: Double;
|
||
rad,d,t,nickD,MAngle: Double;
|
||
TextLen,TH,tw,rt: Integer;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
aFont: TFont;
|
||
r: Trect;
|
||
OutLen,headLen: Double;
|
||
rg,reg:HRGN;
|
||
oldFont : TFont;
|
||
dp1,dp2,xp1,xp2,p3: TdOUBLEPoint;
|
||
dim,z: Double;
|
||
ang: integer;
|
||
bc: Integer;
|
||
bs: Integer;
|
||
|
||
Procedure AddTextRegion(p1:TDoublepoint);
|
||
var tReg: HRGN;
|
||
ang: double;
|
||
begin
|
||
ang := 0;
|
||
tReg := CreateRotatedRgn(p1,tw,th,ang);
|
||
CombineRgn(Reghandle,Reghandle,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure AddRegion(p1,p2:TDoublepoint);
|
||
var tReg: HRGN;
|
||
z: Double;
|
||
begin
|
||
z := 0;
|
||
ConvertCoord(p1.x,p1.y,z);
|
||
ConvertCoord(p2.x,p2.y,z);
|
||
tReg := CreateLinearRgn(p1,p2);
|
||
CombineRgn(Reghandle,Reghandle,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
|
||
Procedure AddRectRgn(p1,p2,p3,p4:Integer);
|
||
var tReg: HRGN;
|
||
begin
|
||
tReg := CreateRectRgn(p1,p2,p3,p4);
|
||
CombineRgn(Reghandle,Reghandle,treg,RGN_OR);
|
||
DeleteObject(tReg);
|
||
end;
|
||
begin
|
||
|
||
rg := 1;
|
||
//bc := clWhite;
|
||
//if Canvas.Pen.Mode = pmXor then
|
||
// bc := clBlack;
|
||
bc := clNone;
|
||
bs := Ord(bsClear);
|
||
if radius <> 0 then begin
|
||
if (LStyle = rlsInner) or (sAngle = Fangle) then begin
|
||
//drawbezarc(ap1.x,ap1.y,radius,SAngle,FAngle,acolor,1,ord(psSolid),
|
||
// 0,0,0,rg,p1,p2,false,3);
|
||
drawbezarc(ap1.x,ap1.y,radius,SAngle,FAngle,acolor,1,ord(psSolid),
|
||
bc,bs,0,rg,p1,p2,false,3);
|
||
end else if LStyle = rlsOuter then begin
|
||
|
||
per := pi*radius;
|
||
MAngle := pi/(per/8);
|
||
drawbezarc(ap1.x,ap1.y,radius,SAngle-MAngle,SAngle,acolor,1,ord(psSolid),
|
||
0,0,0,rg,xp1,p1,false,1);
|
||
drawbezarc(ap1.x,ap1.y,radius,FAngle,FAngle+MAngle,acolor,1,ord(psSolid),
|
||
0,0,0,rg,p2,xp2,false,2);
|
||
end;
|
||
end;
|
||
|
||
|
||
if (GuideLen < 0) then dim := 1.5 else dim := -1.5;
|
||
|
||
if (FAngle <> SAngle) and (GuideLen <> 0) then begin
|
||
|
||
rad := GetRadOfLine(p1,ap1);
|
||
xp1 := RotatePoint(ap1,p1,-rad);
|
||
xp1 := DoublePoint(xp1.x+dim,xp1.y);
|
||
xp1 := RotatePoint(ap1,xp1,rad);
|
||
|
||
rad := GetRadOfLine(p2,ap1);
|
||
xp2 := RotatePoint(ap1,p2,-rad);
|
||
xp2 := DoublePoint(xp2.x+dim,xp2.y);
|
||
xp2 := RotatePoint(ap1,xp2,rad);
|
||
|
||
if GuideLen = Radius then begin
|
||
dp1 := ap1;
|
||
dp2 := ap1;
|
||
end else begin
|
||
rad := GetRadOfLine(p1,ap1);
|
||
dp1 := RotatePoint(ap1,p1,-rad);
|
||
dp1 := DoublePoint(dp1.x+GuideLen,dp1.y);
|
||
dp1 := RotatePoint(ap1,dp1,rad);
|
||
|
||
rad := GetRadOfLine(p2,ap1);
|
||
dp2 := RotatePoint(ap1,p2,-rad);
|
||
dp2 := DoublePoint(dp2.x+GuideLen,dp2.y);
|
||
dp2 := RotatePoint(ap1,dp2,rad);
|
||
end;
|
||
|
||
try
|
||
drawline(xp1.x,xp1.y,dp1.x,dp1.y,acolor,1,ord(psSolid),0);
|
||
drawline(xp2.x,xp2.y,dp2.x,dp2.y,acolor,1,ord(psSolid),0);
|
||
except
|
||
end;
|
||
end;
|
||
|
||
if FAngle = SAngle then
|
||
begin
|
||
p3 := DoublePoint(ap1.x+radius+3,ap1.y);
|
||
end else begin
|
||
if (FAngle < SAngle) then begin
|
||
MAngle := SAngle+((2*pi)-SAngle+FAngle)/2;
|
||
end else begin
|
||
MAngle := (SAngle+FAngle)/2;
|
||
end;
|
||
p3 := DoublePoint(ap1.x+radius+3,ap1.y);
|
||
p3 := RotatePoint(ap1,p3,MAngle);
|
||
end;
|
||
|
||
if dLabel <> '' then
|
||
begin
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := TextColor;
|
||
FCanvas.Font := aFont;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
ConvertDim(aHeight);
|
||
FontRecord.lfHeight := round(aHeight);
|
||
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
// Set Font Width
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
textLen := FCanvas.TextWidth(Dlabel);
|
||
end;
|
||
|
||
tx := p3.x;
|
||
ty := p3.y;
|
||
z := 0;
|
||
ConvertCoord(tx,ty,z);
|
||
th := FCanvas.TextHeight(Dlabel);
|
||
tw := FCanvas.TextWidth(Dlabel);
|
||
FCanvas.Brush.Color := bc;
|
||
FCanvas.Brush.Style := TBrushStyle(bs);
|
||
Windows.TextOut(FCanvas.Handle,Round(tx-(tw div 2)),Round(ty - (th div 2) ),pChar(DLabel),length(DLabel));
|
||
if regHandle = 0 then
|
||
begin
|
||
RegHandle := CreateRectRgn(Round(tx-(tw div 2)),Round(ty - (th div 2)),Round(tx+(tw div 2)),Round(ty+ (th div 2)));
|
||
if (FAngle <> SAngle) and (GuideLen <> 0) then begin
|
||
AddRegion(xp1,dp1);
|
||
AddRegion(xp2,dp2);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.drawselectionpoint(x,y,z: Double; pType: TPointType; dim : double; col : TColor; isXOR:Boolean = False);
|
||
var p,ap1,ap2:TdoublePoint;
|
||
tx,ty,tz: Double;
|
||
begin
|
||
if pType = ptTarget then begin
|
||
tx := x; ty := y; tz :=z;
|
||
drawselectionpoint(tx,ty,tz,ptCross,dim,col,isXOR);
|
||
tx := x; ty := y; tz :=z;
|
||
drawselectionpoint(tx,ty,tz,ptECircle,dim/2,col,isXOR);
|
||
exit;
|
||
end;
|
||
FCanvas.pen.color := col;
|
||
FCanvas.pen.width := 1;
|
||
FCanvas.pen.style := psSolid;
|
||
if isXor then
|
||
FCanvas.pen.mode := pmXOr
|
||
else
|
||
FCanvas.pen.mode := pmCopy;
|
||
//Tolik 03/02/2022 --
|
||
//FCanvas.brush.color := col; $00E8731A
|
||
FCanvas.brush.color := $00E8731A;
|
||
//
|
||
FCanvas.brush.style := bsSolid;
|
||
ConvertCoord(x,y,z);
|
||
case pType of
|
||
|
||
ptRect : begin
|
||
RectanglePix(x-dim,y-dim,x+dim,y+dim);
|
||
end;
|
||
ptCircle : begin
|
||
ellipsePix(x-dim-1,y-dim-1,x+dim+1,y+dim+1);
|
||
end;
|
||
ptECircle : begin
|
||
FCanvas.brush.style := bsClear;
|
||
ellipsePix(x-dim-1,y-dim-1,x+dim+1,y+dim+1);
|
||
end;
|
||
|
||
ptRCenter: begin
|
||
FCanvas.brush.style := bsClear;
|
||
ellipsePix(x-dim-3,y-dim-3,x+dim+3,y+dim+3);
|
||
FCanvas.brush.color := col;
|
||
FCanvas.brush.style := bsSolid;
|
||
ellipsePix(x-dim,y-dim,x+dim,y+dim);
|
||
end;
|
||
|
||
ptCross : begin
|
||
movetoPix(x,y-dim);linetoPix(x,y+dim);
|
||
movetoPix(x-dim,y);linetoPix(x+dim,y);
|
||
end;
|
||
ptStar : begin
|
||
movetoPix(x-dim,y+dim);linetoPix(x+dim,y-dim);
|
||
movetoPix(x+dim,y+dim);linetoPix(x-dim,y-dim);
|
||
end;
|
||
ptRow : begin
|
||
movetoPix(x-dim+3,y+dim);linetoPix(x-dim+3,y-dim);
|
||
linetoPix(x+dim+3,y);linetoPix(x-dim+3,y+dim);
|
||
end;
|
||
|
||
end;
|
||
end;
|
||
|
||
procedure PrintBitmap(Canvas: TCanvas; DestRect: TRect; Bitmap: TBitmap; ROP: Integer);
|
||
VAR
|
||
BitmapHeader: pBitmapInfo;
|
||
BitmapImage : POINTER;
|
||
HeaderSize : DWord;
|
||
ImageSize : DWord;
|
||
begin
|
||
GetDIBSizes(Bitmap.Handle,HeaderSize,ImageSize);
|
||
GetMem(BitmapHeader,HeaderSize);
|
||
GetMem(BitmapImage,ImageSize);
|
||
TRY
|
||
GetDIB(Bitmap.Handle, Bitmap.Palette, BitmapHeader^, BitmapImage^);
|
||
StretchDIBits(Canvas.Handle,
|
||
DestRect.Left, DestRect.Top, // Destination Origin
|
||
DestRect.Right - DestRect.Left, // Destination Width
|
||
DestRect.Bottom - DestRect.Top, // Destination Height
|
||
0,0, // Source Origin
|
||
Bitmap.Width, Bitmap.Height, // Source Width & Height
|
||
BitmapImage,
|
||
TBitmapInfo(BitmapHeader^),
|
||
DIB_RGB_COLORS,
|
||
ROP);
|
||
FINALLY
|
||
FreeMem(BitmapHeader);
|
||
FreeMem(BitmapImage)
|
||
END;
|
||
END; {PrintBitmap}
|
||
|
||
|
||
procedure stretchDrawGraphics(ACanvas : TCanvas; R : TRect;
|
||
Graphic: TGraphic; transparent : boolean);
|
||
var TmpRect: TRect;
|
||
FactorX, FactorY: Double;
|
||
TmpWidth, TmpHeight: Integer;
|
||
CWidth, CHeight: Integer;
|
||
BWidth, BHeight: Integer;
|
||
begin
|
||
if (ACanvas <> nil) and Assigned(ACanvas) and
|
||
(Graphic <> nil) and Assigned(Graphic) and not Graphic.Empty
|
||
then
|
||
with ACanvas do
|
||
try
|
||
CWidth := R.Right - R.Left + 1 - 1;
|
||
CHeight := R.Bottom - R.Top + 1 - 1;
|
||
BWidth := Graphic.Width;
|
||
BHeight := Graphic.Height;
|
||
try
|
||
if BWidth = 0 then FactorX := 0 else FactorX := CWidth /BWidth;
|
||
if BHeight = 0 then FactorY := 0 else FactorY := CHeight /BHeight;
|
||
except
|
||
FactorX := 1;
|
||
FactorY := 1;
|
||
end;
|
||
if FactorY < FactorX
|
||
then begin
|
||
TmpWidth := Round(BWidth * FactorY);
|
||
TmpHeight := CHeight;
|
||
end
|
||
else begin
|
||
TmpHeight := Round(BHeight * FactorX);
|
||
TmpWidth := CWidth;
|
||
end;
|
||
SetRect(TmpRect, 0, 0, TmpWidth, TmpHeight);
|
||
OffsetRect(TmpRect, R.Left + ((CWidth - TmpWidth) div 2),R.Top + ((CHeight - TmpHeight) div 2));
|
||
Graphic.Transparent := transparent;
|
||
StretchDraw(TmpRect, Graphic);
|
||
except
|
||
end;
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.drawcurvesegment(p1, p2: TDoublepoint);
|
||
var a: integer;
|
||
x,y,mu,mu2,z: double;
|
||
xp1,xp2: TDoublePoint;
|
||
begin
|
||
xP1 := p1; xp2 := p2;z := 0;
|
||
ConvertCoord(xp1.x,xp1.y,z);
|
||
MoveToPix(xp1.x,xp1.y);
|
||
for a := 0 to 500 do begin
|
||
mu := (1 / 500)*a;
|
||
mu2 := (1-cos(mu*PI))/2;
|
||
y := p1.y*(1-mu2)+p2.y*mu2;
|
||
x := p1.x + (mu*(p2.x-p1.x));
|
||
ConvertCoord(x,y,z);
|
||
LineToPix(x,y);
|
||
end;
|
||
end;
|
||
|
||
|
||
|
||
Procedure TPCDrawEngine.DrawRTF(re: TRichEdit98; x1,y1,x2,y2: integer);
|
||
begin
|
||
DrawRtfToCanvas(re,x1,y1,x2,y2,fCanvas,true);
|
||
end;
|
||
|
||
|
||
Procedure TPCDrawEngine.DrawRTFToCanvas(re: TRichEdit98; x1,y1,x2,y2: Double; xCanvas: Tcanvas; convert: Boolean);
|
||
var
|
||
Range: TFormatRange;
|
||
LogX, LogY, OldMap: Integer;
|
||
fMetaFile: TMetaFile;
|
||
DC: HDC;
|
||
t,z:Double;
|
||
begin
|
||
z := 0;
|
||
if convert then
|
||
begin
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
end;
|
||
if x1>x2 then begin
|
||
t := x1;
|
||
x1 := x2;
|
||
x2 := t;
|
||
end;
|
||
if y1>y2 then begin
|
||
t := y1;
|
||
y1 := y2;
|
||
y2 := t;
|
||
end;
|
||
if assigned(re) then with re, Range do
|
||
begin
|
||
FillChar(Range, SizeOf(TFormatRange), 0);
|
||
hdc := xCanvas.Handle;
|
||
hdcTarget := hdc;
|
||
LogX := GetDeviceCaps(hdc, LOGPIXELSX);
|
||
LogY := GetDeviceCaps(hdc, LOGPIXELSY);
|
||
rc.left := Round(x1 * 1440 / LogX);
|
||
rc.right := round(x2 * 1440 / LogX);
|
||
rc.top := round(y1 * 1440 / LogY);
|
||
rc.bottom := round(y2 * 1440 / LogY);
|
||
rcPage := rc;
|
||
chrg.cpMin := 0;
|
||
chrg.cpMax := -1;
|
||
OldMap := SetMapMode(hdc, MM_TEXT);
|
||
//setbkmode(hdc,TRANSPARENT);
|
||
setbkmode(hdc,OPAQUE);
|
||
if Assigned(re.Parent) then
|
||
begin
|
||
SendMessage(re.Handle, EM_FORMATRANGE, 0, 0);
|
||
try
|
||
SendMessage(re.Handle, EM_FORMATRANGE, 0, Longint(@Range));
|
||
hdc := xcanvas.handle;
|
||
hdcTarget := hdc;
|
||
SendMessage(Handle, EM_FORMATRANGE, 1, Longint(@Range));
|
||
finally
|
||
SendMessage(Handle, EM_FORMATRANGE, 0, 0);
|
||
SetMapMode(hdc, OldMap);
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.DrawOleToCanvas(ole: TOLEContainer; x1,y1,x2,y2: Double; xCanvas: Tcanvas; convert: Boolean);
|
||
var
|
||
LogX, LogY, OldMap: Integer;
|
||
fMetaFile: TMetaFile;
|
||
t,z:Double;
|
||
begin
|
||
z := 0;
|
||
if convert then
|
||
begin
|
||
ConvertCoord(x1,y1,z);
|
||
ConvertCoord(x2,y2,z);
|
||
end;
|
||
if x1>x2 then begin
|
||
t := x1;
|
||
x1 := x2;
|
||
x2 := t;
|
||
end;
|
||
if y1>y2 then begin
|
||
t := y1;
|
||
y1 := y2;
|
||
y2 := t;
|
||
end;
|
||
if assigned(ole) then
|
||
begin
|
||
oleDraw(ole.OleObjectInterface ,DVASPECT_CONTENT,xCanvas.Handle,DR2R(x1,y1,x2,y2));
|
||
end;
|
||
end;
|
||
|
||
Function ProcessRichRecord(DC:HDC; HT:PHandleTable; rec:PEnhMetaRecord;
|
||
count:integer; param: pointer): integer;stdcall;
|
||
var rectext: PEMRExtTextOut;
|
||
begin
|
||
if (rec.iType = EMR_EXTTEXTOUTW) or (rec.iType = EMR_EXTTEXTOUTA) then
|
||
begin
|
||
rectext:= PEMRExtTextOut(rec);
|
||
if rectext.emrtext.fOptions = 2 then rectext.emrtext.fOptions := 0
|
||
end;
|
||
PlayEnhMetaFileRecord(DC,HT^,rec^,count);
|
||
if rec.itype <> EMR_EOF then result := 1 else result := 0;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawline(p1,p2:TDoublePoint);
|
||
begin
|
||
Moveto(p1);
|
||
Lineto(p2);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawDashLine(p1,p2:TDoublePoint);
|
||
var done: Boolean;
|
||
xp: TDoublePoint;
|
||
begin
|
||
xp := p1;
|
||
done := False;
|
||
repeat
|
||
Moveto(xp);
|
||
xp := PushPoint(xp,p2,2.0,done);
|
||
LineTo(xp);
|
||
xp := PushPoint(xp,p2,0.75,done);
|
||
MoveTo(xp);
|
||
until done;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawbezier(p1,p2,p3,p4: TDoublePoint);
|
||
var
|
||
p: array [0..3] of TPoint;
|
||
z: Double;
|
||
begin
|
||
ConvertCoord(p1.x,p1.y,z);p[0] := Dp2P(p1);
|
||
ConvertCoord(p2.x,p2.y,z);p[1] := Dp2P(p2);
|
||
ConvertCoord(p3.x,p3.y,z);p[2] := Dp2P(p3);
|
||
ConvertCoord(p4.x,p4.y,z);p[3] := Dp2P(p4);
|
||
PolyBezier(FCanvas.handle,p,4);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawEllipse(p1: TDoublePoint;ax,bx: Double;angle: Double);
|
||
|
||
var sinAngle : real;
|
||
cosAngle : real;
|
||
theta : real;
|
||
xp,yp : real;
|
||
xr, yr : integer;
|
||
li : integer;
|
||
x,y,a,b,z : Double;
|
||
points : array of TPoint;
|
||
begin
|
||
|
||
sinAngle := sin (angle);
|
||
cosAngle := cos (angle);
|
||
|
||
x := p1.x;
|
||
y := p1.y;
|
||
a := ax; b :=bx;
|
||
z := 0;
|
||
ConvertCoord(x,y,z);
|
||
ConvertDim(a);
|
||
ConvertDim(b);
|
||
|
||
//if angle = 0 then
|
||
//begin
|
||
// FCanvas.Ellipse(x-a,y-b,x+a,y+b);
|
||
//end
|
||
//else
|
||
begin
|
||
SetLength(Points,500+1);
|
||
for li := 0 to 500
|
||
do begin
|
||
theta := (li/500) * 2*PI; // angle step
|
||
xp := a * cos(theta); // ellipse point
|
||
yp := b * sin(theta);
|
||
// rotate ellipse point around center
|
||
xr := Round (x - xp * cosAngle + yp * sinAngle);
|
||
yr := Round (y + xp * sinAngle + yp * cosAngle);
|
||
points[li].x := xr;
|
||
points[li].y := yr;
|
||
end;
|
||
FCanvas.Polygon(points);
|
||
end;
|
||
end;
|
||
|
||
function TPCDrawEngine.LineRegion(p1, p2: TDoublePoint; w: Double): HRGN;
|
||
var np1,np2,np3,np4:TDoublePoint;
|
||
pArr: TPointArr;
|
||
begin
|
||
SetLength(pArr,4);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
GetParallelPoints(p1,p2,np1,np2,w+1);
|
||
GetParallelPoints(p1,p2,np3,np4,-(w+1));
|
||
pArr[0] := Point(round(np1.x),round(np1.y));
|
||
pArr[1] := Point(round(np2.x),round(np2.y));
|
||
pArr[2] := Point(round(np4.x),round(np4.y));
|
||
pArr[3] := Point(round(np3.x),round(np3.y));
|
||
result := PolygonRegion(pArr);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawVane(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; Dim,Mar: Double;HasFlans:Boolean; var regHandle:HRGN;Kortapa:Boolean;
|
||
Covered:Boolean;SeloDist:Double;st:Integer;penS:Integer=0);
|
||
var rad,sz,h: Double;
|
||
ap1,ap2,ap3,ap4: TDoublePoint;
|
||
fp1,fp2,fp3,fp4: TDoublePoint;
|
||
p: array of TPoint;
|
||
fMar: Double;
|
||
kt1,kt2,kt3,kt4: TDoublePOint;
|
||
tMar,tSize: Double;
|
||
cp,sp,sp1,sp2,sp3,sp4,xp1,xp2: TDoublePoint;
|
||
rgn:HRGN;
|
||
selH: Double;
|
||
|
||
begin
|
||
|
||
tMar := 0.2;
|
||
tSize := dim;
|
||
fMar := 1;
|
||
Selh := 1.5;
|
||
|
||
ConvertDim(fMar);
|
||
ConvertDim(Dim);
|
||
ConvertDim(tMar);
|
||
ConvertDim(tSize);
|
||
ConvertDim(Selodist);
|
||
ConvertDim(SelH);
|
||
sz := dim/2;
|
||
h := dim/2;
|
||
ConvertDim(Mar);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
rad := GetRadOfLine(p1,p2);
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
kt2 := DoublePoint(p2.x,p2.y-(tSize/2));
|
||
kt3 := DoublePoint(p2.x,p2.y+(tSize/2));
|
||
kt1 := DoublePOint(kt2.x-tMar,kt2.y);
|
||
kt4 := DoublePOint(kt3.x-tMar,kt3.y);
|
||
|
||
|
||
p2 := DoublePoint(p2.x-sz-1-Mar,p2.y);
|
||
ap1 := DoublePoint(p2.x-sz,p2.y-h);
|
||
ap2 := DoublePoint(p2.x+sz,p2.y-h);
|
||
ap3 := DoublePoint(p2.x+sz,p2.y+h);
|
||
ap4 := DoublePoint(p2.x-sz,p2.y+h);
|
||
fp1 := DoublePoint(p2.x-sz-fMar,p2.y-h);
|
||
fp2 := DoublePoint(p2.x-sz-fmar,p2.y+h);
|
||
fp3 := DoublePoint(p2.x+sz+fMar,p2.y-h);
|
||
fp4 := DoublePoint(p2.x+sz+fmar,p2.y+h);
|
||
|
||
|
||
|
||
ap1 := RotatePoint(p1,ap1,rad);
|
||
ap2 := RotatePoint(p1,ap2,rad);
|
||
ap3 := RotatePoint(p1,ap3,rad);
|
||
ap4 := RotatePoint(p1,ap4,rad);
|
||
fp1 := RotatePoint(p1,fp1,rad);
|
||
fp2 := RotatePoint(p1,fp2,rad);
|
||
fp3 := RotatePoint(p1,fp3,rad);
|
||
fp4 := RotatePoint(p1,fp4,rad);
|
||
|
||
kt1 := RotatePoint(p1,kt1,rad);
|
||
kt2 := RotatePoint(p1,kt2,rad);
|
||
kt3 := RotatePoint(p1,kt3,rad);
|
||
kt4 := RotatePoint(p1,kt4,rad);
|
||
cp := MPoint(ap1,ap3);
|
||
|
||
SetLength(p,4);
|
||
p[0] := Point(Round(ap1.x),Round(ap1.y));
|
||
p[1] := Point(Round(ap3.x),Round(ap3.y));
|
||
p[2] := Point(Round(ap2.x),Round(ap2.y));
|
||
p[3] := Point(Round(ap4.x),Round(ap4.y));
|
||
|
||
|
||
|
||
if SeloDist <> 0 then begin
|
||
sp :=PointByDistToLine(p1,cp,selodist);
|
||
xp1 := Mpoint(ap1,ap4);
|
||
xp2 := Mpoint(ap2,ap3);
|
||
sp1 :=PointByDistToLine(p1,xp1,selodist);
|
||
sp2 :=PointByDistToLine(p1,xp2,selodist);
|
||
sp3 := Mpoint(sp2,xp2,-selH);
|
||
sp4 := Mpoint(sp1,xp1,-selH);
|
||
DrawLinePix(round(cp.x),round(cp.y),round(sp.x),round(sp.y),pColor,1,penS,0);
|
||
DrawLinePix(round(sp1.x),round(sp1.y),round(sp2.x),round(sp2.y),pColor,1,penS,0);
|
||
DrawLinePix(round(sp2.x),round(sp2.y),round(sp3.x),round(sp3.y),pColor,1,penS,0);
|
||
DrawLinePix(round(sp3.x),round(sp3.y),round(sp4.x),round(sp4.y),pColor,1,penS,0);
|
||
DrawLinePix(round(sp4.x),round(sp4.y),round(sp1.x),round(sp1.y),pColor,1,penS,0);
|
||
|
||
sp :=PointByDistToLine(p1,cp,selodist);
|
||
end;
|
||
|
||
Canvas.Pen.Style := TPenStyle(penS);
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Mode := pmCopy;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Brush.Color := bColor;
|
||
Canvas.Brush.Style := TBrushStyle(st);
|
||
|
||
WPolygon(p,regHandle);
|
||
|
||
if hasFlans then begin
|
||
DrawLinePix(round(fp1.x),round(fp1.y),round(fp2.x),round(fp2.y),pColor,2,penS,0);
|
||
DrawLinePix(round(fp3.x),round(fp3.y),round(fp4.x),round(fp4.y),pColor,2,penS,0);
|
||
end;
|
||
|
||
if Kortapa then begin
|
||
DrawLinePix(round(kt1.x),round(kt1.y),round(kt2.x),round(kt2.y),pColor,2,penS,0);
|
||
DrawLinePix(round(kt2.x),round(kt2.y),round(kt3.x),round(kt3.y),pColor,2,penS,0);
|
||
DrawLinePix(round(kt3.x),round(kt3.y),round(kt4.x),round(kt4.y),pColor,2,penS,0);
|
||
end;
|
||
|
||
if covered then begin
|
||
cp := MPoint(fp1,fp4);
|
||
fp1 := ScalePoint(cp,fp1,3.5,3.5);
|
||
fp2 := ScalePoint(cp,fp2,3.5,3.5);
|
||
fp3 := ScalePoint(cp,fp3,3.5,3.5);
|
||
fp4 := ScalePoint(cp,fp4,3.5,3.5);
|
||
DrawCover(fp1,fp2,fp4,fp3,pColor,false);
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.WPolygon(const p: array of TPoint;
|
||
var RegHandle: HRGN; ADrawPoints: Pointer=nil);
|
||
var ip: Pointer;
|
||
i,size: Integer;
|
||
xp: TPoint;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
size := Length(p);
|
||
ip := ADrawPoints; //31.10.2011
|
||
if ip = nil then //31.10.2011
|
||
begin
|
||
GetMem(ip,(size+1)*8);
|
||
for i := 0 to size do begin
|
||
if i = size then
|
||
xp := p[0]
|
||
else
|
||
xp := p[i];
|
||
//PInt(PChar(ip)+i*8+0)^:= xp.x;
|
||
//PInt(PChar(ip)+i*8+4)^:= xp.y;
|
||
PInt(PAnsiChar(ip)+i*8+0)^:= xp.x;
|
||
PInt(PAnsiChar(ip)+i*8+4)^:= xp.y;
|
||
end;
|
||
end
|
||
else
|
||
Size := 4; //31.10.2011 <20><><EFBFBD><EFBFBD> <20><><EFBFBD> TRectangle
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
Windows.Polygon(FCanvas.Handle, PPoints(ip)^,Size+1);
|
||
if reghandle = 0 then
|
||
reghandle := CreatePolygonRgn(PPoints(ip)^,size+1,ALTERNATE);
|
||
if ADrawPoints = nil then
|
||
FreeMem(ip,(size+1)*8);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
Windows.Polygon(FCanvas.Handle, PPoints(ip)^,Size+1);
|
||
if reghandle = 0 then
|
||
reghandle := CreatePolygonRgn(PPoints(ip)^,size+1,ALTERNATE);
|
||
if ADrawPoints = nil then
|
||
FreeMem(ip,(size+1)*8);
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawIsoKombi(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; rad1,rad2: Double;var RegHandle: HRGN;Covered:Boolean;st:Integer);
|
||
var cp1: TDoublePoint;
|
||
ap1,ap2,ap3,ap4:TDoublePoint;
|
||
d: Double;
|
||
begin
|
||
d := 10;
|
||
ConvertDim(d);
|
||
ConvertDim(rad1);
|
||
ConvertDim(rad2);
|
||
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
cp1 := MPoint(p2,p1,-rad1);
|
||
DrawCirclePix(round(cp1.x),round(cp1.y),round(rad1),pColor,1,ord(psSOlid),bColor,st,RegHandle);
|
||
DrawCirclePix(round(cp1.x),round(cp1.y),round(rad2),pColor,1,ord(psSOlid),bColor,st,RegHandle);
|
||
DrawCenteredText(Point(Round(cp1.x),Round(cp1.y)),pColor,'G','Verdana',3.5,0);
|
||
|
||
MovetoPix(round(cp1.x),round(cp1.y+rad1));
|
||
LinetoPix(round(cp1.x),round(cp1.y+rad1+rad1));
|
||
MovetoPix(round(cp1.x-rad1),round(cp1.y+rad1+(rad1/2)));
|
||
LinetoPix(round(cp1.x+rad1),round(cp1.y+rad1+(rad1/2)));
|
||
if Covered then begin
|
||
ap1 := DoublePoint(cp1.x-d,cp1.y-d);
|
||
ap2 := DoublePoint(cp1.x+d,cp1.y-d);
|
||
ap3 := DoublePoint(cp1.x+d,cp1.y+d);
|
||
ap4 := DoublePoint(cp1.x-d,cp1.y+d);
|
||
DrawCover(ap1,ap2,ap3,ap4,pColor,false);
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawIsoOcak(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; size: Double; var RegHandle: HRGN;st:Integer);
|
||
var cp1: TDoublePoint;
|
||
p: array [0..3] of TPoint;
|
||
i: Integer;
|
||
begin
|
||
ConvertDim(size);
|
||
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
cp1 := MPoint(p2,p1,-(size/2));
|
||
p[0] := Point(Round(cp1.x-(Size/2)),Round(cp1.y-(Size/2)));
|
||
p[1] := Point(Round(cp1.x+(Size/2)),Round(cp1.y-(Size/2)));
|
||
p[2] := Point(Round(cp1.x+(Size/2)),Round(cp1.y+(Size/2)));
|
||
p[3] := Point(Round(cp1.x-(Size/2)),Round(cp1.y+(Size/2)));
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Mode := pmCopy;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Brush.Style := TBrushStyle(st);
|
||
Canvas.Brush.Color := bColor;
|
||
WPolygon(p,RegHandle);
|
||
p[0] := Point(Round(cp1.x-(Size/4)),Round(cp1.y-(Size/4)));
|
||
p[1] := Point(Round(cp1.x+(Size/4)),Round(cp1.y-(Size/4)));
|
||
p[2] := Point(Round(cp1.x+(Size/4)),Round(cp1.y+(Size/4)));
|
||
p[3] := Point(Round(cp1.x-(Size/4)),Round(cp1.y+(Size/4)));
|
||
for i := 0 to 3 do
|
||
DrawCirclePix(p[i].X,p[i].Y,round(size/6),pColor,1,ord(psSOlid),bColor,ord(bsClear),RegHandle);
|
||
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawIsoSoba(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; w, h: Double; var RegHandle: HRGN;st:Integer);
|
||
var cp1: TDoublePoint;
|
||
p: array [0..3] of TPoint;
|
||
i: Integer;
|
||
m: Double;
|
||
Shifted: Boolean;
|
||
begin
|
||
m := 2.5;
|
||
ConvertDim(m);
|
||
ConvertDim(w);
|
||
ConvertDim(h);
|
||
|
||
Shifted := False;
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
if p1.z = p2.z then begin
|
||
if p1.y = p2.y then
|
||
cp1 := MPoint(p2,p1,-(w/2))
|
||
else begin
|
||
p1 := p2;
|
||
p2 := DoublePoint(p2.x+(m),p2.y);
|
||
cp1 := MPoint(p2,p1,-(w/2));
|
||
Shifted := True;
|
||
end;
|
||
end else begin
|
||
cp1 := MPoint(p2,p1,-(h/2));
|
||
end;
|
||
p[0] := Point(Round(cp1.x-(w/2)),Round(cp1.y-(h/2)));
|
||
p[1] := Point(Round(cp1.x+(w/2)),Round(cp1.y-(h/2)));
|
||
p[2] := Point(Round(cp1.x+(w/2)),Round(cp1.y+(h/2)));
|
||
p[3] := Point(Round(cp1.x-(w/2)),Round(cp1.y+(h/2)));
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Mode := pmCopy;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Brush.Style := TBrushStyle(st);
|
||
Canvas.Brush.Color := bColor;
|
||
WPolygon(p,RegHandle);
|
||
if Shifted then begin
|
||
MovetoPix(Round(p1.x),Round(p1.y));
|
||
LineToPix(Round(p2.x),Round(p2.y));
|
||
end;
|
||
for i := 1 to 4 do
|
||
begin
|
||
MoveToPix(p[0].X+round(i*w/4),p[0].y);
|
||
LineToPix(p[0].X+round(i*w/4),p[3].y);
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawIsoSofben(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; rad1: Double; var RegHandle: HRGN;st:Integer);
|
||
var cp1,lp1,lp2: TDoublePoint;
|
||
begin
|
||
ConvertDim(rad1);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
cp1 := MPoint(p2,p1,-rad1);
|
||
DrawCirclePix(round(cp1.x),round(cp1.y),round(rad1),pColor,1,ord(psSOlid),bColor,st,RegHandle);
|
||
MovetoPix(round(cp1.x),round(cp1.y+rad1));
|
||
LineToPix(round(cp1.x),round(cp1.y+rad1+rad1));
|
||
DrawRowPix(round(cp1.x),round(cp1.y+rad1),round(cp1.x),round(cp1.y+rad1+rad1),8,8,True);
|
||
DrawCenteredText(Point(Round(cp1.x),Round(cp1.y)),pColor,'G','Verdana',3.5,0);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.Drawtext(ap1: TDoublePoint; angle: Double; atext,
|
||
afontName: String;Styles:TFontStyles;aColor:TColor; aheight: double; marx:double = 0;mary:double=0);
|
||
var aFont,oldFont:TFont;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
begin
|
||
ConvertDim(aHeight);
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := afontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := aColor;
|
||
FCanvas.Font := aFont;
|
||
|
||
ConvertCoord(ap1.x,ap1.y,ap1.z);
|
||
// Set Font Height
|
||
SetBkMode(Fcanvas.Handle,TRANSPARENT);
|
||
|
||
ConvertDim(marx);
|
||
ConvertDim(mary);
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
|
||
if angle <> 0 then begin
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfEscapement := Round(1800*(angle/pi));
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
(*
|
||
// Set Font Width
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
*)
|
||
|
||
ap1.x := ap1.x+marx;
|
||
ap1.y := ap1.y+mary;
|
||
FCanvas.TextOut(Round(ap1.x),Round(ap1.y),aText);
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawrect(p1: TDoublePoint; rw, rh: Double; color,
|
||
awidth, style, bc, bs: integer;var rgn:HRGN);
|
||
begin
|
||
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertDim(rw);
|
||
ConvertDim(rh);
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := awidth;
|
||
FCanvas.pen.style := penstyles[style];
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
Fcanvas.Rectangle(Round(p1.x),round(p1.y),round(p1.x)+Round(rw),round(p1.y)+round(rh));
|
||
if rgn = 0 then
|
||
rgn := CreateRectRgn(Round(p1.x),round(p1.y),round(p1.x)+Round(rw),round(p1.y)+Round(rw));
|
||
end;
|
||
|
||
Procedure TPCDrawEngine.Drawtext(ap1: TDoublePoint; atext:TstringList;
|
||
afontName: String;Styles:TFontStyles;aColor:TColor;aheight: double;
|
||
var Region:HRGN;
|
||
var tw,th: Double;
|
||
marx:double = 0;mary:double=0);
|
||
var twi,thi:Integer;
|
||
begin
|
||
tw := 0;
|
||
th := 0;
|
||
ConvertDim(aHeight);
|
||
ConvertCoord(ap1.x,ap1.y,ap1.z);
|
||
ConvertDim(marx);
|
||
ConvertDim(mary);
|
||
DrawMTextToCanvas(Point(Round(ap1.x),Round(ap1.y)),aText,aFontName,Styles,aColor,0,
|
||
round(aHeight),round(marX),round(marY),0,Region,twi,thi,FCanvas);
|
||
tw := twi;
|
||
th := thi;
|
||
DeconvertDim(tw);
|
||
DeconvertDim(th);
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.Drawtext(ap1: TDoublePoint; atext: TstringList;
|
||
afontName: String; Styles: TFontStyles;
|
||
aColor: TColor; aheight: double; marx:double = 0;mary:double=0);
|
||
|
||
var twi,thi:Integer;
|
||
reg:HRGN;
|
||
begin
|
||
|
||
ConvertDim(aHeight);
|
||
ConvertCoord(ap1.x,ap1.y,ap1.z);
|
||
ConvertDim(marx);
|
||
ConvertDim(mary);
|
||
reg := 1;
|
||
DrawMTextToCanvas(Point(Round(ap1.x),Round(ap1.y)),aText,aFontName,Styles,aColor,0,
|
||
round(aHeight),round(marX),round(marY),0,reg,twi,thi,FCanvas);
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawrow(xp1, xp2: TDoublePoint; solid: Boolean;var rgn:HRGN;hl,
|
||
hh: double);
|
||
var
|
||
pt : TDoublePointArr;
|
||
|
||
begin
|
||
//SetLength(pt,3);
|
||
//CalcRowPoints(xp1.x,xp1.y,xp2.x,xp2.y,hl,hh,pt[0],pt[1],pt[2]);
|
||
//if solid then Polygon(pt,rgn) else PolyLine(pt);
|
||
//(*
|
||
|
||
ConvertCoord(xp1.x,xp1.y,xp1.z);
|
||
ConvertCoord(xp2.x,xp2.y,xp2.z);
|
||
ConvertLen(hl);
|
||
ConvertLen(hh);
|
||
DrawRowPix(Round(xp1.x),Round(xp1.y),Round(xp2.x),Round(xp2.y),round(hh),round(hl),Solid);
|
||
//*)
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawRegulator(p1, p2: TDoublePoint; pColor,
|
||
bColor,npColor: TColor; Dim, Mar: Double; var RegHandle: HRGN;covered:Boolean;st:Integer);
|
||
var sz,rad,dx,dy: Double;
|
||
cp: TDoublePoint;
|
||
cp1,cp2,cp3,cp4,lp1,lp2,lp3: TDoublePOint;
|
||
dp2:TDoublePOint;
|
||
npMar,mLen,moMar,moR,rh,rW: Double;
|
||
npR: Double;
|
||
rgn: HRGN;
|
||
r1,r2: TDoublePOint;
|
||
lp: array[0..3] of TPoint;
|
||
mp1,mp2,mp3,mp4:TDoublePoint;
|
||
mil: Double;
|
||
u: Double;
|
||
|
||
Function MoveP(p:TDoublePOint;dist:Double):TDoublePOint;
|
||
begin
|
||
result := RotatePoint(p1,p,-rad);
|
||
result := MovePoint(result,dist,0);
|
||
result := RotatePoint(p1,result,rad);
|
||
end;
|
||
begin
|
||
|
||
mp1 := MPoint(p2,p1,27.0);
|
||
mp2 := Mpoint(p2,p1,0.5);
|
||
rad := GetRadOfline(mp1,mp2);
|
||
mp2 := RotatePOint(mp1,mp2,-rad);
|
||
cp := mp1;
|
||
mp1 := DoublePOint(mp1.x,mp1.y-12);
|
||
mp2 := DoublePOint(mp2.x,mp2.y-12);
|
||
mp3 := DoublePOint(mp2.x,mp2.y+22);
|
||
mp4 := DoublePOint(mp1.x,mp1.y+22);
|
||
mp1 := RotatePoint(cp,mp1,rad);
|
||
mp2 := RotatePoint(cp,mp2,rad);
|
||
mp3 := RotatePoint(cp,mp3,rad);
|
||
mp4 := RotatePoint(cp,mp4,rad);
|
||
|
||
ConvertDim(Dim);
|
||
npMar := 3.8;
|
||
moMar := 1.0;
|
||
moR := 1.2;
|
||
npR := 0.6;
|
||
sz := dim/2;
|
||
rh := 0.6;
|
||
rw := 0.6;
|
||
mLen := 4;
|
||
mil := 1.8;
|
||
u := 1;
|
||
rgn:=1;
|
||
ConvertDim(u);
|
||
ConvertDim(Mar);
|
||
ConvertDim(npMar);
|
||
ConvertDim(moMar);
|
||
ConvertDim(npR);
|
||
ConvertDim(mLen);
|
||
ConvertDim(moR);
|
||
ConvertDim(rh);
|
||
ConvertDim(rw);
|
||
ConvertDim(mil);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
rad := GetRadOfLine(p1,p2);
|
||
|
||
|
||
cp1 := RotatePoint(p1,p2,-rad);
|
||
cp1 := DoublePoint(cp1.x-sz-Mar+mil,cp1.y);
|
||
|
||
cp2 := RotatePoint(p1,p2,-rad);
|
||
cp2 := DoublePoint(cp2.x-sz-Mar+sz+npMar,cp2.y);
|
||
|
||
cp3 := RotatePoint(p1,p2,-rad);
|
||
cp3 := DoublePoint(cp3.x-sz-Mar-sz-moMar,cp3.y);
|
||
cp4 := DoublePOint(cp3.x,cp3.y-mLen);
|
||
r1 := DoublePoint(cp4.x-(mor/2),cp4.y+(mor/2));
|
||
r2 := DoublePoint(cp4.x+(mor/2),cp4.y-(mor/2));
|
||
|
||
cp1 := RotatePoint(p1,cp1,rad);
|
||
cp2 := RotatePoint(p1,cp2,rad);
|
||
cp3 := RotatePoint(p1,cp3,rad);
|
||
cp4 := RotatePoint(p1,cp4,rad);
|
||
r1 := RotatePoint(p1,r1,rad);
|
||
r2 := RotatePoint(p1,r2,rad);
|
||
|
||
DrawCirclePix(Round(cp1.x),Round(cp1.y),Round(Dim),pColor,1,ord(psSolid),bColor,st,regHandle);
|
||
dx := Dim/2;
|
||
dy := sqrt(dim*dim-dx*dx)-2;
|
||
lp[0] := Point(Round(cp1.x+dim-2),Round(cp1.y));
|
||
lp[1] := Point(Round(cp1.x-dx),Round(cp1.y+dy));
|
||
lp[2] := Point(Round(cp1.x-dx),Round(cp1.y-dy));
|
||
lp[3] := lp[0];
|
||
WPolyline(lp);
|
||
|
||
DrawCirclePix(Round(cp2.x),Round(cp2.y),Round(npR),npColor,1,ord(psSolid),npColor,ord(bsSolid),rgn);
|
||
cp2 := MoveP(cp2,-6*u);
|
||
DrawCirclePix(Round(cp2.x),Round(cp2.y),Round(npR),npColor,1,ord(psSolid),npColor,ord(bsSolid),rgn);
|
||
|
||
|
||
DrawLinePix(Round(cp3.x),Round(cp3.y),Round(cp4.x),Round(cp4.y),npColor,1,ord(psSolid),0);
|
||
DrawCirclePix(Round(cp4.x),Round(cp4.y),Round(moR),npColor,1,ord(psSolid),bColor,st,rgn);
|
||
DrawLinePix(Round(r1.x),Round(r1.y),Round(r2.x),Round(r2.y),npColor,1,ord(psSolid),0);
|
||
Canvas.Pen.Color := npColor;
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
SetCanvasValues(npColor,npColor,1,psSolid,bsSolid,pmCopy);
|
||
if (rh > 1) and (rw > 1) then DrawRowPix(Round(r1.x),Round(r1.y),Round(r2.x),Round(r2.y),round(rh),round(rw),True);
|
||
|
||
cp3 := Movep(cp3,7.5*u);
|
||
cp4 := Movep(cp4,7.5*u);
|
||
r1 := Movep(r1,7.5*u);
|
||
r2 := Movep(r2,7.5*u);
|
||
|
||
DrawLinePix(Round(cp3.x),Round(cp3.y),Round(cp4.x),Round(cp4.y),npColor,1,ord(psSolid),0);
|
||
DrawCirclePix(Round(cp4.x),Round(cp4.y),Round(moR),npColor,1,ord(psSolid),bColor,st,rgn);
|
||
DrawLinePix(Round(r1.x),Round(r1.y),Round(r2.x),Round(r2.y),npColor,1,ord(psSolid),0);
|
||
Canvas.Pen.Color := npColor;
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
SetCanvasValues(npColor,npColor,1,psSolid,bsSolid,pmCopy);
|
||
if (rh > 1) and (rw > 1) then DrawRowPix(Round(r1.x),Round(r1.y),Round(r2.x),Round(r2.y),round(rh),round(rw),True);
|
||
|
||
|
||
if Covered then begin
|
||
DrawCover(mp1,mp2,mp3,mp4,pColor,true);
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.SetCanvasValues(PenColor, BrushColor: TColor;
|
||
PenWidth: Integer; PenStyle: TPenStyle; BrushStyle: TBrushStyle;
|
||
PenMode: TPenMode);
|
||
begin
|
||
Canvas.Brush.Color := BrushColor;
|
||
Canvas.Brush.Style := BrushStyle;
|
||
Canvas.Pen.Color := PenCOlor;
|
||
Canvas.Pen.Width := PenWidth;
|
||
Canvas.Pen.Style := PenStyle;
|
||
Canvas.Pen.Mode := PenMode;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.SetCanvasValues(PenColor, BrushColor: TColor;
|
||
PenWidth, PenStyle, BrushStyle: Integer; PenMode: TPenMode);
|
||
begin
|
||
SetCanvasValues(PenColor,BrushColor,PenWidth,TPenStyle(PenStyle),TBrushSTyle(BrushStyle),PenMode);
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.WPolyline(const p: array of TPoint);
|
||
var ip: Pointer;
|
||
i,size: Integer;
|
||
xp: TPoint;
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
begin
|
||
size := Length(p);
|
||
GetMem(ip,size*8);
|
||
for i := 0 to size -1 do begin
|
||
xp := p[i];
|
||
// Tolik 23/04/2019 --
|
||
//PInt(PChar(ip)+i*8+0)^:= xp.x;
|
||
//PInt(PChar(ip)+i*8+4)^:= xp.y;
|
||
PInt(PAnsiChar(ip)+i*8+0)^:= xp.x;
|
||
PInt(PAnsiChar(ip)+i*8+4)^:= xp.y;
|
||
//
|
||
end;
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
Windows.Polyline(FCanvas.Handle, PPoints(ip)^,Size);
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
if Not FCachePen then //01.11.2011
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
Windows.Polyline(FCanvas.Handle, PPoints(ip)^,Size);
|
||
end;
|
||
FreeMem(ip,size*8);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawCenteredText(p1: TPoint; Color: TColor; Text,
|
||
FontName: String; FontSize: Double;Angle:Double);
|
||
var tWidth,tHeight:Integer;
|
||
FSize: Double;
|
||
FontRecord : TLogFont;
|
||
ap1,ap2,ap3,ap4:TDoublePoint;
|
||
begin
|
||
|
||
if angle = 0 then begin
|
||
FSize := FontSize;
|
||
ConvertDim(FSize);
|
||
if FSize < 4 then exit;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
Canvas.brush.style := bsClear;
|
||
Canvas.Font.Name := FontName;
|
||
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(FSize);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
Canvas.Font.Color := Color;
|
||
tWidth := Canvas.TextWidth(text);
|
||
tHeight := Canvas.TextHeight(text);
|
||
Canvas.TextOut(Round(p1.x)-(tWidth div 2),Round(p1.y)-(tHeight div 2),Text);
|
||
end else begin
|
||
FSize := FontSize;
|
||
ConvertDim(FSize);
|
||
if FSize < 4 then exit;
|
||
Canvas.Font.Name := FontName;
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(FSize);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
tWidth := Canvas.TextWidth(text);
|
||
tHeight := Canvas.TextHeight(text);
|
||
ap1 := DoublePoint(p1.x-(tWidth/2),p1.y-(tHeight/2));
|
||
ap2 := DoublePoint(ap1.x+tWidth,ap1.y);
|
||
ap3 := DoublePoint(ap2.x,ap2.y+tHeight);
|
||
ap4 := DoublePoint(ap1.x,ap1.y+tHeight);
|
||
ap1 := RotatePoint(DP(p1),ap1,Angle);
|
||
ap2 := RotatePoint(DP(p1),ap2,Angle);
|
||
ap3 := RotatePoint(DP(p1),ap3,Angle);
|
||
ap4 := RotatePoint(DP(p1),ap4,Angle);
|
||
|
||
DrawText(Dp2P(ap1),Dp2P(ap2),Dp2P(ap3),Dp2P(ap4),Angle,Text,FontName,Color,FontSize);
|
||
end;
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawCenteredText(p1: TDoublePoint; Color: TColor;
|
||
Text, FontName: String; FontSize: Double);
|
||
var tWidth,tHeight:Integer;
|
||
FSize: Double;
|
||
FontRecord : TLogFont;
|
||
begin
|
||
FSize := FontSize;
|
||
ConvertDim(FSize);
|
||
if FSize < 4 then exit;
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
Canvas.Font.Name := FontName;
|
||
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(FSize);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
Canvas.Font.Color := Color;
|
||
tWidth := Canvas.TextWidth(text);
|
||
tHeight := Canvas.TextHeight(text);;
|
||
Canvas.TextOut(Round(p1.x)-(tWidth div 2),Round(p1.y)-(tHeight div 2),Text);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.SetCanvasValues(PenColor, BrushColor: TColor;
|
||
PenWidth: Integer; PenStyle: TPenStyle; BrushStyle: TBrushStyle);
|
||
begin
|
||
Canvas.Brush.Color := BrushColor;
|
||
Canvas.Brush.Style := BrushStyle;
|
||
Canvas.Pen.Color := PenCOlor;
|
||
Canvas.Pen.Width := PenWidth;
|
||
Canvas.Pen.Style := PenStyle;
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawFlansh(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; Dim, Mar,Len: Double; var RegHandle: HRGN;st:Integer);
|
||
var rad,sz,h: Double;
|
||
ap1,ap2,ap3,ap4: TDoublePoint;
|
||
p: array of TPoint;
|
||
tp1,tp2,tp3,tl1,tl2,tl3,tl4,tl5,tl6: TDoublePoint;
|
||
begin
|
||
sz := len;
|
||
h := dim/2;
|
||
ConvertDim(h);
|
||
ConvertDim(sz);
|
||
|
||
ConvertDim(Mar);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
rad := GetRadOfLine(p1,p2);
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
p2 := DoublePoint(p2.x-sz-1-Mar,p2.y);
|
||
ap1 := DoublePoint(p2.x-sz,p2.y-h);
|
||
ap2 := DoublePoint(p2.x+sz,p2.y-h);
|
||
ap3 := DoublePoint(p2.x+sz,p2.y+h);
|
||
ap4 := DoublePoint(p2.x-sz,p2.y+h);
|
||
|
||
ap1 := RotatePoint(p1,ap1,rad);
|
||
ap2 := RotatePoint(p1,ap2,rad);
|
||
ap3 := RotatePoint(p1,ap3,rad);
|
||
ap4 := RotatePoint(p1,ap4,rad);
|
||
|
||
SetLength(p,4);
|
||
p[0] := Point(Round(ap1.x),Round(ap1.y));
|
||
p[1] := Point(Round(ap2.x),Round(ap2.y));
|
||
p[2] := Point(Round(ap3.x),Round(ap3.y));
|
||
p[3] := Point(Round(ap4.x),Round(ap4.y));
|
||
|
||
Canvas.Pen.Style := psClear;
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Mode := pmCopy;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Brush.Style := TBrushStyle(st);
|
||
Canvas.Brush.Color := bColor;
|
||
WPolygon(p,regHandle);
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 2;
|
||
DrawLinePix(p[0],p[3],0);
|
||
DrawLinePix(p[1],p[2],0);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawlinePix(p1, p2: TPoint; row: Integer);
|
||
var rw,rh: Double;
|
||
x1,y1,x2,y2: Integer;
|
||
begin
|
||
x1 := p1.x;
|
||
x2 := p2.x;
|
||
y1 := p1.y;
|
||
y2 := p2.y;
|
||
rw := 3.5;
|
||
rh := 1.2;
|
||
ConvertDim(rw);
|
||
ConvertDim(rh);
|
||
if row = 1 then drawrowpix(x1,y1,x2,y2,Round(rh),Round(rw),true)
|
||
else if row = 2 then drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),true)
|
||
else if row = 3 then begin
|
||
drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),true);
|
||
drawrowPix(x1,y1,x2,y2,Round(rh),Round(rw),true)
|
||
end
|
||
else if row = 4 then drawrowPix(x1,y1,x2,y2,Round(rh),Round(rw),false)
|
||
else if row = 5 then drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),false)
|
||
else if row = 6 then begin
|
||
drawrowPix(x2,y2,x1,y1,Round(rh),Round(rw),false);
|
||
drawrowPix(x1,y1,x2,y2,Round(rh),Round(rw),false)
|
||
end;
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
FCanvas.moveto(x1,y1);
|
||
FCanvas.lineto(x2,y2);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawKatod(p1, p2: TDoublePoint; Color: TColor;
|
||
var RegHandle: HRGN);
|
||
var mp: TDoublePOint;
|
||
d,rad: Double;
|
||
h1,h2,h3,h4: TDoublePoint;
|
||
t1,t2,t3,t4,t5,t6:TDoublePoint;
|
||
p: array of TPoint;
|
||
tp: TDoublePOint;
|
||
i:Integer;
|
||
begin
|
||
FCanvas.pen.color := color;
|
||
FCanvas.pen.width := 1;
|
||
FCanvas.Pen.Style := psSolid;
|
||
FCanvas.Brush.Style := bsClear;
|
||
FCanvas.Brush.Color := color;
|
||
tp := MPoint(p1,p2);
|
||
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
|
||
|
||
d := 1;
|
||
ConvertDim(d);
|
||
SetLength(p,4);
|
||
rad := GetRadOfLine(p1,p2);
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
mp := MPoint(p1,p2);
|
||
h1 := mp;
|
||
h2 := MovePoint(h1,-2*d,1.5*d);
|
||
h3 := MovePoint(h2,+d,1.6*d);
|
||
h4 := MovePoint(h3,-d,1.8*d);
|
||
t1 := h4;
|
||
t2 := MovePoint(t1,-1.5*d,d);
|
||
t3 := MovePoint(t2,0,2*d);
|
||
t4 := MovePoint(t3,2*d,2.2*d);
|
||
t5 := MovePoint(t4,2.2*d,-2.5*d);
|
||
t6 := MovePoint(t5,-d,-1.5*d);
|
||
|
||
h1 := RotatePoint(p1,h1,rad);
|
||
h2 := RotatePoint(p1,h2,rad);
|
||
h3 := RotatePoint(p1,h3,rad);
|
||
h4 := RotatePoint(p1,h4,rad);
|
||
|
||
p[0] := Dp2P(h1); p[1] := Dp2P(h2); p[2] := Dp2P(h3); p[3] := Dp2P(h4);
|
||
|
||
WPolyline(p);
|
||
t1 := RotatePoint(p1,t1,rad);
|
||
t2 := RotatePoint(p1,t2,rad);
|
||
t3 := RotatePoint(p1,t3,rad);
|
||
t4 := RotatePoint(p1,t4,rad);
|
||
t5 := RotatePoint(p1,t5,rad);
|
||
t6 := RotatePoint(p1,t6,rad);
|
||
|
||
SetLength(p,6);
|
||
p[0] := Dp2P(t1); p[1] := Dp2P(t2); p[2] := Dp2P(t3); p[3] := Dp2P(t4);
|
||
p[4] := Dp2P(t5); p[5] := Dp2P(t6);
|
||
FCanvas.Brush.Style := bsSolid;
|
||
FCanvas.Brush.Color := clWhite;
|
||
WPolygon(p,regHandle);
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawToprak(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; Dim, Mar: Double; var RegHandle: HRGN;st:Integer;pos:Integer);
|
||
var rad,sz,h: Double;
|
||
ap1,ap2,ap3,ap4: TDoublePoint;
|
||
p: array of TPoint;
|
||
tp1,tp2,tp3,tl1,tl2,tl3,tl4,tl5,tl6: TDoublePoint;
|
||
begin
|
||
sz := 1;
|
||
ConvertDim(Dim);
|
||
ConvertDim(sz);
|
||
h := dim/2;
|
||
ConvertDim(Mar);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
rad := GetRadOfLine(p1,p2);
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
p2 := DoublePoint(p2.x-Mar,p2.y);
|
||
|
||
tp1 := DoublePoint(p2.x-3*sz+3*sz,p2.y);
|
||
tp2 := DoublePoint(p2.x-3*sz+3*sz,p2.y+2*h);
|
||
tp3 := DoublePoint(p2.x-6*sz+3*sz,p2.y+2*h);
|
||
tl1 := DoublePoint(p2.x-6*sz+3*sz,p2.y+2*h-3*sz);
|
||
tl2 := DoublePoint(p2.x-6*sz+3*sz,p2.y+2*h+3*sz);
|
||
tl3 := DoublePoint(p2.x-7*sz+3*sz,p2.y+2*h-2*sz);
|
||
tl4 := DoublePoint(p2.x-7*sz+3*sz,p2.y+2*h+2*sz);
|
||
tl5 := DoublePoint(p2.x-8*sz+3*sz,p2.y+2*h-1*sz);
|
||
tl6 := DoublePoint(p2.x-8*sz+3*sz,p2.y+2*h+1*sz);
|
||
|
||
tp1 := RotatePoint(p1,tp1,rad);
|
||
tp2 := RotatePoint(p1,tp2,rad);
|
||
tp3 := RotatePoint(p1,tp3,rad);
|
||
tl1 := RotatePoint(p1,tl1,rad);
|
||
tl2 := RotatePoint(p1,tl2,rad);
|
||
tl3 := RotatePoint(p1,tl3,rad);
|
||
tl4 := RotatePoint(p1,tl4,rad);
|
||
tl5 := RotatePoint(p1,tl5,rad);
|
||
tl6 := RotatePoint(p1,tl6,rad);
|
||
|
||
rad := (pos-1)*(pi/2);
|
||
if rad <> 0 then begin
|
||
tp2 := RotatePoint(tp1,tp2,rad);
|
||
tp3 := RotatePoint(tp1,tp3,rad);
|
||
tl1 := RotatePoint(tp1,tl1,rad);
|
||
tl2 := RotatePoint(tp1,tl2,rad);
|
||
tl3 := RotatePoint(tp1,tl3,rad);
|
||
tl4 := RotatePoint(tp1,tl4,rad);
|
||
tl5 := RotatePoint(tp1,tl5,rad);
|
||
tl6 := RotatePoint(tp1,tl6,rad);
|
||
end;
|
||
|
||
Canvas.Pen.Style := psClear;
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
DrawLinePix(DP2P(tp1),DP2P(tp2),0);
|
||
DrawLinePix(DP2P(tp2),DP2P(tp3),0);
|
||
DrawLinePix(DP2P(tl1),DP2P(tl2),0);
|
||
DrawLinePix(DP2P(tl3),DP2P(tl4),0);
|
||
DrawLinePix(DP2P(tl5),DP2P(tl6),0);
|
||
if RegHandle = 0 then begin
|
||
RegHandle := PolygonRegion(DP2P(tl1),DP2P(tl2),DP2P(tl6),DP2P(tl5));
|
||
end;
|
||
end;
|
||
|
||
function TPCDrawEngine.PolygonRegion(p1, p2, p3, p4: TPoint): HRGN;
|
||
var p:TPointArr;
|
||
begin
|
||
SetLength(p,4);
|
||
p[0] := p1;
|
||
p[1] := p2;
|
||
p[2] := p3;
|
||
p[3] := p4;
|
||
result := PolygonRegion(p);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.Drawtext(ap1, ap2, ap3, a4: TDoublePoint;
|
||
angle: Double; atext, fontName: String;aColor:TColor; aheight, CWidth, CSpace: double;
|
||
var nH, nl: Integer);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
Leading : LongInt;
|
||
ap : TPoint;
|
||
txSize: TSize;
|
||
wChar: Integer;
|
||
x1,y1,z: Double;
|
||
olDFont: TFont;
|
||
aFont:Tfont;
|
||
begin
|
||
nh := 0;
|
||
nl := 0;
|
||
ConvertDim(aHeight);
|
||
if aheight < 4 then exit;
|
||
OldFont := Fcanvas.Font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Color := aColor;
|
||
FCanvas.Font := aFont;
|
||
Fcanvas.Font.Height := Round(aHeight);
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
|
||
x1 := ap1.x;
|
||
y1 := ap1.y;
|
||
z := 0;
|
||
ConvertCoord(x1,y1,z);
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
|
||
if Angle <> 0 then begin
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Angle
|
||
angle := -1*(angle/pi)*1800;
|
||
FontRecord.lfEscapement := Round(angle);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
// Calculate Zero Point
|
||
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
if CWidth <> 0 then begin
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
ConvertDim(CWidth);
|
||
wChar := round(CWidth);
|
||
FontRecord.lfWidth := wchar;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
Leading := TM.tmInternalLeading;
|
||
if angle <> 0 then begin
|
||
ap := getRelativePointbyAngle(Round(angle),DP2P(x1,y1),Dp2P(x1,y1-Leading div 3));
|
||
y1 := ap.y;
|
||
x1 := ap.x;
|
||
end;
|
||
|
||
if CSpace <> 0 then begin
|
||
ConvertDim(CSpace);
|
||
SetTextCharacterExtra(FCanvas.Handle,round(CSpace));
|
||
end;
|
||
|
||
FCanvas.textout(round(x1),Round(y1),atext);
|
||
|
||
|
||
GetTextExtentPoint(FCanvas.Handle,pchar(aText),length(aText),txSize);
|
||
nh := txSize.cy;
|
||
nL := txSize.cx;
|
||
nL := nl-round(cSpace);
|
||
if CSpace <> 0 then begin
|
||
SetTextCharacterExtra(FCanvas.Handle,0);
|
||
end;
|
||
Fcanvas.Font := oldFont;
|
||
aFont.Free;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawIsoGnCihaz(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; size: Double; var RegHandle: HRGN;st:Integer);
|
||
var cp1: TDoublePoint;
|
||
p: array [0..3] of TPoint;
|
||
i: Integer;
|
||
begin
|
||
ConvertDim(size);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
cp1 := MPoint(p2,p1,-(size/2));
|
||
p[0] := Point(Round(cp1.x-(Size/2)),Round(cp1.y-(Size/2)));
|
||
p[1] := Point(Round(cp1.x+(Size/2)),Round(cp1.y-(Size/2)));
|
||
p[2] := Point(Round(cp1.x+(Size/2)),Round(cp1.y+(Size/2)));
|
||
p[3] := Point(Round(cp1.x-(Size/2)),Round(cp1.y+(Size/2)));
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Mode := pmCopy;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Brush.Style := TBrushStyle(st);
|
||
Canvas.Brush.Color := bColor;
|
||
WPolygon(p,RegHandle);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.drawrow(x1, y1, x2, y2: Double; solid: Boolean;
|
||
var reg: HRGN; hl, hh: double);
|
||
var
|
||
pt : TDoublePointArr;
|
||
r:HRGN;
|
||
begin
|
||
r := 1;
|
||
SetLength(pt,3);
|
||
CalcRowPoints(x1,y1,x2,y2,hl,hh,pt[0],pt[1],pt[2]);
|
||
if solid then Polygon(pt,reg) else PolyLine(pt);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.CalcRowPoints(x1, y1, x2, y2: Double; hl, hh: double; var r1, r2, r3: TDoublePoint);
|
||
VAR
|
||
xLineDelta : double;
|
||
yLineDelta : double;
|
||
p1,p2,p3 : TDoublePoint;
|
||
a : integer;
|
||
Angle: Double;
|
||
r: HRGN;
|
||
HeadLength,HeadHeight: Double;
|
||
begin
|
||
try
|
||
HeadLength := hl;
|
||
HeadHeight := hh;
|
||
|
||
xLineDelta := x2 - x1;
|
||
yLineDelta := y2 - y1;
|
||
if (xLineDelta = 0) and (yLineDelta = 0) then exit;
|
||
p1.x := x2;
|
||
p1.y := y2;
|
||
|
||
if (xLineDelta < 0) and (yLineDelta = 0) then
|
||
begin
|
||
p2.x := p1.x + HeadLength;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - HeadHeight;
|
||
p3.y := p1.y + HeadHeight;
|
||
end
|
||
else if (xLineDelta > 0) and (yLineDelta = 0) then
|
||
begin
|
||
p2.x := p1.x - HeadLength;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - HeadHeight;
|
||
p3.y := p1.y + HeadHeight;
|
||
end
|
||
else if (xLineDelta = 0) and (yLineDelta > 0) then
|
||
begin
|
||
p2.x := p1.x - HeadHeight;
|
||
p3.x := p1.x + HeadHeight;
|
||
p2.y := p1.y - HeadLength;
|
||
p3.y := p1.y - HeadLength;
|
||
end
|
||
else if (xLineDelta = 0) and (yLineDelta < 0) then
|
||
begin
|
||
p2.x := p1.x - HeadHeight;
|
||
p3.x := p1.x + HeadHeight;
|
||
p2.y := p1.y + HeadLength;
|
||
p3.y := p1.y + HeadLength;
|
||
end
|
||
else if (xLineDelta > 0) and (yLineDelta > 0) then
|
||
begin
|
||
p2.x := p1.x - HeadLength;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - HeadHeight;
|
||
p3.y := p1.y + HeadHeight;
|
||
//rotate
|
||
Angle := ArcTan(abs(yLineDelta) / abs(xLineDelta));
|
||
p2 := RotatePoint(p1,p2,Angle);
|
||
p3 := RotatePoint(p1,p3,Angle);
|
||
end
|
||
else if (xLineDelta < 0) and (yLineDelta > 0) then
|
||
begin
|
||
p2.x := p1.x - HeadHeight;
|
||
p3.x := p1.x + HeadHeight;
|
||
p2.y := p1.y - HeadLength;
|
||
p3.y := p1.y - HeadLength;
|
||
// rotate
|
||
Angle := (pi/2) - ArcTan(abs(yLineDelta) / abs(xLineDelta));
|
||
p2 := RotatePoint(p1,p2,Angle);
|
||
p3 := RotatePoint(p1,p3,Angle);
|
||
end
|
||
else if (xLineDelta < 0) and (yLineDelta < 0) then
|
||
begin
|
||
p2.x := p1.x + HeadLength;
|
||
p3.x := p2.x;
|
||
p2.y := p1.y - HeadHeight;
|
||
p3.y := p1.y + HeadHeight;
|
||
// rotate
|
||
Angle := ArcTan(abs(yLineDelta) / abs(xLineDelta));
|
||
p2 := RotatePoint(p1,p2,Angle);
|
||
p3 := RotatePoint(p1,p3,Angle);
|
||
end
|
||
else if (xLineDelta > 0) and (yLineDelta < 0) then
|
||
begin
|
||
p2.x := p1.x - HeadHeight;
|
||
p3.x := p1.x + HeadHeight;
|
||
p2.y := p1.y + HeadLength;
|
||
p3.y := p1.y + HeadLength;
|
||
// rotate
|
||
Angle := (pi/2) - ArcTan(abs(yLineDelta) / abs(xLineDelta));
|
||
p2 := RotatePoint(p1,p2,Angle);
|
||
p3 := RotatePoint(p1,p3,Angle);
|
||
end;
|
||
r1 := p2; r2 := p1; r3 := p3;
|
||
except
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.Drawtext(ap1, ap2, ap3, a4: TPoint; angle: Double;
|
||
atext, fontName: String; aColor: TColor; aheight: double);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
Leading : LongInt;
|
||
ap : TPoint;
|
||
txSize: TSize;
|
||
wChar: Integer;
|
||
x1,y1: Integer;
|
||
olDFont: TFont;
|
||
aFont:Tfont;
|
||
begin
|
||
ConvertDim(aHeight);
|
||
if aheight < 4 then exit;
|
||
OldFont := Fcanvas.Font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := FontName;
|
||
aFont.Color := aColor;
|
||
FCanvas.Font := aFont;
|
||
Fcanvas.Font.Height := Round(aHeight);
|
||
|
||
FCanvas.brush.color := clNone;
|
||
FCanvas.brush.style := bsClear;
|
||
|
||
|
||
x1 := ap1.x;
|
||
y1 := ap1.y;
|
||
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
|
||
if Angle <> 0 then begin
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Angle
|
||
angle := -1*(angle/pi)*1800;
|
||
FontRecord.lfEscapement := Round(angle);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
// Calculate Zero Point
|
||
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
Leading := TM.tmInternalLeading;
|
||
if angle <> 0 then begin
|
||
ap := getRelativePointbyAngle(Round(angle),Point(x1,y1),Point(x1,y1-Leading div 3));
|
||
y1 := ap.y;
|
||
x1 := ap.x;
|
||
end;
|
||
|
||
FCanvas.textout(round(x1),Round(y1),atext);
|
||
|
||
Fcanvas.Font := oldFont;
|
||
aFont.Free;
|
||
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawCover(p1, p2, p3, p4: TDoublePoint;
|
||
aColor: TColor;dConvert:Boolean);
|
||
var rgn:HRGN;
|
||
p:Array of TPoint;
|
||
rad:Double;
|
||
cp:Tpoint;
|
||
xp1,xp2:TDoublePoint;
|
||
dx: Double;
|
||
begin
|
||
rgn:= 1;
|
||
xp1 := MPoint(p1,p4);
|
||
xp2 := MPoint(p2,p3);
|
||
dx := 3;
|
||
if not dConvert then ConvertDim(dx);
|
||
xp1 := MPoint(xp1,xp2,dx);
|
||
dx := 1.5;
|
||
if not dConvert then ConvertDim(dx);
|
||
xp2 := MPoint(xp1,xp2,-dx);
|
||
Setlength(p,5);
|
||
if dConvert then begin
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
ConvertCoord(p3.x,p3.y,p3.z);
|
||
ConvertCoord(p4.x,p4.y,p4.z);
|
||
ConvertCoord(xp1.x,xp1.y,xp1.z);
|
||
ConvertCoord(xp2.x,xp2.y,xp2.z);
|
||
end;
|
||
p[0] := DP2P(p1); p[1] := DP2P(p2);
|
||
p[2] := DP2P(p3); p[3] := DP2P(p4);
|
||
p[4] := DP2P(p1);
|
||
Canvas.Brush.Style := bsClear;
|
||
Canvas.Pen.Style := psDot;
|
||
Canvas.Pen.Width := 1;
|
||
Canvas.Pen.Color := aColor;
|
||
WPolygon(p,rgn);
|
||
|
||
//cp := DP2P(MPoint(p1,p4));
|
||
rad := GetRadOfLine(p1,p4);
|
||
if EQD(rad ,pi) or EQD(rad,-pi) then rad := 0;
|
||
if EQD(rad, 3*pi/2) then rad := pi/2;
|
||
//DrawCenteredText(cp,aColor,'Muhafaza','Arial',2,rad);
|
||
{$ifdef p55}
|
||
DrawCenteredText(DP2P(xp1),aColor,'Havaland<6E>r<EFBFBD>lm<6C><6D>','Arial',2,rad);
|
||
{$endif p55}
|
||
DrawCenteredText(DP2P(xp2),aColor,'Muhafaza','Arial',2,rad);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.GetTextLens(var TextLen, TextH: Double;
|
||
atext: string; afont: Tfont; aheight, CWidth, CSpace: double);
|
||
var TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
Leading : LongInt;
|
||
ap : TPoint;
|
||
txSize: TSize;
|
||
wChar: Integer;
|
||
x1,y1,z: Double;
|
||
olDFont: TFont;
|
||
begin
|
||
ConvertDim(aHeight);
|
||
// if aheight < 4 then exit;
|
||
OldFont := Fcanvas.Font;
|
||
FCanvas.Font := aFont;
|
||
Fcanvas.Font.Height := Round(aHeight);
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(aHeight);
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
if CWidth <> 0 then begin
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
ConvertDim(CWidth);
|
||
wChar := round(CWidth);
|
||
FontRecord.lfWidth := wchar;
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
Leading := TM.tmInternalLeading;
|
||
|
||
if CSpace <> 0 then begin
|
||
ConvertDim(CSpace);
|
||
SetTextCharacterExtra(FCanvas.Handle,round(CSpace));
|
||
end;
|
||
|
||
GetTextExtentPoint(FCanvas.Handle,pchar(aText),length(aText),txSize);
|
||
TextH := txSize.cy;
|
||
TextLen := txSize.cx;
|
||
TextLen := TextLen-round(cSpace);
|
||
DeConvertDim(TextLen);
|
||
DeConvertDim(TextH);
|
||
if CSpace <> 0 then begin
|
||
SetTextCharacterExtra(FCanvas.Handle,0);
|
||
end;
|
||
Fcanvas.Font := oldFont;
|
||
end;
|
||
|
||
|
||
procedure TPCDrawEngine.DrawPatternLine(p1, p2: TDoublePoint; color,
|
||
awidth, style: integer; Pattern: TObject);
|
||
var points: TDoublePointArr;
|
||
|
||
begin
|
||
SetLength(Points,4);
|
||
points[0] := p1;
|
||
points[1] := p1;
|
||
points[2] := p2;
|
||
points[3] := p2;
|
||
DrawPatBezier(points,4,color,awidth,style,0,0,false,pattern);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawMtextToCanvas(ap1: TPoint;
|
||
atext: TstringList; afontName: String; Styles: TFontStyles;
|
||
aColor: TColor; aSize,aHeight,marX,marY,limitH: Integer;
|
||
var Region: HRGN; var tw,th: Integer; FCanvas: TCanvas);
|
||
|
||
var aFont,oldFont:TFont;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
i,k,p1,p2,p3,p4: Integer;
|
||
xp1,tp: TPoint;
|
||
tx,ty,sx,sy,lx: Integer;
|
||
xText: String;
|
||
bsh: Integer;
|
||
KeepLine: Boolean;
|
||
sqroot,bs,ts,tab: Boolean;
|
||
mText,Lines: TstringList;
|
||
txt,c,tag,etag,tx1,tx2,tx3: String;
|
||
done: boolean;
|
||
lh:Integer;
|
||
tab2: Boolean;
|
||
|
||
begin
|
||
tw := 0;
|
||
th := 0;
|
||
|
||
if (aHeight < 4) and (aSize < 4) then exit;
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := afontName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := aColor;
|
||
if aSize > 0 then
|
||
aFont.Size := aSize
|
||
else
|
||
aFont.Height := aHeight;
|
||
FCanvas.Font := aFont;
|
||
SetBkMode(Fcanvas.Handle,TRANSPARENT);
|
||
xp1 := ap1;
|
||
tab2 := false;
|
||
lh := FCanvas.TextHeight('ABC');
|
||
|
||
// Create Modified Font
|
||
//FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
ap1.x := ap1.x+marx;
|
||
ap1.y := ap1.y+mary;
|
||
tp := ap1;
|
||
sx := 0;
|
||
sy := 0;
|
||
KeepLine := False;
|
||
mtext := TstringList.Create;
|
||
lines := TstringList.Create;
|
||
for i := 0 to aText.Count-1 do
|
||
begin
|
||
xText := atext[i];
|
||
p1 := Pos('|TAB|',xText);
|
||
if p1 = 0 then p1 := Pos('|TAB2|',xText);
|
||
if p1 > 0 then begin
|
||
tx1 := Copy(xText,1,p1-1);
|
||
if Trim(tx1) <> '' then lines.Add(tx1+'|KL|');
|
||
tx2 := copy(xText,p1,Length(xText)-p1+1);
|
||
lines.Add(tx2);
|
||
end else begin
|
||
lines.Add(xtext);
|
||
end;
|
||
end;
|
||
|
||
for i := 0 to lines.Count-1 do
|
||
begin
|
||
xText := lines[i];
|
||
done := false;
|
||
repeat
|
||
p1 := Pos('<',xText);
|
||
if p1 > 0 then begin
|
||
p2 := Pos('>',xText);
|
||
if p2 > 0 then begin
|
||
tag := '<'+Copy(xText,p1+1,p2-p1-1)+'>';
|
||
eTag := '</'+Copy(xText,p1+1,p2-p1-1)+'>';
|
||
p3 := Pos(etag,xText);
|
||
if p3 > 0 then begin
|
||
if p1 > 1 then begin
|
||
tx1 := Copy(xText,1,p1-1)+'|KL|';
|
||
mText.Add(tx1);
|
||
end;
|
||
tx2 := Copy(xText,p2+1,p3-p2-1)+tag;
|
||
p4 := p3+Length(etag)-1;
|
||
if p4 < Length(xText) then begin
|
||
tx3 := Copy(xText,p4+1,Length(xText)-p4);
|
||
xText := tx3;
|
||
tx2 := tx2+'|KL|';
|
||
end else begin
|
||
done := true;
|
||
end;
|
||
mText.Add(tx2);
|
||
|
||
end else begin
|
||
mText.Add(xText);
|
||
done := true;
|
||
end;
|
||
end;
|
||
end else begin
|
||
mText.Add(xText);
|
||
done := true;
|
||
end;
|
||
until done;
|
||
end;
|
||
|
||
for i := 0 to mText.Count-1 do
|
||
begin
|
||
xText := mText[i];
|
||
FCanvas.Font.Style := Styles;
|
||
if (Pos('<B>',xText) > 0) then FCanvas.Font.Style := Styles+[fsBold];
|
||
if (Pos('<I>',xText) > 0) then FCanvas.Font.Style := Styles+[fsItalic];
|
||
if (Pos('<U>',xText) > 0) then FCanvas.Font.Style := Styles+[fsUnderline];
|
||
if (Pos('|KL|',xText) > 0) or (Pos('<KL>',xText) > 0) then KeepLine := True else KeepLine := False;
|
||
|
||
if (Pos('<sqrt>',xText) > 0) then sqroot := True else sqroot :=False;
|
||
if (Pos('|TAB|',xText) > 0) then tab := True else tab :=False;
|
||
if (Pos('|TAB2|',xText) > 0) then tab2 := True else tab2 :=False;
|
||
|
||
if (Pos('<S>',xText) > 0) then FCanvas.Font.Name := 'Symbol' else FCanvas.Font.Name := afontName;
|
||
if (Pos('<BS>',xText) > 0) then bs := True else bs := false;
|
||
if (Pos('<TS>',xText) > 0) then ts := True else ts := false;
|
||
if bs or ts then begin
|
||
if aSize > 0 then
|
||
fcanvas.Font.Size := Round(aSize*0.6)
|
||
else
|
||
fcanvas.Font.Height := Round(aHeight*0.6);
|
||
end else begin
|
||
if aSize > 0 then
|
||
fcanvas.Font.Size := aSize
|
||
else
|
||
fcanvas.Font.Height := aHeight;
|
||
end;
|
||
xText := StringReplace(xText,'<NP>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<B>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<I>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<U>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'|KL|','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<KL>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<S>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<BS>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<TS>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'<sqrt>','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'|TAB|','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'|TAB2|','',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'|grt|','>',[rfReplaceAll]);
|
||
xText := StringReplace(xText,'|sml|','<',[rfReplaceAll]);
|
||
|
||
tx := FCanvas.TextWidth(xText);
|
||
|
||
if not (bs or ts) then begin
|
||
ty := FCanvas.TextHeight(xText);
|
||
if xText = '' then ty := aHeight;
|
||
end;
|
||
if tab then tp.X := xp1.X + 40;
|
||
if tab2 then tp.X := xp1.X + 120;
|
||
if sqroot then begin
|
||
FCanvas.Pen.Color := FCanvas.Font.Color;
|
||
FCanvas.Pen.Style := psSolid;
|
||
FCanvas.Pen.Width := 1;
|
||
FCanvas.MoveTo(Round(tp.x),Round(tp.y-2+ty/2));
|
||
FCanvas.LineTo(Round(tp.x-2+ty/2),Round(tp.y-2+ty));
|
||
FCanvas.LineTo(Round(tp.x-2+ty),Round(tp.y));
|
||
FCanvas.LineTo(Round(tp.x+ty+tx+1),Round(tp.y));
|
||
FCanvas.LineTo(Round(tp.x+ty+tx+1),Round(tp.y+ty/3));
|
||
FCanvas.TextOut(Round(tp.x+ty),Round(tp.y),xText);
|
||
tx := tx+ty+2;
|
||
end else begin
|
||
bsh := 0;
|
||
if bs then bsh := Round(lh*0.4);
|
||
FCanvas.TextOut(Round(tp.x),Round(tp.y+bsh),xText);
|
||
end;
|
||
if not keepLine then
|
||
begin
|
||
tp.y := tp.y+ty+2;
|
||
tp.x := ap1.x;
|
||
lx := lx+tx;
|
||
if lx > sx then sx := lx;
|
||
sy := sy+ty+2;
|
||
lx := 0;
|
||
end else begin
|
||
tp.x := tp.x+tx+2;
|
||
|
||
lx := lx+tx+2;
|
||
if lx > sx then sx := lx;
|
||
end;
|
||
end;
|
||
sx := sx+marx;
|
||
sy := sy+mary;
|
||
tw := sx;
|
||
th := sy;
|
||
if Region = 0 then Region := CreateRectRgn(Round(xp1.x),round(xp1.y),round(xp1.x+sx),round(xp1.y+sy));
|
||
Fcanvas.Font := oldFont;
|
||
afont.Free;
|
||
mtext.Clear;
|
||
mText.Free;
|
||
Lines.Clear;
|
||
Lines.Free;
|
||
end;
|
||
|
||
Function TPCDrawEngine.SetCanvasFont(FName: String; FHeight, CWidth,
|
||
CSpace,Angle: Double; Styles: TFontStyles; Charset: Byte;FColor:TColor):TFont;
|
||
|
||
var aFont,oldFont:TFont;
|
||
TM : TTextMetric;
|
||
FontRecord : TLogFont;
|
||
begin
|
||
ConvertDim(FHeight);
|
||
|
||
oldFont := Fcanvas.font;
|
||
aFont := Tfont.Create;
|
||
aFont.Name := fName;
|
||
aFont.Style := Styles;
|
||
aFont.Color := FColor;
|
||
aFont.Charset := Charset;
|
||
FCanvas.Font := aFont;
|
||
|
||
// Set Font Height
|
||
SetBkMode(Fcanvas.Handle,TRANSPARENT);
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
// Set Font Height
|
||
FontRecord.lfHeight := Round(FHeight);
|
||
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
|
||
if angle <> 0 then begin
|
||
// Get Font Record
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
FontRecord.lfEscapement := Round(1800*(angle/pi));
|
||
// Create Modified Font
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
|
||
GetTextMetrics(FCanvas.Handle,TM);
|
||
if CWidth <> 0 then begin
|
||
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
|
||
ConvertDim(CWidth);
|
||
FontRecord.lfWidth := round(CWidth);
|
||
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
|
||
end;
|
||
|
||
if CSpace <> 0 then begin
|
||
ConvertDim(CSpace);
|
||
SetTextCharacterExtra(FCanvas.Handle,round(CSpace));
|
||
end;
|
||
|
||
result := oldFont;
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.ResetCanvasFont(oldFont: TFont);
|
||
var aFont:TFont;
|
||
begin
|
||
aFont := FCanvas.Font;
|
||
Fcanvas.Font := oldFont;
|
||
// aFont.Free;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.GDIDrawText(r1, r2,r3,r4: TDoublePoint; Text: String;
|
||
vAlign:TTextVAlign;hAlign:TTextHAlign);
|
||
var xRect,xoRect: Trect;
|
||
z:Double;
|
||
format: Integer;
|
||
Ang: Double;
|
||
begin
|
||
Ang := GetRadOfLine(r1,r2);
|
||
|
||
ConvertCoord(r1.x,r1.y,z);
|
||
ConvertCoord(r2.x,r2.y,z);
|
||
ConvertCoord(r3.x,r3.y,z);
|
||
ConvertCoord(r4.x,r4.y,z);
|
||
|
||
ang := getRadOfLine(r1,r2);
|
||
if ang <> 0 then begin
|
||
RotateCanvas(FCanvas.handle,ang);
|
||
r1 := RotatePoint(DoublePoint(0,0),r1,-ang);
|
||
r2 := RotatePoint(DoublePoint(0,0),r2,-ang);
|
||
r3 := RotatePoint(DoublePoint(0,0),r3,-ang);
|
||
r4 := RotatePoint(DoublePoint(0,0),r4,-ang);
|
||
end;
|
||
|
||
xRect := Rect(round(r1.x),round(r1.y),round(r3.x),round(r3.y));
|
||
format := 0;
|
||
|
||
Format := 0;
|
||
case VAlign of
|
||
//vtCenter : format := format or DT_VCENTER;
|
||
vtTop : format := format or DT_TOP;
|
||
//vtBottom: format := format or DT_BOTTOM;
|
||
end;
|
||
format := format or DT_TOP;
|
||
case HAlign of
|
||
htCenter : format := format or DT_CENTER;
|
||
htLeft : format := format or DT_LEFT;
|
||
htRight: format := format or DT_RIGHT;
|
||
end;
|
||
|
||
format := format or DT_WORDBREAK;
|
||
|
||
|
||
if vAlign = vtCenter then begin
|
||
xoRect := xRect; // make a 2. copy
|
||
// Compute rect of text in rect
|
||
Windows.DrawTextEx(FCanvas.Handle, Pchar(Text), -1,xoRect, format or DT_CALCRECT, nil);
|
||
// Compute the vcenter-line - half vsize
|
||
xRect.top := xRect.top + Round((xRect.bottom - xoRect.bottom )/2);
|
||
end else if vAlign = vtBottom then begin
|
||
xoRect := xRect; // make a 2. copy
|
||
// Compute rect of text in rect
|
||
Windows.DrawTextEx(FCanvas.Handle, Pchar(Text), -1,xoRect, format or DT_CALCRECT, nil);
|
||
// Compute the vcenter-line - half vsize
|
||
xRect.top := xRect.Bottom - (xoRect.bottom - xoRect.top);
|
||
|
||
end;
|
||
|
||
Windows.DrawText(FCanvas.Handle, Pchar(Text), -1, xRect,format);
|
||
if ang <> 0 then begin
|
||
ResetCanvas(FCanvas.handle)
|
||
end;
|
||
end;
|
||
|
||
procedure TPCDrawEngine.DrawFiltre(p1, p2: TDoublePoint; pColor,
|
||
bColor: TColor; Dim, Mar, Len: Double; var RegHandle: HRGN; st: Integer);
|
||
var rad,sz,h: Double;
|
||
ap1,ap2,ap3,ap4: TDoublePoint;
|
||
p: array of TPoint;
|
||
tp1,tp2,tp3,tp4,tl1,tl2,tl3,tl4,tl5,tl6: TDoublePoint;
|
||
dx,dy: Integer;
|
||
begin
|
||
sz := len;
|
||
h := dim/2;
|
||
ConvertDim(h);
|
||
ConvertDim(sz);
|
||
|
||
ConvertDim(Mar);
|
||
ConvertCoord(p1.x,p1.y,p1.z);
|
||
ConvertCoord(p2.x,p2.y,p2.z);
|
||
rad := GetRadOfLine(p1,p2);
|
||
p2 := RotatePoint(p1,p2,-rad);
|
||
p2 := DoublePoint(p2.x-sz-1-Mar,p2.y);
|
||
ap1 := DoublePoint(p2.x-sz,p2.y-h);
|
||
ap2 := DoublePoint(p2.x+sz,p2.y-h);
|
||
ap3 := DoublePoint(p2.x+sz,p2.y+h);
|
||
ap4 := DoublePoint(p2.x-sz,p2.y+h);
|
||
tp1 := ap1;
|
||
tp2 := ap2;
|
||
tp3 := ap3;
|
||
tp4 := ap4;
|
||
|
||
ap1 := RotatePoint(p1,ap1,rad);
|
||
ap2 := RotatePoint(p1,ap2,rad);
|
||
ap3 := RotatePoint(p1,ap3,rad);
|
||
ap4 := RotatePoint(p1,ap4,rad);
|
||
|
||
SetLength(p,4);
|
||
p[0] := Point(Round(ap1.x),Round(ap1.y));
|
||
p[1] := Point(Round(ap2.x),Round(ap2.y));
|
||
p[2] := Point(Round(ap3.x),Round(ap3.y));
|
||
p[3] := Point(Round(ap4.x),Round(ap4.y));
|
||
|
||
Canvas.Pen.Mode := pmCopy;
|
||
Canvas.Pen.Color := pColor;
|
||
Canvas.Brush.Style := TBrushStyle(st);
|
||
Canvas.Brush.Color := bColor;
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 2;
|
||
WPolygon(p,regHandle);
|
||
|
||
Canvas.Pen.Style := psSolid;
|
||
Canvas.Pen.Width := 1;
|
||
|
||
tl1 := MPoint(ap1,ap2);
|
||
tl2 := Mpoint(ap3,ap4);
|
||
p[0] := Point(Round(tl1.x),Round(tl1.y));
|
||
p[1] := Point(Round(tl2.x),Round(tl2.y));
|
||
DrawLinePix(p[0],p[1],0);
|
||
|
||
tl1 := MPoint(ap1,ap4);
|
||
tl2 := Mpoint(ap2,ap3);
|
||
p[0] := Point(Round(tl1.x),Round(tl1.y));
|
||
p[1] := Point(Round(tl2.x),Round(tl2.y));
|
||
DrawLinePix(p[0],p[1],0);
|
||
|
||
tl1 := MPoint(ap1,ap4);
|
||
tl1 := MPoint(ap1,tl1);
|
||
tl2 := Mpoint(ap2,ap3);
|
||
tl2 := Mpoint(tl2,ap2);
|
||
p[0] := Point(Round(tl1.x),Round(tl1.y));
|
||
p[1] := Point(Round(tl2.x),Round(tl2.y));
|
||
DrawLinePix(p[0],p[1],0);
|
||
|
||
tl1 := MPoint(ap1,ap4);
|
||
tl1 := MPoint(ap4,tl1);
|
||
tl2 := Mpoint(ap2,ap3);
|
||
tl2 := Mpoint(tl2,ap3);
|
||
p[0] := Point(Round(tl1.x),Round(tl1.y));
|
||
p[1] := Point(Round(tl2.x),Round(tl2.y));
|
||
DrawLinePix(p[0],p[1],0);
|
||
|
||
tl1 := MPoint(ap1,ap2);
|
||
tl1 := MPoint(ap1,tl1);
|
||
tl2 := Mpoint(ap3,ap4);
|
||
tl2 := Mpoint(ap4,tl2);
|
||
p[0] := Point(Round(tl1.x),Round(tl1.y));
|
||
p[1] := Point(Round(tl2.x),Round(tl2.y));
|
||
DrawLinePix(p[0],p[1],0);
|
||
|
||
tl1 := MPoint(ap1,ap2);
|
||
tl1 := MPoint(ap2,tl1);
|
||
tl2 := Mpoint(ap3,ap4);
|
||
tl2 := Mpoint(ap3,tl2);
|
||
p[0] := Point(Round(tl1.x),Round(tl1.y));
|
||
p[1] := Point(Round(tl2.x),Round(tl2.y));
|
||
DrawLinePix(p[0],p[1],0);
|
||
|
||
end;
|
||
|
||
procedure TPCDrawEngine.ClipAnd(clpRgn: HRGN);
|
||
begin
|
||
if clipRgn = 0 then ExClip := 0 else
|
||
begin
|
||
DeleteObject(ExClip);
|
||
ExClip := CreateRectRgn(0,0,0,0);
|
||
GetClipRgn(Canvas.Handle,ExClip);
|
||
end;
|
||
ExtSelectClipRgn(Canvas.Handle,clpRgn,RGN_AND);
|
||
end;
|
||
|
||
procedure TPCDrawEngine.ClipBack;
|
||
begin
|
||
Clip(ExClip);
|
||
end;
|
||
|
||
|
||
(*
|
||
procedure DrawOpacityBrush(ACanvas: TCanvas; aRect: TRect; X, Y: Integer; AColor: TColor; Opacity: Byte);
|
||
var
|
||
Bmp: TBitmap;
|
||
I, J: Integer;
|
||
Pixels: PRGBQuad;
|
||
ColorRgb: Integer;
|
||
ColorR, ColorG, ColorB: Byte;
|
||
aBlendFunc : TBlendFunction;
|
||
bmpPixels: PByteArray;
|
||
bmpR, bmpG, bmpB: Byte;
|
||
rgbRes: Byte;
|
||
|
||
//GdiGraph : TGPGraphics;
|
||
//GDIBrush : TGPSolidBrush;
|
||
begin
|
||
Bmp := TBitmap.Create;
|
||
|
||
try
|
||
Bmp.PixelFormat := pf32Bit; // needed for an alpha channel
|
||
Bmp.Width := (aRect.Right - aRect.Left);
|
||
Bmp.Height := (aRect.Bottom - aRect.Top);
|
||
|
||
// Bmp.Transparent := true;
|
||
// Bmp.TransparentColor := clGreen;
|
||
with Bmp.Canvas do
|
||
begin
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (<28><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>)
|
||
if AColor <> clFuchsia then
|
||
Brush.Color := clFuchsia // background color to mask out
|
||
else
|
||
Brush.Color := clSkYBlue;
|
||
Brush.Color := AColor;
|
||
|
||
ColorRgb := ColorToRGB(Brush.Color);
|
||
ColorR := GetRValue(ColorRgb);
|
||
ColorG := GetGValue(ColorRgb);
|
||
ColorB := GetBValue(ColorRgb);
|
||
|
||
// must pre-multiply the pixel with its alpha channel before drawing
|
||
ColorR := (ColorR * Opacity) div $FF;
|
||
ColorG := (ColorG * Opacity) div $FF;
|
||
ColorB := (ColorB * Opacity) div $FF;
|
||
|
||
Brush.Color := RGB(ColorR, ColorG, ColorB);
|
||
|
||
FillRect(Rect(0,0,Bmp.Width,Bmp.Height));
|
||
{Pen.Color := AColor;
|
||
Pen.Style := psSolid;
|
||
Pen.Width := aRect.Bottom - aRect.Top;
|
||
}
|
||
//MoveTo(0,0);
|
||
//LineTo(0,(aRect.Right - aRect.Left));
|
||
// MoveTo(ASize div 2, ASize div 2);
|
||
// LineTo(ASize div 2, ASize div 2);
|
||
end;
|
||
Bmp.Canvas.Refresh;
|
||
{
|
||
bmp.Canvas.Brush.Color:= aColor;// clBlue;
|
||
bmp.Canvas.Pen.Width := 1;
|
||
bmp.Canvas.Pie(55,55, 200,200, 200,0, 0,0);
|
||
//bmp.Canvas.FloodFill(90,90, clBlack, fsBorder);
|
||
}
|
||
|
||
for I := 0 to Bmp.Height-1 do
|
||
begin
|
||
Pixels := PRGBQuad(Bmp.ScanLine[I]);
|
||
for J := 0 to Bmp.Width-1 do
|
||
begin
|
||
with Pixels^ do
|
||
begin
|
||
rgbReserved := Opacity;
|
||
end;
|
||
Inc(Pixels);
|
||
end;
|
||
end;
|
||
|
||
{ for I := 0 to Bmp.Height-1 do
|
||
begin
|
||
Pixels := PRGBQuad(Bmp.ScanLine[I]);
|
||
for J := 0 to Bmp.Width-1 do
|
||
begin
|
||
with Pixels^ do
|
||
begin
|
||
if (rgbRed = ColorR) and (rgbGreen = ColorG) and (rgbBlue = ColorB) then
|
||
rgbReserved := 0
|
||
else
|
||
rgbReserved := Opacity;
|
||
// must pre-multiply the pixel with its alpha channel before drawing
|
||
rgbRed := (rgbRed * rgbReserved) div $FF;
|
||
rgbGreen := (rgbGreen * rgbReserved) div $FF;
|
||
rgbBlue := (rgbBlue * rgbReserved) div $FF;
|
||
end;
|
||
Inc(Pixels);
|
||
end;
|
||
end;
|
||
}
|
||
|
||
//end;
|
||
DrawAlphaAPI(bmp, ACanvas, x, y, Opacity);
|
||
finally
|
||
Bmp.Free;
|
||
end;
|
||
(*
|
||
|
||
bmp.PixelFormat := pf32Bit;
|
||
Bmp.Width := (aRect.Right - aRect.Left);
|
||
Bmp.Height := (aRect.Bottom - aRect.Top);
|
||
bmp.HandleType := bmDIB;
|
||
bmp.ignorepalette := true;
|
||
//bmp.alphaformat := afPremultiplied;
|
||
|
||
ColorRgb := ColorToRGB(AColor);
|
||
ColorR := GetRValue(ColorRgb);
|
||
ColorG := GetGValue(ColorRgb);
|
||
ColorB := GetBValue(ColorRgb);
|
||
|
||
GdiGraph := TGPGRaphics.Create(bmp.Canvas.Handle);
|
||
|
||
GDiBrush := TGPSolidBrush.Create(GdiPapi.MakeColor(Opacity, ColorR, ColorG, ColorB));
|
||
GdiGraph.FillRectangle(GDIBrush, GdiPapi.MakeRect(0,0,Bmp.Width, bmp.Height));
|
||
GDIBrush.Free;
|
||
GdiGraph.Free;
|
||
// BitBlt(ACanvas.Handle, x, y, bmp.Width, bmp.Height, bmp.Canvas.Handle, 0, 0, srcCopy);
|
||
//aCanvas.CopyRect(Rect(x,y,Bmp.Width + x, Bmp.Height + y), Bmp.Canvas, Rect(0,0,Bmp.Width, Bmp.Height));
|
||
DrawAlphaAPI(bmp, ACanvas, x, y, Opacity);
|
||
Bmp.Free;
|
||
*)
|
||
(*
|
||
end;
|
||
*)
|
||
procedure TPCDrawEngine.FillRect(rect: TDoubleRect; bc, bs: Integer; aTransParency: Integer = 0);
|
||
var xRect: TRect;
|
||
z: Double;
|
||
begin
|
||
if aTransParency = 100 then
|
||
exit;
|
||
FCanvas.brush.color := bc;
|
||
FCanvas.brush.style := TBrushStyle(bs);
|
||
//DrawOpacityBrush(FCanvas, Round(rect.Left), Round(rect.top), clGreen, Round(rect.right - rect.Left), 120);
|
||
ConvertCoord(rect.left,rect.top,z);
|
||
ConvertCoord(rect.right,rect.bottom,z);
|
||
xRect := Classes.Rect(Round(rect.Left),Round(rect.top),Round(rect.right),Round(rect.bottom));
|
||
// Tolik 24/06/2017 --
|
||
//if aTransParency = 0 then
|
||
//
|
||
if aTransParency = 0 then
|
||
Windows.FillRect(FCanvas.Handle,xrect,FCanvas.Brush.Handle)
|
||
else
|
||
//DrawOpacityBrush(FCanvas, ABS(xRect.Right - xRect.Left), Round(rect.Left), Round(rect.top), FCanvas.brush.color, ABS(xRect.Bottom - xRect.Top), 120);
|
||
//DrawOpacityBrush(FCanvas, ABS(xRect.Right - xRect.Left), Round(rect.Left), Round(rect.top), FCanvas.brush.color, ABS(xRect.Bottom - xRect.Top), 255 - Round(aTransparency*2.55));
|
||
|
||
// Tolik 03/11/2017 -- <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> 200 000 000, <20> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> (<28><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ), <20><><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
// DrawOpacityBrush(FCanvas, xRect, Round(rect.Left), Round(rect.top), FCanvas.brush.color, Byte( 255 - Round(aTransparency*2.55)) )
|
||
begin
|
||
|
||
// if ((Rect.Right - Rect.Left ) * (Rect.Bottom - Rect.Top) * 4) < 200000000 then
|
||
try
|
||
DrawOpacityBrush(FCanvas, xRect, Round(rect.Left), Round(rect.top), FCanvas.brush.color, Byte( 255 - Round(aTransparency*2.55)) )
|
||
except
|
||
on E: exception do
|
||
Windows.FillRect(FCanvas.Handle,xrect,FCanvas.Brush.Handle);
|
||
end;
|
||
end;
|
||
end;
|
||
|
||
|
||
function TPCDrawEngine.ExtCreatePenMy(aCanva: TCanvas): HPEN;
|
||
//01.11.2011 const
|
||
//01.11.2011 PenStyles: array[TPenStyle] of Word =
|
||
//01.11.2011 (PS_SOLID, PS_DASH, PS_DOT, PS_DASHDOT, PS_DASHDOTDOT, PS_NULL,
|
||
//01.11.2011 PS_INSIDEFRAME);
|
||
var
|
||
LogPen: TLogPen;
|
||
lb: TLogBrush;
|
||
i: Integer;
|
||
aHan: HPEN;
|
||
aPrinting: Boolean;
|
||
Styles: array[0..3] of Integer;
|
||
OldMode: integer;
|
||
|
||
Begin
|
||
result := aCanva.Pen.Handle;
|
||
//01.11.2011 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
|
||
//aPrinting := False;
|
||
//try
|
||
// if aCanva.Handle = Printer.Canvas.Handle then
|
||
// begin
|
||
// if FDeviceName <> Printer.Printers[Printer.PrinterIndex] then
|
||
// GetDeviceSettings;
|
||
// aPrinting := True;
|
||
// end;
|
||
//except
|
||
//end;
|
||
aPrinting := FPrinting;
|
||
|
||
if aPrinting then
|
||
begin
|
||
with LogPen do
|
||
try
|
||
begin
|
||
lopnStyle := Ord(ExtPenStyles[FCanvas.Pen.Style]);
|
||
lopnWidth.X := FCanvas.Pen.Width;
|
||
lopnColor := ColorToRGB(FCanvas.Pen.Color);
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
// if (FCanvas.Pen.Style = psSolid) or (FCanvas.Pen.Style = psDash) or (FCanvas.Pen.Style = psDot) then
|
||
begin
|
||
oldMode := -1;
|
||
oldMode := SetMapMode (FCanvas.Handle, MM_ANISOTROPIC);
|
||
SetWindowExtEx (FCanvas.Handle, GetDeviceCaps(FCanvas.Handle, LOGPIXELSX), GetDeviceCaps(FCanvas.Handle, LOGPIXELSY), Nil);
|
||
SetViewportExtEx (FCanvas.Handle, GetDeviceCaps(FCanvas.Handle, LOGPIXELSX), GetDeviceCaps(FCanvas.Handle, LOGPIXELSY), Nil);
|
||
|
||
lb.lbStyle := BS_SOLID;
|
||
lb.lbColor := ColorToRGB(FCanvas.Pen.Color);
|
||
lb.lbHatch := 0;
|
||
aHan := ExtCreatePen(PS_GEOMETRIC or lopnStyle or
|
||
PS_ENDCAP_SQUARE or PS_JOIN_MITER, Round(FCanvas.pen.width * FPixelsPerMMY / 3.3 ),lb, 0, nil);
|
||
result := aHan;
|
||
|
||
if OldMode > 0 then
|
||
SetMapMode (FCanvas.Handle, OldMode) ;
|
||
end;
|
||
(*
|
||
if (FCanvas.Pen.Style = psDash) then
|
||
begin
|
||
lb.lbStyle := BS_SOLID;
|
||
lb.lbColor := ColorToRGB(FCanvas.Pen.Color);
|
||
lb.lbHatch := 0;
|
||
Styles[0] := Round(18 * FPixelsPerMMY / 5.8 );
|
||
Styles[1] := Round(6 * FPixelsPerMMY / 5.8 );
|
||
Styles[2] := Round(18 * FPixelsPerMMY / 5.8 );
|
||
Styles[3] := Round(6 * FPixelsPerMMY / 5.8 );
|
||
aHan := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE or lopnStyle or
|
||
PS_ENDCAP_FLAT or PS_JOIN_MITER {PS_JOIN_BEVEL}, Round(FCanvas.pen.width * FPixelsPerMMY / 3.3 ),lb, 4, @Styles[0]);
|
||
result := aHan;
|
||
end;
|
||
if (FCanvas.Pen.Style = psDot) then
|
||
begin
|
||
lb.lbStyle := BS_SOLID;
|
||
lb.lbColor := ColorToRGB(FCanvas.Pen.Color);
|
||
lb.lbHatch := 0;
|
||
Styles[0] := Round(3 * FPixelsPerMMY / 5.8 );
|
||
Styles[1] := Round(3 * FPixelsPerMMY / 5.8 );
|
||
Styles[2] := Round(3 * FPixelsPerMMY / 5.8 );
|
||
Styles[3] := Round(3 * FPixelsPerMMY / 5.8 );
|
||
aHan := ExtCreatePen(PS_GEOMETRIC or PS_USERSTYLE or lopnStyle or
|
||
PS_ENDCAP_FLAT or PS_JOIN_MITER {PS_JOIN_BEVEL}, Round(FCanvas.pen.width * FPixelsPerMMY / 3.3 ),lb, 4, @Styles[0]);
|
||
result := aHan;
|
||
end;
|
||
*)
|
||
end
|
||
else
|
||
begin
|
||
result := CreatePenIndirect(LogPen);
|
||
end;
|
||
end;
|
||
except
|
||
end;
|
||
end
|
||
else
|
||
begin
|
||
Result := ExtractExtPenByCanvas;
|
||
//01.11.2011
|
||
//with LogPen do
|
||
// try
|
||
// begin
|
||
// lopnStyle := ExtPenStyles[FCanvas.Pen.Style];
|
||
// lopnWidth.X := FCanvas.Pen.Width;
|
||
// lopnColor := ColorToRGB(FCanvas.Pen.Color);
|
||
// if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width>1) then
|
||
// begin
|
||
// lb.lbStyle := BS_SOLID;
|
||
// lb.lbColor := ColorToRGB(FCanvas.Pen.Color);
|
||
// lb.lbHatch := 0;
|
||
// aHan := ExtCreatePen(PS_GEOMETRIC or lopnStyle or
|
||
// PS_ENDCAP_SQUARE or PS_JOIN_MITER {PS_JOIN_BEVEL}, FCanvas.pen.width ,lb, 0, nil);
|
||
// result := aHan;
|
||
// end
|
||
// else
|
||
// begin
|
||
// result := CreatePenIndirect(LogPen);
|
||
// end;
|
||
// end;
|
||
// except
|
||
// end;
|
||
end;
|
||
end;
|
||
|
||
|
||
initialization
|
||
{$ifdef demo}
|
||
if not delphiloaded then application.terminate;
|
||
{$endif demo}
|
||
end.
|
||
|
||
(*
|
||
hPenOld: HPEN;
|
||
hPen1: HPEN;
|
||
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) and (FCanvas.Pen.Style <> psSOlid) and (FCanvas.Pen.Style <> psClear) then
|
||
if (FCanvas.Pen.Mode <> pmXor) and (FCanvas.Pen.width > 1) then
|
||
begin
|
||
hPen1 := ExtCreatePenMy(FCanvas);
|
||
hPenOld := SelectObject(FCanvas.Handle, hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
|
||
//
|
||
|
||
SelectObject(FCanvas.Handle, hPenOld); //<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
|
||
DeleteObject(hPen1);//<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>
|
||
end
|
||
else
|
||
begin
|
||
end;
|
||
*)
|