admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-11 22:45:39 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/POWERCAD30/UNITS/DrawEngine.pas
Anatoly d7204c6898 First_commit
2025-05-13 16:51:40 +03:00

8306 lines
254 KiB
ObjectPascal
Raw Blame History

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;
*)
Reference in New Issue View Git Blame Copy Permalink