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/DrawObjects.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

25988 lines
748 KiB
ObjectPascal
Raw Blame History

unit DrawObjects;
interface
uses SysUtils, WinTypes, WinProcs, Messages,
Classes, Controls, Forms, Dialogs,ExtCtrls,comctrls,buttons,stdctrls,extdlgs,
windows,math,PCTypesUtils,Graphics,DrawEngine,
U_Common_Classes, Menus,RichForm,RichEdit2,OleCtnrs,rrEllipses, LibJpeg, inputForm,GUIStrings,magwand, {Tolik 24/05/2019 -- } RichEdit,
{GDIPlus, GDIPAPI,} GDIPOBJ, U_RasterImageSettings
{$IF Not Defined (FINAL_SCS)}
// , GDIPUTIL
{$IFEND }
;
Type
TRoomConfig = Packed record
aWorkRoom: Boolean;
aPlenumArea: Boolean;
aUnroutableArea: Boolean;
IsCabinetExt: Boolean;
POintCount: Integer;
CabinetNumPos: Integer;
CabinetSignPos: Integer;
NumRadius: Integer;
end;
// Tolik
TPieCutStyle = (PieLinearCut, PieArcCut); // òèï îáðåçêè ñåêòîðà îò öåíòðà
//
ProomConfig = ^TRoomConfig;
TLayer = class;
TPattern = class;
TVector = class;
TFigure = class;
TFigureGrp = class;
TPolyline = class;
TFigMoveEvent = Procedure (Sender: TFigure;dx,dy:integer) of object;
//Tolik
TRegionObject = Class;
// Tolik 24/12/2019 --
//TModPoint = class (TObject)
TModPoint = class (TMyObject)
//
CoordX : Double;
CoordY : Double;
CoordZ : Double;
SeqNbr : integer;
PType : TModPointType;
DType : TPointType;
Figure : TFigure;
Color : TColor;
Dim : Double;
PixX: integer;
PixY: integer;
PixDetX:Integer;
PixDetY:Integer;
Tag: Integer;
Obj1: LongInt;
Obj2: LongInt;
Obj3: LongInt;
Obj4: LongInt;
OnlyIso: Boolean;
isBlink:Boolean;
isDraw:Boolean;
//FIsDrag: Boolean;
Constructor Create(aFigure: TFigure; aType: TModPointType; aDType: TPointType;
aColor: TColor; aDim, X,Y: Double; aSeqNbr: integer; Z: Double=0);
Function IsPointIn(x,y,pdim: Double):Boolean;
Function IsPointInInt(x,y,pdim: Integer):Boolean;
Function IsPointInDetInt(x,y,pdim: Integer):Boolean;
//Tolik
Destructor Destroy; override;
end;
TLayer = class (tobject)
name : string[255];
ModPoints : TList;
visible: TShow;
DrawEngine: TPCDrawEngine;
Data: TObject;
vertZero: integer;
horzZero: integer;
PenColor : TColor;
BrushColor: TColor;
TextColor : TColor;
Description: String;
Tag: Integer;
LayerWidth: Integer;
LayerHeight: Integer;
IsDxf: boolean;
tmpVisible: TShow;
constructor create(aname:string);
destructor Destroy;
Procedure WriteToStream(stream:TStream;CadControl:TObject);
class Function CreateFromStream(Stream:TStream; aDEngine: TPCDrawEngine;CadControl:Tobject):TLayer;
Procedure SetLayerPropertyInt(xCode:Byte; Value:Integer);
Procedure SetLayerPropertyStr(xCode:Byte; Value:String);
Procedure SetLayerPropertyDbl(xCode:Byte; Value:Double);
Procedure SetLayerPropertyStream(xCode:Byte; Stream:TStream;CadControl:TObject);
end;
//Tolik
TRegionObject = class(TMyObject)
protected
public
RegObjOwner: TFigure;
CheckPointByRects: Boolean;
RegObjDataLength: Cardinal;
RegObjData: PRgnData;
//RegObjData: Pointer; // çäåñü áóäåò ñèäåòü âñå îïèñàíèå ðåãèîíà (ó íåãî æå è óêðàäåì, ïðåæäå, ÷åì óáèòü)
//RectArray: array of TRect;
procedure GetRegData(RegObjHandle: HRGN);
constructor create(RegionObjectOwner: TFigure);
destructor destroy; override;
end;
//
TFigureClass = class of TFigure;
TFigureFill = class(TMyObject)
public
Owner: TFigure;
Step: Double;
TxtSize: Integer;
FillType: TFillType;
HatchStyle: THatchStyle;
GradStyle: TGradStyle;
TextureStyle: TTextureStyle;
Color: TColor;
BackColor: TColor;
Grp: TFigureGrp;
PenStyle: TPenStyle;
PenWidth: Integer;
GradBmp: TBitmap;
TxtBmp: TBitmap;
Empty: Boolean;
UseBack: Boolean;
Procedure Move(dx,dy:Double);
Procedure Rotate(Angle:Double;cPoint:TDoublePoint);
Procedure Scale(px,py:Double;rPoint:TDoublePoint);
Procedure SetPen(pStyle:TPenStyle;pWidth:Integer);
Procedure SetStyle(FType:TFillType;Data:Integer);
Procedure SetColor(FColor:TColor);
Procedure SetBackColor(BColor:TColor);
Procedure SetTextSize(TxSize:Integer);
Procedure SetHatchStep(FStep:Double);
Procedure Clear;
Constructor Create(AOwner:TFigure;FStep:Double;FType:TFillType;Data:Integer);
Destructor Destroy; override;
Procedure SetSubData(Data:Integer);
Procedure ReGenerate;
Procedure BuildHatch;
Procedure BuildGradient;
Procedure BuildTexture;
Procedure Draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
end;
TFigure = class(TMyObject)
private
fLockModify: Boolean;
fLockMove: Boolean;
fLockSelect: Boolean;
fDiagonal: Boolean;
fIncombined: Boolean;
procedure SetInCombined(const Value: Boolean);virtual;
Protected
FOnMouseDownMacro: String;
FOnModifiedMacro: String;
FOnMouseUpMacro: String;
FBeforeDeleteMacro: String;
FOnDblClickMacro: String;
FOnMoveMacro: String;
FOnClickMacro: String;
originals :TDoublePointArr;
actuals :TDoublePointArr;
// Tolik 24/12/2019 --
//SelPoints: TList;
SelPoints: TMyList;
//
MenuIndex: Integer;
OldStyleLoad: Boolean;
fTempPoints: array of TPoint;
fPointEvent: Boolean;
CreateDims: Boolean;
Function GdiBrs:Integer;
Function GetAp1: TDoublePoint;virtual;
Function GetAp2: TDoublePoint;virtual;
Function GetAp3: TDoublePoint;virtual;
Function GetAp4: TDoublePoint;virtual;
function getCp: TDoublePoint;
Procedure GetPointArray(var Arr:TDoublePointArr);overload;
Procedure GetPointArray(var Arr:TDoublePointArr;Count: Integer);overload;
Function GetOrig(index: integer): TDoublePoint;
Procedure SetOrig(index: integer; xpoint: TDoublePoint);
Function GetActual(index: integer): TDoublePoint;
Procedure SetActual(index: integer; xpoint: TDoublePoint);
Function GetPoint(index: integer): TDoublePoint;
Procedure SetPoint(Index: integer; const Value: TDoublepoint);
Function GetP1: TDoublePoint;
Procedure GetRotatePoints(ModList: TList);virtual;
Procedure GetRegionPoints(var points: array of TDoublePoint);virtual;
Procedure CreateDimLinesFromStream(xStream:TStream;LHandle:Integer;Owner:TComponent);
Procedure OnNewPoint;virtual;
Procedure ClearPoints;
Procedure RedimenPoints;
Function NeedRegion:Boolean;
Property InCombined: Boolean read fIncombined write SetInCombined;
public
Fill: TFigureFill;
DragMove: Boolean;
Shift: TShiftState;
OnModified: TnotifyEvent;
UserClass:String;
Name: String;
Cname: String;
AngletoPoint : Double;
RotPoint : TDoublePoint;
DrawStyle : PCTypesUtils.TDrawStyle;
Modified : Boolean;
Selected : Boolean;
FirstSelected : Boolean;
SelectedPoint:Integer;
IsOp : Boolean;
Deleted : Boolean;
Radius : Double;
RMode:Boolean;
vertZero: integer;
horzZero: integer;
Icon: TBitmap;
IconX,IconY: Double;
IconVertPos: TIconVertPos;
IconHorzPos: TIconHorzPos;
Urc: Integer; // Undo recorded Count //internal use only
JoinedFigures: TList;
SelOrder: Integer;
DelIndex: Integer;
TracePoint:TModPoint;
IsDrawingDetail: Boolean;
DimLines:TList;
EditX: Double;
EditY: Double;
PopStyle: TFigurePopStyle;
CustomPops: String;
Visible:Boolean;
ClipFigures: TList;
NativeFill: Boolean;
InClip: Boolean;
NotNeedToDraw: Boolean;
FClassIndex: ShortInt;
InsideCabinet: Boolean;
Function IsPointInRegion(x,y: Double): Boolean;overload;
Function IsPointInRegion(x,y: Double;reg:Integer): Boolean;overload;
//Tolik
Function IsPointInRegionByRegObj(x,y: Double): Boolean;overload; // ïîïàäåò ëè òî÷êà â ðåãèîí
Function IsPointInRegionByRegObj(x,y: Double; RegObj: TRegionObject): Boolean;overload; // ïîïàäåò ëè òî÷êà â ðåãèîí
function ptInRegionByRegObj(x,y: Double; RegObj: TRegionObject): Boolean; // òèïà âìåñòî ptInRegion (Tolik)
Function GetRegionBox(var r: TRect): Integer; // âåðíåò ãðàíèöû ðåãèîíà (ïðÿìîóãîëüíèê èëè 0, åñëè íå÷åãî âåðíóòü)
Procedure ResetRegObject; // ñáðîñ äàííûõ î ðåãèîíå
procedure GetRegObject; // ïîëó÷åíèå äàííûõ î ðåãèîíå
//
Procedure ClearClipFigures;
Procedure MoveClipFigures(deltax,deltaY:Double);
Procedure RefreshHatch;
Procedure Unfilled;virtual;
Procedure OnFigureModified;virtual;
Procedure ClearDimLines;virtual;
Procedure CreateDimLines;virtual;
//Procedure GetModPoints(ModList: TList);virtual;
procedure getModPoints(ModList: TMyList);virtual;
Function Offset(Thick:Double):TFigure;virtual;
Procedure ClearBounds;
Function GetClassName:String;virtual;
Procedure VerifyZeroPoints(orgV,orgH:Byte);virtual;
Class Function ShadowType:TShadowType;virtual;
Class Function IsOneClick:Boolean;virtual;
Class Function InsideSelection:Boolean;virtual;
Procedure Initialize;virtual;
Function Rename:String;virtual;
Function Edit: Boolean;virtual;
Procedure SelectPoint(Modpoint:TModPOint);virtual;
Procedure DeSelectPoint(Modpoint:TModPOint);virtual;
Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;virtual;
Procedure GetBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);virtual;
Procedure getboundsWithoutGrpSize(var figMaxX,figMaxY,figMinX,figMinY: Double);virtual;abstract;
Procedure GetSelBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);virtual;
Procedure UpdateBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);virtual;
Procedure GetIsometricBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);virtual;
Procedure GetRegionBounds(var figMaxX,figMaxY,figMinX,figMinY: Double);virtual;
Function GetBoundRect(UseGRpSize: boolean):TDoubleRect;overload;
Function GetBoundRect:TDoubleRect;overload;virtual;
Procedure Move(deltax, deltay: Double);virtual;
Procedure Rotate(aAngle: Double);overload;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);overload;virtual;
Procedure Mirror(Point1,Point2: TDoublePoint);virtual;
Procedure Scale(px,py: Double);overload;
Procedure Scale(px,py: Double; rPoint: TDoublepoint);overload;virtual;
Procedure ModifySelection(mm: TModifyMode; value: Integer);virtual;
Function ModifyTextAndFont(mm: TModifyMode; valueI: Double; valueS:string; valueSt: TFontStyles; ValueB:Boolean):Boolean;virtual;
Function IsPointIn(x,y:Double): boolean; virtual;
Function IsPointInInt(x,y:Integer): boolean; virtual;
Function CheckifInArea(area: TDoubleRect): Boolean;
Function Duplicate: TFigure; virtual;
Procedure CopyProperties(Figure:TFigure);virtual;
procedure Draw(DEngine: TPCDrawEngine;isGrayed:Boolean);virtual;
procedure DrawDimLines(DEngine: TPCDrawEngine;isGrayed:Boolean);virtual;
procedure DrawDetail(DEngine: TPCDrawEngine;DetailStyle:TDetailStyle);virtual;
Procedure CollectFaces(Faces:Tlist);Virtual;
procedure DrawRotTrace(DEngine: TPCDrawEngine;isGrayed:Boolean);
procedure ResetRegion;virtual;
procedure SetModified;virtual;
Procedure Select;Virtual;
Procedure Deselect;Virtual;
Procedure ReSelect;Virtual;
Procedure ReSelectUnsel;Virtual; //02.04.2012
Procedure ReSelectSel;Virtual; //02.04.2012
Procedure RotateSelect;Virtual;
Procedure SetHatch(HStyle:THatchStyle;ForeColor,BackColor:TColor;StepSize:Double);virtual;
Procedure SetGradient(GStyle:TGradStyle;ForeColor,BackColor:TColor);virtual;
Procedure SetTexture(TStyle:TTextureStyle;TexSize:Integer);virtual;
Procedure DrawFill(DEngine: TPCDrawEngine;isGrayed:Boolean);Virtual;
Procedure DrawClipFigures(DEngine: TPCDrawEngine;isGrayed:Boolean);Virtual;
Procedure DrawSelPoint(DEngine: TPCDrawEngine;isGrayed:Boolean;mp:TModPoint);
Procedure DrawSelectionPoints(DEngine: TPCDrawEngine;isGrayed:Boolean);virtual;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);virtual;
Procedure DrawFigureGuidesInDetail(DEngine: TPCDrawEngine;DetailStyle:TDetailStyle);virtual;
Constructor Create(LHandle:LongInt; aDrawStyle:PCTypesUtils.TDrawStyle; aOwner: TComponent);
class Function CreateFromStream(Stream: TStream; LHandle:LongInt;
aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent): TFigure;
Class Function CreateFromShadow(aOwner:TComponent;LHandle:LongInt;Shadow:TFigure):TFigure;virtual;
Destructor Destroy;override;
class Function CreateShadow(x,y:Double): TFigure;virtual;
Function ShadowClick(ClickIndex: Integer; x,y: Double):Boolean;virtual;
Function ShadowTrace(ClickIndex: Integer; x,y: Double):Boolean;virtual;
Function ShadowKeyStroke(var ClickIndex,KeyCode:Integer;Shift:TShiftState;var Fnished:Boolean):Boolean;virtual;
Function CreateModification: TFigure;virtual;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;
x,y:Double;Shift: TShiftState):boolean;virtual;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;
x,y:Double;Shift: TShiftState):boolean;virtual;
Function TraceRotate(CadControl: Pointer;mp:TModPoint;var TraceFigure:TFigure;
x,y:Double;Shift: TShiftState):boolean;virtual;
Function EndRotate(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;
x,y:Double;Shift: TShiftState):boolean;virtual;
Function GetStartPoint:TDoublePoint;virtual;
Function GetEndPoint:TDoublePoint;virtual;
Function IsWelded(f:Tfigure): Integer;
Procedure ShowProperties;virtual;
Procedure PropUpdate(PropName,PropVal:String);virtual;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);virtual;
Procedure MenuClicked(commandId:integer);virtual;
Procedure WriteToStream(Stream:TStream);virtual;
Procedure SetPropertiesFromStream(Stream: TStream);
Procedure SetSpecialPropertiesFromStream(Stream: TStream);virtual;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);virtual;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);virtual;
Procedure SendSignal(port:Integer;value:Integer);virtual;
Function DuplicateAsBezier:TFigure;virtual;
Function DuplicateAsStroke:TFigure;virtual;
Function isVisible:Boolean;
Function Knife(p1,p2:TdoublePoint;Figures:TList):Boolean;virtual;
Function BreakbyPoints(p:TdoublePointArr;var Figures:TList):boolean;virtual;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;virtual;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;virtual;
Function GetZAvg(dRect:TDoubleRect;var fAvg:Double):Boolean;virtual;
Function GetLength:Double;virtual;
Function GetArea: Double;virtual;
Property OriginalPoints[Index : integer]:TDoublepoint read GetOrig write SetOrig;
Property ActualPoints[Index : integer]:TDoublepoint read GetActual write SetActual;
Property ap1: TDoublePoint read getAp1;
Property ap2: TDoublePoint read getAp2;
Property ap3: TDoublePoint read getAp3;
Property ap4: TDoublePoint read getAp4;
Property CenterPoint:TDoublePoint read getCp;
(*
Property OnMoveMacro: String read FOnMoveMacro write FOnMoveMacro;
Property OnMouseDownMacro: String read FOnMouseDownMacro write FOnMouseDownMacro;
Property OnMouseUpMacro: String read FOnMouseUpMacro write FOnMouseUpMacro;
Property OnClickMacro: String read FOnClickMacro write FOnClickMacro;
Property OnDblClickMacro: String read FOnDblClickMacro write FOnDblClickMacro;
Property OnModifiedMacro: String read FOnModifiedMacro write FOnModifiedMacro;
Property BeforeDeleteMacro: String read FBeforeDeleteMacro write FBeforeDeleteMacro;
*)
public
Handle: TFigHandle;
ID: Integer;
DataID: integer;
LayerHandle: LongInt;
Owner: TComponent;
width: integer;
color: integer;
Style: integer;
RowStyle : Integer;
Angle: Double;
Brc,Brs : integer;
ExHatchStyle :THatchStyle;
ExGradStyle :TGradStyle;
ExTextureStyle :TTextureStyle;
ExFillBackColor:TColor;
ExHatchStepSize: Double;
ExTextureSize: Integer;
PointCount: integer;
RegHandle : HRGN;
//Tolik
RegObject: TRegionObject;
// Tolik -- 26/05/2017 -- ïðîöåíò ïðîçðà÷íîñòè äëÿ çàëèâêè ôèãóðû
// ïî óìîë÷àíèþ âûñòàâèì â 0 òèïà == 0% ïðîçðà÷íîñòè
Transparency: integer;
isAutoCreatedFigure: Byte; // Tolik -- 30/05/ 2017 -- åñëè ôèãóðà ñîçäàíà àâòîìàòè÷åñêè = 1 èíà÷å = 0
//
id_for_dellist: Integer;
Data: Pointer;
CustomStream: TStream;
Info:String;
FullHitTest: Boolean;
DrawInfo: Boolean;
FBoundRect: TDoubleRect; //31.10.2011
FIsLoadedBounds: Boolean; //31.10.2011
Parent: TFigure;//28.04.2011
FBeforeAllScale: TNotifyEvent; //27.05.2011
FAfterAllScale: TNotifyEvent; //27.05.2011
//FAfterScalingBeforeEvents: TNotifyEvent; //23.09.2011 - Ñîáûòèå ïîñëå Scale âñåõ îáúåêòîâ è ïåðåä FScaleAllEvent
FScaleAllEvent: TNotifyEvent; //27.05.2011
FBeforeDelFromParent: TNotifyEvent; //22.09.2011 - âûçûâàåòñÿ ïåðåä free èç ãðóïïû
FAfterUndo: TNotifyEvent; //23.09.2011 - âûçûâàåòñÿ ïîñëå undo âñåõ îáúåêòîâ
Property FigurePoints[Index : integer]:TDoublepoint read GetPoint write SetPoint;
Property LockMove: Boolean read fLockMove write fLockMove;
Property LockSelect: Boolean read fLockSelect write fLockSelect;
Property LockModify: Boolean read fLockModify write fLockModify;
Property DiagonalScale: Boolean read fDiagonal write fDiagonal;
function GetModPointBySeqNbr(ANbr: Integer; x, y: Double): TModPoint;
end;
TFigureGrp = class(TFigure)
private
procedure SetCombined(const Value: Boolean);
protected
procedure SetInCombined(const Value: Boolean);override;
public
FMetafile: TMetafile;
InFigures: TList;
bDeltaX,bDeltaY: double;
Changed: Boolean;
FCombined: Boolean;
FReLoad: Boolean;
UnGrouped: Boolean;
LoadIdx: Integer;
AlwaysTogether: Boolean;
UseMetafile: Boolean;
BoundCalc : Boolean;
DimLocked: Boolean;
Mirrored: Boolean;
DrawRatio: Double;
// Tolik 27/06/2017 --
HasAutocreatedFigures: Boolean;
//
Procedure SetHatch(HStyle:THatchStyle;ForeColor,BackColor:TColor;StepSize:Double);override;
Procedure SetGradient(GStyle:TGradStyle;ForeColor,BackColor:TColor);override;
Procedure SetTexture(TStyle:TTextureStyle;TexSize:Integer);override;
Procedure Unfilled;override;
Function Edit:Boolean;override;
Procedure Initialize;override;
Function Rename:string;override;
procedure ResetRegion;override;
procedure SetModified;override;
Procedure UnGroup;
Procedure SetFieldText(FName, FValue: String);
Procedure ReplaceTextWithWMF(FName: String; mf:TMEtafile);
Procedure RemoveInFigure(FName: String);
Procedure AddFigure(fig: TFigure; AResetReg: Boolean=true);
// Tolik -- 22/08/2017 --
Procedure InsertFigure(fig: TFigure; AResetReg: Boolean = True);
//
Procedure CreateMetaFile;
Procedure ClearFigureList;
constructor create(LHandle: LongInt;aOwner: TComponent);
Procedure DestroyInFigures;
Destructor Destroy;override;
Destructor DestroyGrp;
procedure move(deltax, deltay: double);override;
procedure draw(DEngine: TPCDrawEngine; isGrayed: Boolean);override;
Procedure DrawInFigures(DEngine: TPCDrawEngine; isGrayed:Boolean);
Procedure SetOwnerProps;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y: double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
procedure getInbounds(var figMaxX,figMaxY,figMinX,figMinY: double);
// Tolik 29/06/2017 --
procedure GetBoundsWithoutAutoCreatedFigures(var figMaxX,figMaxY,figMinX,figMinY: double);
procedure GetINBoundsWithoutAutoCreatedFigures(var figMaxX,figMaxY,figMinX,figMinY: double);
procedure GetBoundsWithAutoCreatedFigures(var figMaxX,figMaxY,figMinX,figMinY: double);
//
Function duplicate:TFigure; override;
Function DuplicateAsBezier:TFigure; override;
Procedure Mirror(Point1,Point2: TdoublePoint);override;
Procedure ModifySelection(mm: TModifyMode; value: Integer);override;
Function ModifyTextAndFont(mm: TModifyMode; valueI:Double; valueS:string;
valueSt: TFontStyles;ValueB:Boolean):Boolean;override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Procedure SetSpecialPropertiesFromStream(Stream: TStream);override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;
x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;
x,y:double;Shift: TShiftState):boolean;override;
Function CountBlock(BlockName:String):integer;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Procedure VerifyZeroPoints(orgV,orgH:Byte);override;
Procedure SetReload(Value:Boolean);
Procedure GetFigures(xList:TList);
Function GetClassName:String;override;
Procedure DrawDimlines(DEngine:TPCDrawEngine;isGrayed:Boolean);override;
Procedure LockDimensions(w,h:Double);
Procedure Rotate(aAngle: double; cPoint: TdoublePoint);override;
Procedure scale(percentx,percenty: double; rPoint: Tdoublepoint);override;
function AddToGrp(AFigure: TFigure): Integer; //28.04.2011
function RemoveFromGrp(AFigure: TFigure): Integer; //28.04.2011
// Tolik 14/09/2017 --
Function GetBoundRectWithoutAutoCreatedFigures: TDoubleRect;
//
// Tolik 27/06/2017 --
function CheckHasAutocreatedFigures(aFigure: TFigure): Boolean;
function InsertFig(aFigure: TFigure): Integer;
//
Property ReLoading: Boolean read FReload write SetReload;
Property Combined:Boolean read FCombined write SetCombined;
end;
TBlock = class(TFigureGrp)
Blockname: String;
//CCount: integer;
OrgVz: Byte;
OrgHz: Byte;
MapScale: Double;
Procedure Initialize;override;
Function Rename:string;override;
constructor Create(LHandle: LongInt;aOwner: TComponent);
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function duplicate:TFigure; override;
Function GetClassName:String;override;
//procedure CreateProperties;
procedure SaveToFile(const AFileName: String); //27.08.2010 //#From Oleg#
End;
TLine = class(TFigure)
InMoveList: Boolean;
JoinFigure1,JoinFigure2: Tfigure;
RowH,RowL: Double;
RowWhite: Boolean;
KeepAngle: Boolean;
EndMod: Boolean;
Function SnapPoints(var x,y:Double;DotsPerMil:Double):Boolean;override;
Procedure Initialize;override;
Procedure SetJFigure1(jf:TFigure);virtual;
Procedure SetJFigure2(jf:TFigure);virtual;
Procedure UnBound;virtual;
Procedure JoinFigureMoved(Sender: TFigure; dx,dy:double);virtual;
constructor create( aX1,aY1,aX2,aY2:Double;
w,s,c: integer; row:integer; LHandle: LongInt;
aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);reintroduce;
//Tolik
destructor Destroy;override;
//
class Function ShadowType:TShadowType;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y: double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
Function duplicate:TFigure; override;
Function DuplicateAsBezier:TFigure;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function ShadowClick(ClickIndex: Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex: Integer;x,y: Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Procedure Move(deltax, deltay: Double);override;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
Procedure CreateDimLines;override;
Function GetLength:Double;override;
end;
THellical = class(TFigure)
STep: Integer;
Procedure Initialize;override;
constructor create( aX1,aY1,aX2,aY2:Double;
w,s,c: integer; row:integer; LHandle: LongInt;
aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
class Function ShadowType:TShadowType;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y: double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
Function duplicate:TFigure; override;
Function DuplicateAsBezier:TFigure;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function ShadowClick(ClickIndex: Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex: Integer;x,y: Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure Move(deltax, deltay: Double);override;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
end;
TUserLine = class(TLine)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TVertex = class (TFigure)
constructor create(aX,aY: Double;LHandle:LongInt;
aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
//Procedure getModPoints(ModList: TList); override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
Function duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
class Function CreateShadow(x,y:double): TFigure;override;
Function ShadowClick(ClickIndex:Integer; x,y:Double):Boolean;override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Function GetClassName:String;override;
end;
TCircleVertex = class(TVertex)
//Procedure getModPoints(ModList: TList); override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:double): boolean;override;
Procedure Initialize;override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function GetClassName:String;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
Function CreateModification: TFigure;override;
end;
TUserVertex = class(TVertex)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TPlSegment = class(TMyObject)
Index: Integer;
SType: TSegmentType;
CPoint1:TDoublePoint;
Cpoint2:TDoublePoint;
TangentKnot:Boolean;
Inverted: Boolean;
tp1,tp2: TDoublePoint;
ShowDim:Boolean;
Constructor Create(aIndex:Integer;aType:TSegmentType;cp1,cp2:TDoublepoint);
Destructor Destroy; // Tolik 13/12/2019 --
Procedure SetVals(aType:TSegmentType;cp1,cp2:TDoublePoint);
Procedure Move(deltax, deltay: Double);
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);
Procedure Mirror(Point1,Point2: TDoublePoint);
Procedure Scale(percentx, percenty: Double; rPoint: TDoublePoint);
Function Duplicate:TPlSegment;
Function BreakByPoint(knot1,knot2,bp: TDoublePoint; var seg1,seg2: TPLSegment;
Knifing:Boolean; kp1,kp2:TDoublePoint):Boolean;
Procedure CopyFrom(frSeg:TPLSegment);
end;
TPolyline = class(TLine)
protected
Tracing: Boolean;
fClosed: Boolean;
KnifePoint1: TDoublePoint;
KnifePoint2: TDoublePoint;
Knifing :Boolean;
SavedfigMaxX: double;
SavedfigMaxY: double;
SavedfigMinX: double;
SavedfigMinY: double;
SavedStateFig: string;
procedure setClosed(const Value: Boolean);
procedure CollectPolyLinePoints(var pdPoints: TDoublePointArr);
procedure CollectPolyBezierPoints(var pdPoints: TDoublePointArr;
var rpS1,rpS2,rpE1,rpE2:TDoublePoint;
var fLine,lLine:Boolean);overload;
procedure CollectPolyBezierPoints(var pdPoints: TDoublePointArr);overload;
Procedure OffSetPolyBezierPoints(var pdPoints: TDoublePointArr;w:Double);
Procedure OffSetSegments(var NewSegs: TList;w:Double);
Procedure DrawRows(DEngine: TPCDrawEngine;xColor: TColor;
rpS1,rpS2,rpE1,rpE2:TDoublePoint;firstLine,lastLine:Boolean);
public
PenPattern: TPattern;
Segments: TList;
BrushBitmap: TBitmap;
KeyControl : Boolean;
HatchLines : TDoublePointArr;
HatchSeg: Integer;
HatchDist: Double;
NeedBounds: Boolean; // Tolik 02/08/2021 --
Procedure HatchBySegment(SegIdx:Integer; Distance:Double);
Procedure RemoveHatch;
Procedure AssignPenPattern(MasterPattern: TPattern);
Procedure ClearSegments;
Procedure ArrangeSegment(SegNbr: integer; SegType: TSegmentType);
Procedure ArrangeSelectedSegment(SegType: TSegmentType);
Procedure InsertKnot(SegNbr:Integer);overload;
Procedure InsertKnot(SegNbr:Integer;MP:TDoublePoint);overload;
Procedure DivideSegment(SegNbr:Integer;Cnt:Integer);
Procedure RoundCornerByArc(SeqNbr:Integer; Rad: Double);
Procedure DeleteKnot(SegNbr:Integer);
Procedure OnNewPoint;override;
Procedure MoveControlPointsOfKnot(KnotNbr: Integer;DeltaX,DeltaY:Double);
Procedure GetControlPointsOfKnot(KnotNbr: integer; var cp1,cp2: TDoublePoint);
Procedure SetControlPointsOfKnot(KnotNbr: integer; cp1,cp2: TDoublePoint);
Procedure GetControlPointsOfSegment(SegNbr: integer; var cp1,cp2: TDoublePoint);
Procedure SetControlPointsOfSegment(SegNbr: integer; cp1,cp2: TDoublePoint);
Procedure TangentControlLine(KnotNbr: Integer);
Procedure BreakControlLine(KnotNbr: Integer);
Procedure InvertSegment(KnotNbr: Integer);
Function IsKnotTangent(KnotNbr: Integer):Boolean;
Function TypeOfSegment(SegNbr: Integer): TSegmentType;
Procedure SetJFigure1(jf:TFigure);override;
Procedure SetJFigure2(jf:TFigure);override;
Procedure UnBound;override;
Procedure JoinFigureMoved(Sender: TFigure; dx,dy:double);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure UpdateMenu(var PopMenu: TPopUpMenu;var sIndex: integer);override;
Procedure Initialize;override;
constructor create(Points:TDoublePointArr;w,s,c,abrs,abrc: integer;row:integer;
aClosed: Boolean;
LHandle: LongInt;aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
class function createP4(p1,p2,p3,p4:TDoublePoint;w,s,c,abrs,abrc: integer;row:integer;
aClosed: Boolean;
LHandle: LongInt;aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent):TPolyline;
class function CreateFromBezierPoints(Points:TDoublePointArr;w,s,c,abrs,abrc: integer;row:integer;
aClosed: Boolean;LHandle: LongInt;
aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent):TPolyline;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y: double): boolean;override;
function isPointInSegment(SegNbr: Integer; x, y: double): boolean;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
Function duplicate:TFigure; override;
Procedure ConvertToBezier;
Procedure ConvertToPolyLine;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Procedure SegmentsToStream(xStream:TStream);
Procedure SegmentsFromStream(xStream:TStream);
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowKeyStroke(var ClickIndex,KeyCode:Integer;Shift:TShiftState; var Fnished:Boolean):Boolean;override;
Function ShadowClick(ClickIndex: Integer; x,y: Double): Boolean;override;
Function ShadowTrace(ClickIndex: Integer; x,y: Double):Boolean;override;
Function CreateModification: TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure SelectPoint(ModPoint:TModpoint);override;
Procedure DeSelectPoint(ModPoint:TModpoint);override;
Procedure DrawSelectionPoints(DEngine: TPCDrawEngine;isGrayed:Boolean);override;
Procedure Move(deltax, deltay: double);override;
Procedure Rotate(aAngle: double; cPoint: TDoublePoint);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Procedure scale(percentx,percenty: double; rPoint: TDoublepoint);override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Procedure VerifyZeroPoints(orgV,orgH:Byte);override;
Destructor Destroy;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function Knife(p1,p2:TdoublePoint;Figures:TList):Boolean;override;
Function SelfIntersecting:Boolean;
Function Offset(Thick:Double):TFigure;override;
Function DuplicateAsBezier:TFigure; override;
Function GetClassName:String;override;
Class Function InsideSelection:Boolean;override;
Procedure CreateDimLines;override;
Procedure ClearDimLines;override;
Procedure SetSegmentDimension(SegNbr:Integer;Vis:Boolean);
Function GetSegmentDimension(SegNbr:Integer):Boolean;
Procedure ToggleSegmentDimension(SegNbr:Integer);
Function GetLength:Double;override;
Function GetArea:Double;override;
Procedure SimplfyPoints;
Property Closed: Boolean read fClosed write setClosed;
end;
TFreeHand = class(TPolyline)
Function ShadowClick(ClickIndex: Integer; x,y: Double): Boolean;override;
Function ShadowTrace(ClickIndex: Integer; x,y: Double):Boolean;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function GetClassName:String;override;
end;
TPointSet = class(TPolyline)
Procedure Draw(Dengine:TPCDrawEngine;isGrayed:Boolean);override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function GetClassName:String;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function CreateModification: TFigure;override;
Procedure DrawSelectionPoints(DEngine: TPCDrawEngine;isGrayed:Boolean);override;
end;
TAngleLine = class(TPolyline)
Function GetAngle:Double;
Function ShadowClick(ClickIndex: Integer; x,y: Double): Boolean;override;
Procedure Draw(Dengine:TPCDrawEngine;isGrayed:Boolean);override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function GetClassName:String;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function CreateModification: TFigure;override;
Procedure DrawSelectionPoints(DEngine: TPCDrawEngine;isGrayed:Boolean);override;
end;
TUserPolyline = class(TPolyline)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TEllipse = class(TFigure)
alen,blen : double;
constructor create( cX,cY,len1,len2,aAngle: Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
//Constructor create3P( cX,cY,x1,y1,x2,y2: Double; w,s,c,abrs,abrc:integer;
// LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Procedure Scale(percentx,percenty: Double; rPoint: TDoublePoint);override;
Procedure Move(deltax, deltay: Double);override;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Procedure SetSpecialPropertiesFromStream(Stream: TStream);override;
Function ShadowClick(ClickIndex:Integer;x,y: double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:double): TFigure;override;
Function CreateModification: TFigure;override;
//Procedure RefreshBounds;
Procedure VerifyZeroPoints(orgV,orgH:Byte);override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Function DuplicateAsBezier:TFigure;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
Function GetLength:Double;override;
Function GetArea:Double;override;
end;
TUserEllipse = class(TEllipse)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TCircle = class(TFigure)
Hatched: Boolean;
constructor create( cX,cY,rad: Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
Function Edit: Boolean;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
// procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Procedure scale(percentx,percenty: double; rPoint: Tdoublepoint);override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class function ShadowType:TShadowType;override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Function DuplicateAsBezier:TFigure;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
Procedure CreateDimLines;override;
Function GetLength:Double;override;
Function GetArea:Double;override;
end;
// Tolik -- 19/08/2017 --
TOverLappedCircle = class(TFigure)
Hatched: Boolean;
CutRadius: Double;
constructor create(cX,cY,cX1, cY1, rad, cutRad: Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
//Procedure WriteToStream(Stream:TStream);override;
// Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
// Function GetClassName:String;override;
{
Function Edit: Boolean;override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
procedure getModPoints(ModList: TList);override;
function isPointIn(x,y:Double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Procedure scale(percentx,percenty: double; rPoint: Tdoublepoint);override;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class function ShadowType:TShadowType;override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Function DuplicateAsBezier:TFigure;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function Offset(Thick:Double):TFigure;override;
Procedure CreateDimLines;override;
Function GetLength:Double;override;
Function GetArea:Double;override;
}
end;
TOverLappedEllipse = class(TFigure)
Hatched: Boolean;
Radius1, CutRadius1, CutRadius2: Double;
constructor create(cX, cY, cX1, cY1, Rad1, Rad2, CutRad1, CutRad2: Double;w,s,c,abrs,abrc:integer;
LHandle: LongInt; aDrawStyle: PCTypesUtils.TDrawStyle; aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function GetClassName:String;override;
end;
//
TUserCircle = class(TCircle)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TArc = class(TFigure)
ArcStyle: TArcStyle;
SAngle,FAngle:Double;
constructor create( cx,cy,rad,a1,a2:Double;w,s,c,abrs,abrc,aArcStyle:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Function GetStartPoint:TDoublePoint;override;
Function GetEndPoint:TDoublePoint;override;
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
function isAngleIn(a:Double): boolean;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Function DuplicateAsBezier:TFigure;override;
Procedure Invert;
Procedure WriteToStream(Stream:TStream);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Procedure ArrangeStyle(val: TArcStyle);
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function ShadowClick(ClickIndex:Integer; x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer; x,y: Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function CreateModification: TFigure;override;
Procedure VerifyZeroPoints(orgV,orgH:Byte);override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
Procedure CreateDimLines;override;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure Scale(percentx,percenty: Double; rPoint: TDoublePoint);override;
end;
// Tolik -- 23/05/2017 --
TPie = class(TFigure)
public
FillColor: Integer;
SAngle,FAngle:Double;
GuideLen: Double;
DrawGuides: Boolean;
DLabel: String;
Prefix: String;
Suffix: String;
AutoText: Boolean;
TextFont: String;
TextHeight: Double;
TextBold: Boolean;
TextItalic: Boolean;
TextColor: TColor;
LStyle: TArcDimLabelStyle;
CutStyle : TPieCutStyle; // cut style from center point
CutRadius: double;
Function Edit:Boolean;override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function IsPointIn(x,y: Double): boolean;override;
// Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function CreateModification: TFigure;override;
Function GetMiddleAngle: Double;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
// Function ModifyTextAndFont(mm: TModifyMode; valueI:Double; valueS: string;
// valueSt: TFontStyles;ValueB:Boolean):Boolean;override;
function GetAngle: Double; //06.10.2011
function SetAngle(AValue: Double): Boolean; //06.10.2011
procedure Scale(percentx, percenty: Double; rPoint: TDoublePoint); override;
//Constructor create( cx,cy,rad,a1,a2:Double;w,s,c,abrs,abrc: Integer;
// LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
Constructor create(cx,cy,rad,a1,a2:Double;w,s,c,abrs,abrc: Integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent; aCutStyle: TPieCutStyle; aCutRadius: Double = 0);
Destructor Destroy;override;
Function GetClassName:String;override;
Procedure Initialize;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);override;
//procedure GetModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function GetCutStyle: TPieCutStyle;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
//class Function CreateFromShadow(aOwner: TComponent;
// LHandle: Integer; Shadow: TFigure): TFigure;overload;
end;
//
TElpArc = class(TFigure)
ArcStyle: TArcStyle;
SAngle,FAngle:Double;
ALen,BLen: Double;
constructor create(cx, cy, radA, radB, a1, a2: Double; aAngle: Double; w,s,c,abrs,abrc,aArcStyle:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Function GetStartPoint:TDoublePoint;override;
Function GetEndPoint:TDoublePoint;override;
Procedure Initialize;override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Function DuplicateAsBezier:TFigure;override;
Procedure Invert;
Procedure WriteToStream(Stream:TStream);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Procedure ArrangeStyle(val: TArcStyle);
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function ShadowClick(ClickIndex:Integer; x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer; x,y: Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function CreateModification: TFigure;override;
Procedure VerifyZeroPoints(orgV,orgH:Byte);override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
function isAngleIn(a:Double): boolean;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure Scale(percentx,percenty: Double; rPoint: TDoublepoint);override;
end;
TUserArc = class(TArc)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TRectangle = class(TFigure)
DimLeft:Boolean;
DimRight: Boolean;
DimTop: Boolean;
DimBottom:Boolean;
FDrawPoints: Pointer;
constructor create(aX1,aY1,aX2,aY2:Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
Procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
class Function ShadowType:TShadowType;override;
Function CreateModification: TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Procedure GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);override;
Function DuplicateAsBezier:TFigure;override;
Function BreakByPoint(p:TdoublePoint;var Figures:TList):boolean;override;
Function GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;override;
Function Offset(Thick:Double):TFigure;override;
Function GetClassName:String;override;
Procedure CreateDimLines;override;
//Function Edit: Boolean;override;
Function GetLength:Double;override;
Function GetArea:Double;override;
Destructor Destroy;override; //31.10.2011
end;
TUserRectangle = class(TRectangle)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function duplicate:TFigure; override;
Function isPointIn(x,y: double): boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
Function GetClassName:String;override;
end;
TRichText = class(TRectangle)
re: TRichEdit98;
ttMetaFile: TMetafile;
frm: TfrmInput;
ShowGuide: Boolean;
Lines: TStringList;
TagParse: Boolean;
FontSize: Integer;
FontName: String;
FontStyle: TFontStyles;
constructor create(aX1,aY1,aX2,aY2: Double; w, s, c, abrs, abrc: integer;
LHandle: LongInt; aDrawStyle: PCTypesUtils.TDrawStyle; aOwner: TComponent;
AText: Boolean=true);
constructor createEx(aX1,aY1,aX2,aY2:Double;w,s,c,abrs,abrc:integer;
Lines:String; FontName:String; FontSize: Integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle; aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure WriteToStream(Stream:TStream);override;
Function edit:Boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
function isPointIn(x,y:Double): boolean;override;
Procedure rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure mirror(Point1,Point2: TDoublePoint);override;
Destructor Destroy;override;
procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function duplicate:TFigure; override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
class function ShadowType: TShadowType;override;
Function GetClassName:String;override;
Procedure CheckAndChangeFont;
end;
TRichText_my = class(TRichText)
//Procedure Initialize;override;
end;
TOLEObject = class(TRectangle)
ole: TMFSOle;
MetaFile: TMetafile;
constructor create(aX1,aY1,aX2,aY2:Double; w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle:PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function edit:Boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
function isPointIn(x,y:Double): boolean;override;
Procedure rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure mirror(Point1,Point2: TDoublePoint);override;
Destructor Destroy;override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Procedure WriteToStream(Stream:TStream);override;
Function duplicate:TFigure; override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
class Function ShadowType:TShadowType;override;
Function GetClassName:String;override;
end;
TWMFObject = class(TFigure)
PictureName: String;
MetaFile: TMetafile;
constructor create(x,y: Double;fName:string;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
constructor createEx(x,y: Double;mf:Tmetafile;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function isPointIn(x,y:Double): boolean;override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Destructor Destroy;override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Procedure WriteToStream(Stream:TStream);override;
Function duplicate:TFigure; override;
class Function ShadowType:TShadowType;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;
Shadow:TFigure): TFigure;override;
Class Function IsOneClick:Boolean;override;
Procedure UpdateMenu(var PopMenu: TPopUpMenu;var sIndex:integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure CloneAsEditObjects;
Function GetClassName:String;override;
end;
TMathGraph = class(TRectangle)
Source: String;
UnitSize : Double;
BorderColor: Integer;
BorderStyle: Integer;
BorderWidth: Integer;
AxisColor: Integer;
AxisStyle: Integer;
AxisWidth: Integer;
OrgCenter: Boolean;
ScaleStyle:TMGScaleStyle;
PolarScale: Boolean;
ScaleColor: Integer;
NumStep : Integer;
constructor create(aX1,aY1,aX2,aY2:Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Procedure WriteToStream(Stream:TStream);override;
Function edit:Boolean;override;
function isPointIn(x,y:Double): boolean;override;
Procedure rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure mirror(Point1,Point2: TDoublePoint);override;
Destructor Destroy;override;
procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function duplicate:TFigure; override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
//Procedure GetModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure SetOriginToCenter;
Procedure ZoomIn;
Procedure ZoomOut;
Function CreateModification: TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
class Function ShadowType:TShadowType;override;
Function GetClassName:String;override;
end;
TBMPObject = class (TFigure)
Picture : TBitmap;
Image : TBitmap;
PictureName : string;
VertFlipped : Boolean;
HorzFlipped : Boolean;
fTrans : Boolean;
Dpm : Real;
ClipFigure: TFigure;
ClpRgn: HRGN;
Skewed: Boolean;
SelMode: Byte; // 0: Select Bitmap 1: Select ClipFigure 2: Select Group
Tiled: Boolean;
// Tolik --
ImageEdited: Boolean; // äëÿ îòðèñîâêè, ÷òîáû, åñëè íå áûëî èçìåíèåíèé, íå îòðèñîâûâàòü ïîâîðîò êàðòèíêè êàæäûé ðàç (íå áóäåò òàê òîðìîçèòü)
//
Procedure CreateMWPath(x,y:Double;Tol:Double;var DPoints:TDoublePointArr;var closed:Boolean);
procedure setTrans(value: Boolean);
// Tolik -- 10/03/2016 --
constructor create( x,y: Double; afName: string;
LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent; JPEGBounds: Boolean = False);
(* constructor create( x,y: Double; afName: string;
LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);*)
//
constructor createEx( x,y: Double; aBitmap: TBitmap;
LHandle:LongInt;aDrawStyle:PCTypesUtils.TDrawStyle;aOwner: TComponent);
constructor createExRes(x,y: Double;BmpRes:Integer;aBitmap: TBitmap;
LHandle:LongInt;aDrawStyle:PCTypesUtils.TDrawStyle;aOwner: TComponent);
Procedure Initialize;override;
Procedure RelocatePoints;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function Edit: Boolean;override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
Function DoMagicWand(x,y:Double):Tfigure;
Procedure mirror(Point1,Point2: TDoublePoint);override;
procedure scale(percentx,percenty: Double; rPoint: TDoublepoint);override;
procedure move(deltax, deltay: Double);override;
Procedure rotate(aAngle: Double; cPoint: TDoublePoint);override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function duplicate:TFigure; override;
Procedure FlipHorz;
Procedure FlipVert;
Procedure UpdateMenu(var PopMenu: TPopUpMenu;var sIndex:integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function TraceModificationClipped(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Destructor Destroy;override;
property Transparent: Boolean read fTrans write setTrans;
Procedure Select;override;
Procedure Deselect;override;
Procedure drawselectionpoints(DEngine: TPCDrawEngine;isGrayed:Boolean);override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function ShadowType:TShadowType;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Procedure SkewShape;
Function GetClassName:String;override;
end;
TTextPanel = class (TRectangle)
Text: String;
Alignment: TTextAlign;
Height: Double;
CSpace: Double;
Font : TFont;
constructor create(xp1,xp2: TDoublePoint; LHandle:LongInt; aDrawStyle: PCTypesUtils.TDrawStyle;aOwner: TComponent);
Destructor Destroy;override;
Procedure Initialize;override;
Function Edit: Boolean;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function ModifyTextAndFont(mm: TModifyMode; valueI:Double; valueS: string;
valueSt: TFontStyles;ValueB:Boolean):Boolean;override;
procedure scale(percentx,percenty: Double; rPoint: TDoublepoint);override;
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure;override;
function isPointIn(x,y:Double): boolean;override;
Procedure WriteToStream(Stream:TStream);override;
procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
Function duplicate:TFigure; override;
Procedure DrawFigureGuides(DEngine: TPCDrawEngine);override;
class function ShadowType: TShadowType;override;
Function GetClassName:String;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure SetField(FName,FValue:String);
end;
TText = class(TFigure)
Text: string;
Font: TFont;
Height: Double;
CWidth: double;
CSpace: Double;
fKeepA: Boolean;
TextLength,TextHeight: Double;
BoxWidth: Double; // Tolik 18/10/2019 -- øèðèíà êîíòåéíåðà, â êîòîðîì íàõîäèòñÿ òåêñò
Outlined: Boolean;
constructor Create( aX1,aY1,h,w: double;atext: string; FontName:String;
FontCharset: Byte;aColor:Integer;LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
Class function CreateCentered(aX1,aY1,h,w: double;atext: string; FontName:String;
FontCharset: Byte;aColor:Integer;LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent):TText;
Procedure Initialize;override;
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
Function Edit: Boolean;override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function isPointIn(x,y:Double): boolean;override;
procedure getbounds(var figMaxX,figMaxY,figMinX,figMinY:Double);override;
procedure setRegionPoints;
Function duplicate:TFigure; override;
Procedure mirror(Point1,Point2: TDoublePoint);override;
Procedure ValidatePoints;
procedure scale(percentx,percenty: Double; rPoint: TDoublepoint);override;
Procedure rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure CalculateAngle;
Procedure WriteToStream(Stream:TStream);override;
Function ModifyTextAndFont(mm: TModifyMode; valueI:Double; valueS: string;
valueSt: TFontStyles;ValueB:Boolean):Boolean;override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Destructor Destroy;override;
class Function ShadowType:TShadowType;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;
x,y:Double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Function DuplicateAsBezier:TFigure; override;
Function GetClassName:String;override;
Procedure SetField(FName,FValue:String);
end;
TDimLine = class(TFigure)
DLabel: String;
Prefix: String;
Suffix: String;
AutoText: Boolean;
TextPos : TDimTextPos;
TextFont: String;
TextHeight: Double;
TextBold: Boolean;
TextItalic: Boolean;
TextColor: TColor;
EndType: TEndType;
MapScale: Double;
Procedure Initialize;override;
Function Edit:Boolean;override;
constructor Create(LHandle: LongInt;aDrawStyle:TDrawStyle;aOwner: TComponent);
//procedure GetModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
function IsPointIn(x,y:Double): boolean;override;
procedure Getbounds(var figMaxX,figMaxY,figMinX,figMinY:Double);override;
Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer; x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ModifyTextAndFont(mm: TModifyMode; valueI:Double; valueS: string;
valueSt: TFontStyles;ValueB:Boolean):Boolean;override;
// Tolik 04/03/2020
Function DefineHStyle(currStyle: THDimLabelStyle): THDimLabelStyle; // ïåðåîïðåäåëèòü ïîëîæåíèå òåêñòà, åñëè äëèíà òåêñòà ïðåâûøàåò äëèíó ñàìîé ëèíèè
Function DefineVStyle(currStyle: TVDimLabelStyle): TVDimLabelStyle; // ïåðåîïðåäåëèòü ïîëîæåíèå òåêñòà, åñëè äëèíà òåêñòà ïðåâûøàåò äëèíó ñàìîé ëèíèè
//
end;
THDimLine = class(TDimLine)
caption: string;
LStyle: THDimLabelStyle;
Function Edit:Boolean;override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function IsPointIn(x,y:Double): boolean;override;
Procedure Getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure Rotate(aAngle: Double; cPoint: TDoublePoint);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Function GetClassName:String;override;
end;
TVDimLine = class(TDimLine)
caption: string;
LStyle: TVDimLabelStyle;
Function Edit:Boolean;override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function IsPointIn(x,y: Double): boolean;override;
Procedure Getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:Double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Procedure Rotate(aAngle:Double; cPoint: TDoublePoint);override;
Procedure Mirror(Point1,Point2: TDoublePoint);override;
Function GetClassName:String;override;
end;
TADimLine = class(TDimLine)
LStyle: TADimLabelStyle;
HorzText: Boolean;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function IsPointIn(x,y: Double): boolean;override;
Procedure Getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Function GetClassName:String;override;
end;
TCDimLine = class(TDimLine)
LStyle: TCDimLabelStyle;
HorzText: Boolean;
InnerGuide: Boolean;
OuterGuide: Boolean;
Procedure Initialize;override;
Procedure GetRotatePoints(ModList: TList);override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function IsPointIn(x,y: Double): boolean;override;
Procedure Getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Function GetClassName:String;override;
end;
TArcDimLine = class(TArc)
DLabel: String;
Prefix: String;
Suffix: String;
AutoText: Boolean;
TextFont: String;
TextHeight: Double;
TextBold: Boolean;
TextItalic: Boolean;
TextColor: TColor;
LStyle: TArcDimLabelStyle;
GuideLen: Double;
DrawGuides: Boolean;
Constructor Create(cx,cy,rad,a1,a2:Double;LHandle:LongInt;
aDrawStyle: TDrawStyle;aOwner: TComponent);
Function Edit:Boolean;override;
Procedure Initialize;override;
Procedure Draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
function IsPointIn(x,y: Double): boolean;override;
Procedure Getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);override;
//procedure getModPoints(ModList: TList);override;
procedure getModPoints(ModList: TMyList);override;
Function Duplicate:TFigure; override;
Procedure WriteToStream(Stream:TStream);override;
Procedure SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);override;
class function CreateFromShadow(aOwner:TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y:Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y:Double):Boolean;override;
Function CreateModification: TFigure;override;
Function TraceModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Function EndModification(CadControl: Pointer;mp:TModPoint;TraceFigure:TFigure;x,y:double;Shift: TShiftState):boolean;override;
Procedure UpdateMenu(var popMenu: TPopUpMenu;var sIndex:Integer);override;
Procedure MenuClicked(CommandId:integer);override;
Function GetClassName:String;override;
Function ModifyTextAndFont(mm: TModifyMode; valueI:Double; valueS: string;
valueSt: TFontStyles;ValueB:Boolean):Boolean;override;
function GetAngle: Double; //06.10.2011
function SetAngle(AValue: Double): Boolean; //06.10.2011
procedure Scale(percentx, percenty: Double; rPoint: TDoublePoint); override;
end;
TRotate = class(TFigure)
Function GetAngle:Double;virtual;
constructor create(cX,cY:Double;p1,p2: TDoublepoint);
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TMove = class(TFigure)
constructor create(p1,p2: TDoublepoint);
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TDuplicate = class(TMove)
class Function CreateShadow(x,y:Double): TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TDuplicateAsBezier = class(TMove)
class Function CreateShadow(x,y:Double): TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TMirror = class(TMove)
Straight: Boolean;
Procedure Initialize;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
class Function CreateShadow(x,y:Double): TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TKnife = class(TMove)
class Function CreateShadow(x,y:Double): TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TCalibrate = class(TMove)
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
class Function CreateShadow(x,y:Double): TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TArrayPol = class(TRotate)
Function GetAngle:Double;override;
class Function CreateShadow(x,y:Double): TFigure;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TArrayRect = class(TFigure)
constructor create(p1,p2,p3,p4,p5: TDoublepoint);
procedure draw(DEngine: TPCDrawEngine; isGrayed:Boolean);override;
class Function CreateShadow(x,y:Double): TFigure;override;
Function ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;override;
Function ShadowTrace(ClickIndex:Integer;x,y: Double):Boolean;override;
class function CreateFromShadow(aOwner: TComponent;LHandle: LongInt;Shadow:TFigure): TFigure;override;
end;
TVectorSegment = class(TMyObject)
SegmentType: TVectorSegmentType;
EndPoint: TDoublePoint;
Cpoint1 : TDoublePoint;
Cpoint2 : TDoublePoint;
Constructor CreateLineSegment(ePoint: TDoublePoint);
Constructor CreateBezierSegment(ePoint,cp1,cp2:TDoublepoint);
Constructor CreateFromStream(Stream: TStream);
Constructor CreateFromStreamOldFormat(Stream: TStream);
Destructor Destroy; // Tolik 13/12/2019 --
Procedure SaveToStream(Stream:TStream);
Function Duplicate: TVectorSegment;
Procedure Move(dx,dy: Double);
Procedure Scale(px,py: double);
end;
TVectorObject = class(TMyObject)
ObjectType: TVectorObjectType;
Values: Array of TDoublePoint;
ArrayLen: Integer;
Procedure GetLocalValues(LValues: TDoublePointArr;sCoord:TDoublePoint; Scale,Angle:Double);
Constructor CreateLineObject(p1,p2: TDoublePoint);
Constructor CreateBezierObject(p1,p2,cp1,cp2: TDoublePoint);
Constructor CreateEllipseObject(p1: TDoublePoint;a,b:Double);
Constructor CreateCircleObject(p1: TDoublePoint;r:Double);
Constructor CreatePolyLineObject(nbrPoint: Integer; p: array of TDoublePoint);
Constructor CreatePolygonObject(nbrPoint: Integer; p: array of TDoublePoint);
Constructor CreatePointObject(p:TDoublepoint);
Constructor CreateFromStream(Stream: TStream);
Procedure SaveToStream(Stream:TStream);
Function Duplicate: TVectorObject;
Destructor Destroy; override;
Procedure Move(dx,dy: Double);
Procedure Scale(px,py: double);
end;
TVector = class(TMyObject)
StartY: Double;
Segments: TList;
Objects: TList;
Function AddLineSegment(ePoint:TDoublePoint):TVectorSegment;
Function AddBezierSegment(ePoint:TDoublePoint; cPoint1,cPoint2: TDoublePoint):TVectorSegment;
Procedure AddVectorObject(cObject: TVectorObject);
Procedure Draw(DEngine:TPCDrawEngine;sCoord,eCoord:TDoublepoint;Scale:Double);
Procedure DrawObjects(DEngine:TPCDrawEngine;sCoord,eCoord:TDoublepoint;Scale:Double);
Constructor Create(SPointY: Double);
Function Duplicate:TVector;
Destructor Destroy;override;
Procedure Scale(px,py: double);
Procedure SaveToStream(Stream:TStream);
Procedure LoadFromStream(Stream:TStream);
Procedure LoadFromStreamOldFormat(Stream:TStream);
Procedure MoveContent(dx,dy:Double);
end;
TPattern = class(TMyObject)
PatName: String;
Gap : Double;
Vector: TVector;
PWidth: Double;
Constructor CreateFromFigure(aFigure: TFigure);
Constructor Create(aVector: TVector;aWidth,aGap:Double);
Procedure StartDraw(DEngine:TPCDrawEngine;sCoord:TDoublePoint);
Procedure Scale(px,py: double);
Procedure Draw(DEngine:TPCDrawEngine;sCoord,eCoord:TDoublepoint;Scale:Double);
Procedure DrawObjects(DEngine:TPCDrawEngine;sCoord,eCoord:TDoublepoint;Scale:Double);
Function Duplicate: TPattern;
Destructor destroy;override;
Procedure SaveToStream(Stream:TStream);
Procedure LoadFromStream(Stream:TStream);
Procedure LoadFromStreamOldFormat(Stream:Tstream);
end;
TPrintRect = class(TRectangle) //25.11.2011 - Äëÿ âûäåëåíèÿ îáëàñòè ïå÷àòè
class function CreateFromShadow(aOwner: TComponent;LHandle: Integer; Shadow: TFigure): TFigure; override;
end;
Function IntersectSegments(var seg1,seg2: TPLSegment):Boolean;
Function CreateAlignedDimLine(p1,p2,offp1,offp2:TDoublePoint;Owner:TComponent):TADimLine;
Function CreateVerticalDimLine(p1,p2,offp1,offp2:TDoublePoint;Owner:TComponent):TVDimLine;
const acadlw: array[1..10] of SmallInt = (0,5,13,18,25,30,40,53,70,90);
const charsets: array [0..17] of Byte =
(ANSI_CHARSET,
DEFAULT_CHARSET,
SYMBOL_CHARSET,
SHIFTJIS_CHARSET,
GB2312_CHARSET,
HANGEUL_CHARSET,
CHINESEBIG5_CHARSET,
OEM_CHARSET,
JOHAB_CHARSET,
HEBREW_CHARSET,
ARABIC_CHARSET,
GREEK_CHARSET,
TURKISH_CHARSET,
THAI_CHARSET,
EASTEUROPE_CHARSET,
RUSSIAN_CHARSET,
MAC_CHARSET,
BALTIC_CHARSET);
var OldPatternFormat:Boolean = False;
SelFeed: Integer = 0;
CalibrateUnit: Byte = 0; // 0=nm 1=mm 2=cm 3=dm 4=m 5=km
PolylineKeyControl:Boolean=False;
MirrorDupl: Boolean=True;
ConvertRatio: Double = 1;
ConvertDx : Double = 0;
ConvertDy : Double = 0;
implementation
uses PCDrawing, Powercad, U_Common, U_BaseCommon, U_ESCADClasess, U_Constants, fplan,{Tolik 13/07/2017 } U_Cad;
var TempCanvas: TCanvas;
TempEngine: TPCDrawEngine;
Handles:integer = 0;
plPs0,plPs1,plPs2: integer;
ClassIndexes: TStringList;
// Tolik 24/05/2019 - -
Function EditStreamInCallback(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
theStream: TStream;
dataAvail: LongInt;
begin
theStream := TStream(dwCookie);
with theStream do begin
dataAvail := Size - Position;
if dataAvail <= cb then begin
pcb := Read(pbBuff^, dataAvail);
Result := 0;
end
else begin
pcb := Read(pbBuff^, cb);
Result := pcb;
end;
end;
end;
Function EditStreamOutCallback(dwCookie: Longint; pbBuff: PByte;
cb: Longint; var pcb: Longint): Longint; stdcall;
var
theStream: TStream;
begin
theStream := TStream(dwCookie);
with theStream do begin
If cb > 0 Then Begin
pcb := Write(pbBuff^, cb);
Result := pcb;
End
Else
Result := 0;
end;
end;
Procedure GetRTFSelection( aRichEdit: TRichEdit; intoStream: TStream );
Var
editstream: TEditStream;
Begin
With editstream Do
Begin
dwCookie:= Longint(intoStream);
dwError:= 0;
pfnCallback:= EditStreamOutCallBack;
end;
// Tolik 07/11/2019 -- åñëè þçàòü SFF_SELECTION, ïðåäâàðèòåëüíî ÷åðåç re.SelectAll,
//òî êàæäûé ðàç äîáàâëÿåò ïóñòóþ ñòðîêó òèïà "" ê ñòðîêàì
{ aRichedit.Perform( EM_STREAMOUT, SF_RTF or SFF_SELECTION,
longint(@editstream));}
aRichedit.Perform( EM_STREAMOUT, SF_RTF, longint(@editstream));
//
End;
Procedure PutRTFSelection( aRichEdit: TRichEdit; sourceStream: TStream );
Var
editstream: TEditStream;
Begin
With editstream Do Begin
dwCookie:= Longint(sourceStream);
dwError:= 0;
pfnCallback:= EditStreamInCallBack;
end;
// Tolik 07/11/2019 -- åñëè þçàòü SFF_SELECTION, ïðåäâàðèòåëüíî ÷åðåç re.SelectAll,
//òî êàæäûé ðàç äîáàâëÿåò ïóñòóþ ñòðîêó òèïà "" ê ñòðîêàì
{aRichedit.Perform( EM_STREAMIN, SF_RTF or SFF_SELECTION, longint(@editstream));}
aRichedit.Perform( EM_STREAMIN, SF_RTF, longint(@editstream));
//
End;
//
// Tolik 23/05/2017 -- ðèñîâàòü ïðîçðà÷íûå/ïîëóïðîçðà÷íûå çàëèâêè îáúåêòîâ
{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;
}
(*
procedure DrawOpacityBrush(ACanvas: TCanvas; X, Y: Integer; AColor: TColor; ASize: Integer; Opacity: Byte);
var
Bmp: TBitmap;
I, J: Integer;
Pixels: PRGBQuad;
ColorRgb: Integer;
ColorR, ColorG, ColorB: Byte;
aBlendFunc : TBlendFunction;
begin
Bmp := TBitmap.Create;
try
Bmp.PixelFormat := pf32Bit; // needed for an alpha channel
Bmp.Width := ASize;
Bmp.Height := ASize;
// Bmp.Transparent := true;
// Bmp.TransparentColor := clGreen;
with Bmp.Canvas do
begin
Brush.Color := clFuchsia; // background color to mask out
ColorRgb := ColorToRGB(Brush.Color);
FillRect(Rect(0, 0, ASize, ASize));
Pen.Color := AColor;
Pen.Style := psSolid;
Pen.Width := ASize;
MoveTo(ASize div 2, ASize div 2);
LineTo(ASize div 2, ASize div 2);
end;
ColorR := GetRValue(ColorRgb);
ColorG := GetGValue(ColorRgb);
ColorB := GetBValue(ColorRgb);
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;
DrawAlphaAPI(bmp, ACanvas, 100, 100, Opacity);
finally
Bmp.Free;
end;
end;
*)
//
//******************************************************************************
// TMODPOINT IMPLEMENTATION
//******************************************************************************
Constructor TModPoint.Create(aFigure: TFigure;aType: TModPointType;
adType : TPointType; aColor: TColor; aDim,X,Y:Double; aSeqNbr: integer;z:Double=0);
begin
inherited create;
Figure := aFigure;
PType := aType;
DType := aDType;
Color := aColor;
CoordX := x;
CoordY := y;
CoordZ := z;
SeqNbr := aSeqNbr;
Dim := aDim;
Tag := 0;
Obj1 := 0;
Obj2 := 0;
Obj3 := 0;
Obj4 := 0;
OnlyIso := False;
isDraw := True;
isBlink :=False;
//FIsDrag := false;
end;
//Tolik
Destructor TModPoint.Destroy;
begin
inherited;
end;
Function TModPoint.IspointIn(x,y,pdim:Double):Boolean;
Begin
result := false;
if onlyiso then exit;
If ((x <= CoordX+pdim) and (x >= CoordX-pdim)) and
((y <= CoordY+pdim) and (y >= CoordY-pdim)) then
begin
result := true;
end;
end;
//******************************************************************************
// TLAYER IMPLEMETATION
//******************************************************************************
constructor Tlayer.create(aname: string);
begin
inherited create;
//Tolik 10/12/2021 - -
//name := aName;
name := Copy(aname, 1, 255);
//
ModPoints := TList.Create;
visible := seen;
PenColor := clBlack;
BrushColor := clRed;
TextColor := clBlack;
Description := '';
Tag := 0;
LayerWidth := 0;
LayerHeight := 0;
Data := nil;
IsDxf := false;
tmpVisible := seen;
end;
destructor Tlayer.destroy;
var
a: integer;
begin
try
for a := 0 to modpoints.Count - 1 do
TmodPoint(modpoints[a]).destroy;
// ModPoints.Destroy;
//Tolik
ModPoints.Clear;
ModPoints.Free;
//
if assigned(Data) then
Data.Free;
inherited destroy;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'Tlayer.destroy' + E.Message);
end;
end;
// Tolik
constructor TRegionObject.create(RegionObjectOwner: TFigure);
begin
inherited create;
CheckPointByRects := False;
if Assigned(RegionObjectOwner) then
RegObjOwner := RegionObjectOwner
else
RegObjOwner := nil;
RegObjData := nil;
end;
destructor TRegionObject.destroy;
begin
{if Length(RectArray) > 0 then
SetLength(RectArray, 0);}
RegObjOwner := nil;
if RegObjData <> nil then
GlobalFreePtr(RegObjData);
inherited destroy;
end;
Procedure TRegionObject.GetRegData(RegObjHandle: HRGN);
var i: Integer;
//Size, rSize: Cardinal;
Size: Dword;
//Header: TRegionHeader;
rdhInfo: TRgnDataHeader;
//rect: PRect;
begin
try
RegObjDataLength := 0;
if regObjHandle <> 0 then
begin
Size := 0;
//Size := GetRegionData (RegObjHandle, SizeOf (RGNDATA), nil);
Size := GetRegionData(RegObjHandle, 0, nil);
if size <> 0 then
begin
RegObjDataLength := Size;
if RegObjData <> nil then
begin
GlobalFreePtr(RegObjData);
RegObjData := nil;
end;
RegObjData := GlobalAllocPtr(GPTR, size*sizeOf(TrgnData));
GetRegionData(RegObjHandle, size, RegObjData);
end;
//data := GlobalAllocPtr(GPTR, size);
// GetRegionData(RegObjHandle, size, data);
(* if PRgnData(Data)^.rdh.nCount <> 0 then
begin
// åñëè áûëî ÷åãî - óáèâàåì...
if Length(RectArray) > 0 then
SetLength(RectArray, 0);
SetLength(RectArray, PRgnData(Data)^.rdh.nCount);
PRgnData(Data)^.rdh.dwSize;
PRgnData(Data)^.rdh.nRgnSize;
PRgnData(Data)^.rdh.rcBound
if PRgnData(Data)^.rdh.iType = 1 {RDH_RECTANGLES äðóãîãî, âðîäå êàê è íå áûâàåò ...} then
begin
for i := 0 to PRgnData(Data)^.rdh.nCount - 1 do
begin
rect := @PRgnData(Data)^.buffer[i*Sizeof(TRect)];
RectArray[i] := Rect^;
{RectArray[i].Top := Rect^.Top;
RectArray[i].Bottom := Rect^.Bottom;
RectArray[i].Left := Rect^.Left;
RectArray[i].Right := Rect^.Right;}
end;
end;
end;
*)
end;
except
on E: Exception do
begin
AddExceptionToLog('GetRegionData Error! ' + 'TRegionObject.GetRegData' + E.Message);
end;
end;
end;
//
procedure Tlayer.WriteToStream(stream: TStream;CadControl:TObject);
var xByte:Byte;
xStr:String;
xInt: Integer;
Cad: TPCDrawing;
xStream: TMemoryStream;
begin
xStr := Name;
WriteStrField(180,Stream,xStr);
xStr := Description;
WriteStrField(181,Stream,xStr);
xByte:= ord(visible);
WriteField(90,Stream,xByte,1);
xInt := Tag;
if xInt <> 0 then
WriteField(21,Stream,xInt,4);
xInt := LayerWidth;
if xInt <> 0 then
WriteField(22,Stream,xInt,4);
xInt := LayerHeight;
if xInt <> 0 then
WriteField(23,Stream,xInt,4);
//
if IsDxf then
xInt := 0
else
xInt := 1;
WriteField(24,Stream,xInt,4);
if assigned(Data) then
begin
Cad := TPCDrawing(CadControl);
if assigned(Cad) and assigned(Cad.OnLayerSaveData) then
begin
xStream := TMemoryStream.Create;
Cad.OnLayerSaveData(CadControl,Self,xStream);
if xStream.Size > 0 then
begin
xStream.Position := 0;
WriteStreamField(151,Stream,xStream);
end;
xStream.Free;
end;
end;
end;
class function Tlayer.CreateFromStream(Stream: TStream;aDEngine: TPCDrawEngine;CadControl:TObject): TLayer;
var res:TLayer;
xSize,cSize: Integer;
xCode: Byte;
intVal: integer;
byteVal: byte;
strVal: string;
Buffer:pByte;
CStream:TStream;
Cad:TPCDrawing;
begin
res := TLayer.create('');
res.DrawEngine := aDengine;
xSize:= Stream.Size;
Cad := TPCDrawing(CadControl);
if assigned(Cad) and assigned(Cad.OnLayerInitData) then
Cad.OnLayerInitData(Cad,res);
Repeat
Stream.Read(xCode,1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal,4);
res.SetLayerPropertyInt(xCode,intVal);
end
else if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal,1);
res.SetLayerPropertyInt(xCode,byteVal);
end
else if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(cSize,4);
CStream := TMemoryStream.Create;
getmem(buffer,cSize);
Stream.Read(buffer^,cSize);
CStream.Write(pByte(buffer)^,cSize);
FreeMem(Buffer,cSize);
CStream.Position := 0;
res.SetLayerPropertyStream(xCode,CStream,CadControl);
CStream.Free;
end
else if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
res.SetLayerPropertyStr(xCode,strval);
end;
until Stream.Position = xSize;
result := res;
end;
procedure Tlayer.SetLayerPropertyDbl(xCode: Byte; Value: Double);
begin
end;
procedure Tlayer.SetLayerPropertyInt(xCode: Byte; Value: Integer);
begin
case XCode of
21: Tag := Value;
22: LayerWidth := Value;
23: LayerHeight := Value;
90: Visible := TShow(Value);
24: begin
if Value = 0 then
IsDxf := true
else
IsDxf := false;
end;
end;
end;
procedure Tlayer.SetLayerPropertyStr(xCode: Byte; Value: String);
begin
case XCode of
180: Name := Value;
181: Description := Value;
end;
end;
//******************************************************************************
// END
//******************************************************************************
(* ========================================================================== *)
// TFIGURE IMPLEMENTATION //
(* ========================================================================== *)
constructor TFigure.create(LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
var
a: integer;
ClassNameIndex: Integer;
begin
inherited create;
FClassIndex := 0;
//ClassNameIndex := ClassIndexes.IndexOf(ClassName);
//if ClassNameIndex <> -1 then
// FClassIndex := Integer(ClassIndexes.Objects[ClassNameIndex]);
// Tolik
TracePoint := nil;
//
DimLines := TList.Create;
CreateDims := False;
InCombined := False;
FullHitTest := False;
SelOrder := 0;
FPointEvent := False;
CustomStream := nil;
Owner:= AOwner;
LayerHandle:= LHandle;
DrawStyle := aDrawStyle;
angletoPoint := 0;
angle := 0;
pointcount := 0;
rotPoint := DoublePoint(0,0);
SetLength(Originals,0);
SetLength(Actuals,0);
width := -1;
style := -1;
rowstyle := -1;
brs := -1;
brc := -1;
Reghandle := 0;
Modified := True;
Handle := LongInt (Self);
selected := False;
//SelPoints := TList.Create;
SelPoints := TMyList.Create; // Tolik 24/12/2019 --
FirstSelected := false;
Rename;
SelectedPoint := 1;
JoinedFigures := TList.Create;
fLockMove := False;
fLockModify := False;
fDiagonal := False;
FlockSelect := False;
Deleted := False;
if (owner<>nil) then
begin
vertZero := ord(TPCDrawing(owner).VerticalZero);
horzZero := ord(TPCDrawing(owner).HorizontalZero);
end;
isOp := false;
oldStyleLoad := false;
rMode := False;
Data := nil;
Info := '';
DrawInfo := False;
isDrawingDetail := False;
ClipFigures := TList.Create;
NativeFill := False;
ExHatchStepSize := 2;
ExTextureSize := 2;
ExFillBackColor := clNone;
InClip := False;
Parent := nil; //28.04.2011
FBeforeAllScale := nil; //27.05.2011
FAfterAllScale := nil; //27.05.2011
//FAfterScalingBeforeEvents := nil; //23.09.2011
FScaleAllEvent := nil; //27.05.2011
FBeforeDelFromParent := nil; //22.09.2011
FAfterUndo := nil;
ZeroMemory(@FBoundRect, SizeOf(TDoubleRect)); //31.10.2011
FIsLoadedBounds := false; //31.10.2011
NotNeedToDraw := False; //29.01.2014
//Tolik
RegObject := nil;
Transparency := 0; // Tolik 26/05/2017 --
isAutoCreatedFigure := 0;
end;
Class Function TFigure.ShadowType:TShadowType;
begin
result := stNone;
end;
class function TFigure.IsOneClick: Boolean;
begin
result := false;
end;
class function TFigure.InsideSelection: Boolean;
begin
result := false;
end;
procedure TFigure.Initialize;
begin
//Tollk 24/10/2017 --
id := -1;
id_for_dellist := -1;
if Self.Owner <> nil then
begin
Inc(TPowerCad(Self.Owner).FLastFigureId);
id := TPowerCad(Self.Owner).FLastFigureId;
end;
{ID := CreateUniqueId;}
//
Icon := nil;
IconX := 0;
IconY := 0;
IconVertPos := vposTop;
IconHorzPos := hposLeft;
Urc := 0;
DataId := 0;
PopStyle := fpsAppendCustom;
CustomPops := '';
Visible := True;
NativeFill := False;
FIsLoadedBounds := false; //30.01.2012
end;
function TFigure.Rename: String;
begin
Name := Copy(ClassName,2,length(classname)) + Inttostr(Handle);
CName := Copy(ClassName,1,length(classname));
Result := Name;
end;
function TFigure.Edit: Boolean;
var cad:TPCDrawing;
begin
result := false;
if assigned(Owner) then begin
Cad := TPCDrawing(Owner);
if Assigned(Cad.OnFigureEdit) then begin
cad.OnFigureEdit(Cad,Self);
end;
end;
end;
Class Function TFigure.CreateShadow(x, y: Double): TFigure;
var points: array [0..1] of TPoint;
begin
result := nil;
case ShadowType of
stNone : result := nil;
stLine: result := TLine.Create(x,y,x,y,1,1,clLime,ord(rsNone),0,dsTrace,nil);
stRectangle: result := TRectangle.create(x,y,x,y,1,1,clLime,1,clWhite,0,dsTrace,nil);
stCircle:result := TCircle.create(x,y,0,1,1,clLime,1,clWhite,0,dsTrace,nil);
end;
end;
function TFigure.ShadowClick(ClickIndex:Integer;x,y: Double): Boolean;
begin
result := false;
end;
function TFigure.ShadowTrace(ClickIndex:Integer; x, y: Double): Boolean;
begin
end;
class function TFigure.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
result := nil;
end;
function TFigure.CreateModification: TFigure;
var x1,x2,y1,y2,x3,y3,x4,y4: Double;
a: integer;
points: TDoublePointArr;
st: TShadowType;
begin
x1 := ActualPoints[1].x;
x2 := ActualPoints[2].x;
x3 := ActualPoints[3].x;
x4 := ActualPoints[4].x;
y1 := ActualPoints[1].y;
y2 := ActualPoints[2].y;
y3 := ActualPoints[3].y;
y4 := ActualPoints[4].y;
if (self is TBmpObject) and TBMpObject(self).Skewed then st := stPolyline else st := ShadowType;
case st of
stNone : result := nil;
stLine: result := TLine.Create(x1,y1,x2,y2,1,1,clLime,ord(rsNone),0,dsTrace,nil);
stRectangle: begin
result := TRectangle.create(x1,y1,x3,y3,1,1,clLime,1,clWhite,0,dsTrace,nil);
result.actualpoints[1] := actualpoints[1];
result.actualpoints[2] := actualpoints[2];
result.actualpoints[3] := actualpoints[3];
result.actualpoints[4] := actualpoints[4];
result.DiagonalScale := DiagonalScale;
end;
stCircle:result := TCircle.create(x1,y1,Radius,1,1,clLime,1,clWhite,0,dsTrace,nil);
stPolyline : begin
SetLength(points,pointcount);
for a:= 1 to PointCount do
points[a-1] := ActualPoints[a];
result := TPolyline.create(points,1,1,clLime,1,clWhite,ord(rsNone),True,0,dsTrace,nil);
end;
end;
if assigned(result) then result.RotPoint := RotPoint;
end;
function TFigure.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;x, y: Double;Shift: TShiftState): boolean;
begin
if assigned (Tracefigure) then TraceFigure.TraceModification(CadControl,mp,TraceFigure,x,y,shift);
end;
Function TFigure.TraceRotate(CadControl: Pointer;mp:TModPoint;var TraceFigure:TFigure;
x,y:Double;Shift: TShiftState):boolean;
var a1,a2,a: Double;
s: Integer;
begin
if mp.SeqNbr = 5 then begin
TraceFigure.RotPoint := DoublePoint(x,y);
end else begin
a1 := GetRadOfLine(TraceFigure.rotPoint,DoublePoint(mp.CoordX ,mp.CoordY));
a2 := GetRadOfLine(TraceFigure.rotPoint,DoublePoint(x,y));
TraceFigure.Free;
TraceFigure := CreateModification;
a := a2-a1;
s := sign(a);
a := abs(a);
if abs(a - 0) < (pi/180)*5 then a := 0;
if abs(a - pi/2) < (pi/180)*5 then a := pi/2;
if abs(a - pi) < (pi/180)*5 then a := pi;
if abs(a - 3*(pi/2)) < (pi/180)*5 then a := 3*(pi/2);
if abs(a - 2*pi) < (pi/180)*5 then a := 2*pi;
TraceFigure.Rotate(s*a,TraceFigure.RotPoint);
end;
end;
function TFigure.EndRotate(CadControl: Pointer;mp: TModPoint; TraceFigure: TFigure; x,
y: Double;Shift: TShiftState): boolean;
var a1,a2,a: Double;
s: Integer;
begin
if mp.SeqNbr = 5 then begin
RotPoint := TraceFigure.RotPoint;
end else begin
a1 := GetRadOfLine(rotPoint,DoublePoint(mp.CoordX ,mp.CoordY));
a2 := GetRadOfLine(rotPoint,DoublePoint(x,y));
a := a2-a1;
s := sign(a);
a := abs(a);
if abs(a - 0) < (pi/180)*5 then a := 0;
if abs(a - pi/2) < (pi/180)*5 then a := pi/2;
if abs(a - 3*(pi/2)) < (pi/180)*5 then a := 3*(pi/2);
if abs(a - pi) < (pi/180)*5 then a := pi;
if abs(a - 2*pi) < (pi/180)*5 then a := 2*pi;
Rotate(s*a,RotPoint);
end;
end;
function TFigure.EndModification(CadControl: Pointer;mp: TModPoint; TraceFigure: TFigure; x,
y: Double;Shift: TShiftState): boolean;
var ap: TDoublepoint;
a: integer;
st: TShadowType;
begin
if (self is TBmpObject) and TBMpObject(self).Skewed then st := stPolyline else st := ShadowType;
case st of
stLine:
begin
ap := actualpoints[mp.SeqNbr];
ActualPoints[mp.SeqNbr] := DoublePoint(ActualPoints[mp.SeqNbr].x + (x-ap.x),
ActualPoints[mp.SeqNbr].y + (y-ap.y));
end;
stRectangle:
For a := 1 to PointCount do
begin
ap := ActualPoints[a];
ActualPoints[a] :=
DoublePoint(
ActualPoints[a].x+(TraceFigure.ActualPoints[a].x- ap.x),
ActualPoints[a].y+(TraceFigure.ActualPoints[a].y- ap.y)
);
end;
stCircle: Radius := TraceFigure.Radius;
stPolyline : begin
ap := actualpoints[mp.SeqNbr];
ActualPoints[mp.SeqNbr] := DoublePoint(ActualPoints[mp.SeqNbr].x + (x-ap.x),
ActualPoints[mp.SeqNbr].y + (y-ap.y));
end;
end;
ResetRegion;
Modified := True;
end;
procedure TFigure.select;
begin
if selected then exit;
selected := true;
SelPoints.Pack;
SelPoints.Clear;
SelFeed := SelFeed+1;
SelOrder := SelFeed;
if rMode then
begin
GetRotatePoints(SelPoints);
end
else
begin
GetModPoints(SelPoints);
end;
if assigned(owner) then
begin
TPCDrawing(owner).FAnySelected := True;
end;
end;
Procedure TFigure.RotateSelect;
var figMaxX,figMaxY,figMinX,figMinY:Double;
begin
if selected then Deselect;
RMode := True;
getbounds(figMaxX,figMaxY,figMinX,figMinY);
RotPoint := DoublePoint((figMaxX+figMinX)/2,(figMaxY+figMinY)/2);
Select;
end;
procedure TFigure.deselect;
var
CControl: TPCDrawing;
a: integer;
begin
if not selected then
exit;
selected := false;
SelOrder := 0;
FirstSelected := false;
CControl := TPCDrawing(owner);
try
SelPoints.Pack; // Tolik 24/12/2019 --
For a := 0 to SelPoints.count - 1 do
begin
CControl.UnRegisterModPoint(SelPoints[a]);
end;
SelPoints.Pack; //// Tolik 24/12/2019 --
SelPoints.clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.deselect' + E.Message);
end;
end;
procedure TFigure.ReSelect;
var
CControl: TPCDrawing;
a: integer;
begin
if not selected then
exit;
CControl := TPCDrawing(owner);
try
SelPoints.Pack; // Tolik 24/12/2019 --
For a := 0 to SelPoints.count - 1 do
begin
CControl.UnRegisterModPoint(SelPoints[a]);
end;
SelPoints.clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.ReSelect' + E.Message);
end;
if rMode then
GetRotatePoints(SelPoints)
else
GetModPoints(SelPoints);
if assigned(owner) then
begin
TPCDrawing(owner).FAnySelected := True;
end;
end;
Procedure TFigure.ReSelectUnsel; //02.04.2012
var
CControl: TPCDrawing;
a: integer;
begin
if not selected then
exit;
CControl := TPCDrawing(owner);
SelPoints.Pack; // Tolik 24/12/2019
For a := 0 to SelPoints.count - 1 do
begin
CControl.UnRegisterModPoint(SelPoints[a]);
end;
SelPoints.clear;
end;
Procedure TFigure.ReSelectSel; //02.04.2012
begin
if not selected then
exit;
if rMode then
GetRotatePoints(SelPoints)
else
GetModPoints(SelPoints);
if assigned(owner) then
begin
TPCDrawing(owner).FAnySelected := True;
end;
end;
Procedure TFigure.drawselectionpoints(DEngine: TPCDrawEngine;isGrayed:Boolean);
var a : integer;
pt : TModPoint;
aColor : TColor;
x,y,z: Double;
begin
For a := 0 to SelPoints.Count -1 do
begin
pt := TModPoint(SelPoints[a]);
if (isDrawingDetail) or (not pt.OnlyIso) then
begin
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
aColor := pt.Color;
DrawSelPoint(DEngine,isGrayed,pt);
x := pt.CoordX;
y := pt.CoordY;
z := pt.CoordZ;
DEngine.ConvertPoint(x,y,z);
if isDrawingDetail then
begin
pt.PixDetX := Round(x);
pt.PixDetY := Round(y);
end
else
begin
pt.PixX := Round(x);
pt.PixY := Round(y);
end;
end;
end;
end;
procedure TFigure.DrawFigureGuides(DEngine: TPCDrawEngine);
var fRect: TDoubleRect;
p : TDoublePoint;
Cad: TPowercad;
xInfo: String;
begin
if assigned(Icon) then
begin
fRect := GetBoundRect;
DEngine.DrawFigureIcon(fRect,IconX,IconY,IconVertPos,IconHorzPos,Icon);
end;
xInfo := Info;
if assigned(owner) then begin
Cad := TPowercad(Owner);
if assigned(Cad.OnDrawFigureInfo) then Cad.OnDrawFigureInfo(Cad,Self,xInfo);
end;
if (xInfo <> '') and DrawInfo then
begin
fRect := GetBoundRect;
p := DoublePoint(((Frect.left+frect.right)/2),frect.bottom+3);
Dengine.DrawCenteredText(p,ClBlack,xInfo,'Tahoma',4.0);
end;
end;
Procedure TFigure.ModifySelection(mm: TModifyMode; value: Integer);
Begin
case mm of
mmPenColor : Color := value;
mmPenWidth : Width := value;
mmPenStyle : Style := value;
mmBrushStyle : brs := value;
mmBrushColor : brc := value;
mmRowStyle : RowStyle := value;
end;
End;
Function TFigure.ModifyTextAndFont(mm: TModifyMode; valueI: double;
valueS: string; valueSt: TFontStyles;ValueB:Boolean):Boolean;
Begin
result := false;
end;
procedure TFigure.ResetRegion;
var
i: Integer;
begin
if RegHandle <> 0 then
DeleteObject(RegHandle);
RegHandle := 0;
//Tolik
if RegObject <> nil then
begin
if RegObject.RegObjData <> nil then
begin
GlobalFreePtr(RegObject.RegObjData);
RegObject.RegObjData := nil;
end;
FreeAndNil(RegObject);
end;
//
for i := 0 to ClipFigures.Count - 1 do
begin
TFigure(ClipFigures[i]).ResetRegion;
end;
end;
procedure TFigure.WriteToStream(Stream: TStream);
var
xInt,a,LNbr: Integer;
aPoints: pInt;
xDouble: Double;
xByte: Byte;
IStream,xStream,fStream: TMemoryStream;
DimLine:TFigure;
fSize:Integer;
begin
WriteString(Stream,ClassName);
try
WriteString(Stream, Name);
except
on E: Exception do
begin
addExceptionToLogEx('TFigure.WriteToStream (Name)', E.Message);
Name := Copy(ClassName, 2, length(classname)) + Inttostr(Handle);
WriteString(Stream, Name);
end;
end;
if assigned(Owner) then
LNbr := TPCDrawing(Owner).Layers.IndexOf(Pointer(LayerHandle))
else
LNbr := 0;
xByte := 0;
if fDiagonal then
xByte := 1;
WriteField(90,Stream,xByte,1);
//IGOR 22/11/2019 --
if RowStyle = -1 then
xByte := 255
else
xByte := LoByte(LoWord(RowStyle));
//
WriteField(91,Stream,xByte,1);
xByte := DimLines.Count;
WriteField(92,Stream,xByte,1);
xByte := ord(ExHatchStyle);
WriteField(93,Stream,xByte,1);
xByte := ord(ExGradStyle);
WriteField(94,Stream,xByte,1);
xByte := ord(ExTextureStyle);
WriteField(95,Stream,xByte,1);
// Tolik -- 30/05/2017 --
xByte := isAutoCreatedFigure;
WriteField(253,Stream,xByte,1);
//
xInt:= Lnbr;
WriteField(21,Stream,xInt,4);
xDouble:= AngleToPoint;
WriteField(220,Stream,xDouble,8);
xDouble:= Angle;
WriteField(221,Stream,xDouble,8);
xDouble:= Radius;
WriteField(222,Stream,xDouble,8);
xDouble:= ExHatchStepSize;
WriteField(223,Stream,xDouble,8);
xInt:= PointCount;
WriteField(24,Stream,xInt,4);
xInt:= Width;
WriteField(26,Stream,xInt,4);
xInt:= Color;
WriteField(27,Stream,xInt,4);
xInt:= Style;
WriteField(28,Stream,xInt,4);
xInt:= ID;
WriteField(29,Stream,xInt,4);
xInt:= LongInt(Data);
WriteField(30,Stream,xInt,4);
xInt:= DataID;
WriteField(31,Stream,xInt,4);
xInt:= ExFillBackColor;
WriteField(32,Stream,xInt,4);
xInt:= ExTextureSize;
WriteField(33,Stream,xInt,4);
// Tolik -- write Transparency -- begin using free indexes from 254 downto .... if needed
xInt:= Transparency;
WriteField(254,Stream,xInt,4);
//
GetMem(aPoints, PointCount * 16);
For a := 1 to PointCount do
begin
// Tolik 26/03/2019 --
//pDouble(pChar(aPoints) + ((a - 1) * 16) + 0)^ := ActualPoints[a].x;
//pDouble(pChar(aPoints) + ((a - 1) * 16) + 8)^ := ActualPoints[a].y;
pDouble(pAnsiChar(aPoints) + ((a - 1) * 16) + 0)^ := ActualPoints[a].x;
pDouble(pAnsiChar(aPoints) + ((a - 1) * 16) + 8)^ := ActualPoints[a].y;
//
end;
WriteBinField(152,Stream,pByte(aPoints),PointCount*16);
FreeMem(aPoints,PointCount*16);
if assigned(customStream) then
begin
WriteStreamField(153,Stream,customStream);
end;
if assigned(Icon) then
begin
IStream := TmemoryStream.Create;
Icon.SaveToStream(IStream);
WriteStreamField(154,Stream,IStream);
IStream.Free;
end;
xStream := TMemoryStream.Create;
xStream.Write(DimLines.Count,4);
for a := 0 to Dimlines.Count - 1 do begin
fStream := TMemoryStream.Create;
DimLine := TFigure(Dimlines[a]);
DimLine.WriteToStream(fStream);
fSize := fStream.Size;
fStream.Position := 0;
xStream.Write(fSize,4);
StreamToStream(fStream,xStream,fSize);
fStream.Free;
end;
WriteStreamField(155,Stream,xStream);
xStream.Free;
WriteStrField(181,Stream,Info);
WriteStrField(182,Stream,UserClass);
WriteStrField(180,Stream,'BaseEnd');
end;
class function TFigure.CreateFromStream(Stream: TStream; LHandle: Integer;
aDrawStyle: TDrawStyle; aOwner: TComponent): TFigure;
var
TypeName: string;
a: integer;
FigClass: TFigureClass;
res: Tfigure;
FigIdx: integer;
begin
TypeName := ReadStringFromStream(Stream);
figClass := nil;
//01.11.2011
{for a := 0 to FigureClasses.Count -1 do
begin
if TFigureClass(FigureClasses[a]).ClassName = TypeName then
FigClass := TFigureClass(FigureClasses[a]);
end;}
FigIdx := FigureClassesSL.IndexOf(TypeName); //01.11.2011
if FigIdx <> -1 then //01.11.2011
FigClass := TFigureClass(FigureClassesSL.Objects[FigIdx]);
if figclass = nil then
begin
result := nil;
exit;
end
else
begin
res := FigClass.Create(LHandle,aDrawStyle,aOwner);
res.fPointEvent := True;
// Tolik - - ïîâòîðíàÿ èíèöèàëèçàöèÿ íóæíà, èíà÷å áóäåò ïèñåö ... ÍÅ ÒÐÎÃÀÒÜ!!!
res.Initialize;
//
res.SetPropertiesFromStream(Stream);
//if res.CreateDims then res.CreateDimLines;
end;
result := res;
end;
Procedure TFigure.SetPropertiesFromStream(Stream: TStream);
var
isOk: Boolean;
xCode, xSize, a, x, y, t, cpCount: Integer;
xd,yd: Double;
intVal: Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
LNbr: integer;
xByte: pByte;
Buffer: pByte;
IStream, xStream: TMemoryStream;
pCnt: Integer;
// Tolik -- 12/10/2017
streamsize, streamPos: Integer;
myStream: TfileStream;
// Tolik 13/10/2017
// ×òî êàñàåòñÿ ïîäúåìà ôèãóðû ñî ñòðèìà:
// Ñòàíäàðòíî ïðåäïîëàãàåòñÿ ñëåäóþùàÿ ïîñëåäîâàòåëüíîñòü êîäîâ ñî çíà÷åíèÿìè â îäèí áàéò 90,91,92,93...
// ÍÎ! Íåêîòîðûå êîìïîíåíòû â áàçå çàïèñàíû íå òàê, à ïî-ñòàðîìó, è òàì âûõîäèò ÷òî-òî òèïà: 90,91..à äàëüøå 21...è ÷òî-òî òàì åùå,
// íî íèêàê íå 93
// âîò òàêàÿ âîò öåïî÷êà... ïîýòîìó äëÿ ïðîâåðêè ìîæíî òî÷íî îïðåäåëèòüñÿ òîëüêî äî òðåòüåãî áàéòà (90, 91, à ïîòîì 92 èëè 21)
function CanLoadFigureFromStream: boolean;
var CodeSequence: String;
SeekCode: Integer;
begin
Result := False;
CodeSequence := '';
SeekCode := 90;
if Stream.Position >= Stream.Size - 1 then
begin
AddExceptionToLogEX('TFigure.SetPropertiesFromStream: ' , ' No code 90 after name (end stream)!' + #13#10 + 'CadName = ' + GCadForm.Name +
#13#10 + 'FigureClassName: '+ Self.ClassName + ' FigureName: '+ Name);
//Inc(GExceptionCount);
exit;
end;
Stream.Read(xCode, 1);
if xCode <> 90 then
begin
if (Self is TFigureGrp) then
exit;
AddExceptionToLogSilent('TFigure.SetPropertiesFromStream: No code 90 after name!' + #13#10 + 'CadName = ' + GCadForm.Name +
#13#10 + 'FigureClassName: '+ Self.ClassName + ' FigureName: '+ Name);
//Inc(GExceptionCount);
//AddExceptionToLogSilent('TFigure.SetPropertiesFromStream: ' + ' No correct code sequence!' + #13#10 + 'CadName = ' + GCadForm.Name +
// #13#10 + 'FigureClassName: '+ Self.ClassName + ' FigureName: '+ Name);
(*
StreamPos := Stream.Position;
Stream.Position := 0;
Mystream := TfileStream.Create('d:\stream.txt', fmCreate);
Mystream.CopyFrom(Stream, StreamSize);
Mystream.free;
Stream.Position := StreamPos;
*)
While Stream.Position < (Stream.Size - 2) do
begin
if xCode <> 90 then
begin
Stream.Read(xCode, 1);
end
else
begin
StreamPos := Stream.Position;
Stream.Position := Stream.Position + 1;
if Stream.Position <= StreamSize - 9 then
begin
Stream.Read(xCode, 1);
if xCode = 91 then
begin
Stream.Position := Stream.Position + 1;
Stream.Read(xCode, 1);
if (xCode = 92) or (xCode = 21) then
begin
//Stream.Position := Stream.Position + 1;
// Stream.Read(xCode, 1);
// if xCode = 93 then
// begin
Result := True;
Stream.Position := Stream.Position - 5; // -7
exit;
// end;
end;
end;
end;
Stream.Position := StreamPos;
Stream.Read(xCode, 1);
end;
end;
end
else
begin
StreamPos := Stream.Position;
Stream.Position := Stream.Position + 1;
if Stream.Position <= StreamSize - 9 then
begin
Stream.Read(xCode, 1);
if xCode = 91 then
begin
Stream.Position := Stream.Position + 1;
Stream.Read(xCode, 1);
if (xCode = 92) or (xCode = 21) then
begin
//Stream.Position := Stream.Position + 1;
// Stream.Read(xCode, 1);
// if xCode = 93 then
// begin
Result := True;
Stream.Position := Stream.Position - 5;
exit;
// end;
end;
end;
end;
Stream.Position := StreamPos;
Stream.Read(xCode, 1);
While Stream.Position < (Stream.Size - 2) do
begin
if xCode <> 90 then
begin
Stream.Read(xCode, 1);
end;
if xCode = 90 then
begin
StreamPos := Stream.Position;
Stream.Position := Stream.Position + 1;
if Stream.Position <= StreamSize - 9 then
begin
Stream.Read(xCode, 1);
if xCode = 91 then
begin
Stream.Position := Stream.Position + 1;
Stream.Read(xCode, 1);
if (xCode = 92) or (xCode = 21) then
begin
//Stream.Position := Stream.Position + 1;
//Stream.Read(xCode, 1);
//if xCode = 93 then
//begin
Result := True;
Stream.Position := Stream.Position - 5;
break;
//end;
end;
end;
end;
Stream.Position := StreamPos;
Stream.Read(xCode, 1);
end;
if Result then
exit;
end;
end;
end;
//
begin
try
isOk := False;
// Tolik -- 12/10/2017 --
StreamSize := Stream.Size;
StreamPos := Stream.Position;
//
try
Name := ReadStringFromStream(Stream);
LNbr := -1;
xCode := 0;
RegHandle := 0;
{if self is TLine then
begin
StreamPos := Stream.Position;
Stream.Position := 0;
Mystream := TfileStream.Create('d:\stream_line.txt', fmCreate);
Mystream.CopyFrom(Stream, StreamSize);
Mystream.free;
Stream.Position := StreamPos;
end;
if (StreamSize = 210) then
xCode := 0;}
// Tolik -- 12/10/2017 --
if CanLoadFigureFromStream then
begin
//
repeat
// Tolik -- 12/10/2017 --
StreamPos := Stream.Position;
if StreamPos = StreamSize then
begin
{Stream.Position := 0;
Mystream := TfileStream.Create('d:\stream.txt', fmCreate);
Mystream.CopyFrom(Stream, StreamSize);
Mystream.free;}
AddExceptionToLogEx('TFigure.SetPropertiesFromStream:', 'Can not load Figure. The stream is corrupted (not found BaseEnd)!' + #13#10 + 'CadName = ' + GCadForm.Name +
#13#10 + 'FigureClassNameName: '+ Self.ClassName + ' FigureName: '+ Name);
isOk := True;
break;
end;
//
Stream.Read(xCode, 1);
if (((xCode >= 20) and (xCode < 90)) or (xCode = 254)) then
begin
Stream.Read(intVal, 4);
Case xcode of
21: Lnbr := IntVal;
22: AngleToPoint := ((intVal / 10) / 180) * pi; // in old format
23: Angle := ((intVal / 10) / 180) * pi; // in old format
24: PointCount := intVal;
25: cpCount := intval; // it was ControlPoint Count in old format
26: Width := intVal;
27: Color := intVal;
28: Style := intVal;
29: ID := intVal;
30: Data := Pointer(intVal);
31: DataId := intVal;
32: ExFillBackColor := intVal;
33: ExTextureSize := intVal;
// Tolik -- Transparency 30/05/2017 --
254: Transparency := IntVal;
//
end;
end
else
if (((xCode >= 90) and (xCode < 120)) or (xCode = 253)) then
begin
Stream.Read(byteVal, 1);
Case xcode of
90: DiagonalScale := (byteVal = 1);
91: begin
if byteVal = 255 then
RowStyle := -1
else
RowStyle := byteVal;
end;
92: if byteVal > 0 then
CreateDims := True
else
CreateDims := False;
93: ExHatchStyle := THatchStyle(byteVal);
94: ExGradStyle := TGradStyle(byteVal);
95: ExTextureStyle := TTextureStyle(byteVal);
// Tolik 30/05/2017 -*-
253: isAutoCreatedFigure := byteVal;
//
end;
end
else
if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal, 2);
end
else
if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize,4);
Case xcode of
150: begin // in old format
OldStyleLoad := True;
for a := 1 to PointCount do
begin
Stream.read(x,4);
Stream.read(y,4);
ActualPoints[a] := DoublePoint(x/10,y/10);
end;
end;
151: begin
// was control points in old format
if Self is TPolyLine then
begin
SetLength(fTempPoints,cpCount);
for a := 1 to cpCount do
begin
Stream.read(x,4);
Stream.read(y,4);
fTempPoints[a-1] := Point(x,y);
end;
end
else
begin
GetMem(xByte,xSize);
Stream.read(xByte^,xSize);
FreeMem(xByte,xSize);
end;
end;
152: begin
pCnt := xSize div 16;
PointCount := pCnt;
for a := 1 to pCnt do
begin
// Tolik 22/06/2021 -- ïîïûòêà èñêëþ÷èòü ìóñîð
//Stream.read(xd,8); // <--- òàê áûëî ...
//Stream.read(yd,8);} // <--- òàê áûëî ...
Stream.read(xd,8);
if CompareValue(xd, 0, 0.0000001) = 0 then
xd := 0;
Stream.read(yd,8);
if CompareValue(yd, 0, 0.0000001) = 0 then
yd := 0;
//
ActualPoints[a] := DoublePoint(xd,yd);
end;
end;
153: begin
CustomStream := TMemoryStream.Create;
getmem(buffer,xSize);
Stream.Read(buffer^,xSize);
CustomStream.Write(pByte(buffer)^,xsize);
FreeMem(Buffer,xSize);
CustomStream.Position := 0;
CustomStream.Free;
end;
154: begin
IStream := TMemoryStream.Create;
getmem(buffer,xSize);
Stream.Read(buffer^,xSize);
IStream.Write(pByte(buffer)^,xsize);
FreeMem(Buffer,xSize);
IStream.Position := 0;
Icon := Tbitmap.Create;
Icon.LoadFromStream(IStream);
IStream.Free;
end;
155: begin
XStream := TMemoryStream.Create;
getmem(buffer,xSize);
Stream.Read(buffer^,xSize);
XStream.Write(pByte(buffer)^,xsize);
FreeMem(Buffer,xSize);
XStream.Position := 0;
CreateDimLinesFromStream(xStream,0,Owner);
xStream.Free;
end;
else
begin
try
GetMem(xByte, xSize);
Stream.read(xByte^, xSize);
FreeMem(xByte, xSize);
except
isOK := True;
//GProcCnt := GProcCnt + 1;
end;
end;
end;
end
else
if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
if xCode = 181 then
Info := strval;
if xCode = 182 then
UserClass := strval;
if strval = 'BaseEnd' then
isOk := true;
end
else
if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval, 8);
//Tolik 22/06/2021 -- ñáðîñèòü ìóñîð -- åñëè ïîïàäåòñÿ
if CompareValue(dblval, 0, 0.0000001) = 0 then
dblval := 0;
//
Case xcode of
220: AngleToPoint := dblval;
221: Angle := dblval;
222: Radius := dblval;
223: ExHatchStepSize := dblval;
end;
end;
until isOk;
end
else
begin
AddExceptionToLogEX('TFigure.SetPropertiesFromStream: ' , 'Can not load Figure. The stream is corrupted!' + #13#10 + 'CadName = ' + GCadForm.Name +
#13#10 + 'FigureClassNameName: '+ Self.ClassName + ' FigureName: '+ Name);
//Inc(GExceptionCount);
//Self.Select;
exit;
end;
if (Owner <> nil) and (Lnbr >= 0) and (Lnbr < TPCDrawing(Owner).Layers.Count) then
begin
LayerHandle := LongInt(TPCDrawing(Owner).Layers[Lnbr])
end;
SetSpecialPropertiesFromStream(Stream);
except
on E: Exception do addExceptionToLogEX('Exception TFigure.SetPropertiesFromStream: ' , 'Can not load Figure. The stream is corrupted!' + #13#10 + 'CadName = ' + GCadForm.Name +
#13#10 + 'FigureClassNameName: '+ Self.ClassName + ' FigureName: '+ Name);
end;
finally
// Tolik -- 25/10/2017 --
if Self.Owner <> nil then
begin
if TPowerCad(Self.Owner).FLastFigureIdOnLoad < Self.ID then
TPowerCad(Self.Owner).FLastFigureIdOnLoad := Self.ID;
end;
//
end;
end;
procedure TFigure.SetSpecialPropertiesFromStream(Stream: TStream);
var xCode,xSize,a,x,y: Integer;
intVal : Integer;
byteVal: Byte;
wordVal: Word;
strVal: string;
dblval: Double;
Config: TRoomConfig;
//p: pchar;
buffer: pByte;
xStream: TMemoryStream;
begin
xCode := 0;
repeat
Stream.Read(xCode,1);
if (xCode >= 20) and (xCode < 90) then
begin
Stream.Read(intVal,4);
SetPropertyFromStream(xCode,@intVal,4);
end
else if (xCode >= 90) and (xCode < 120) then
begin
Stream.Read(byteVal,1);
SetPropertyFromStream(xCode,@byteVal,1);
end
else if (xCode >= 120) and (xCode < 150) then
begin
Stream.Read(wordVal,2);
SetPropertyFromStream(xCode,@wordVal,2);
end
else if (xCode >= 150) and (xCode < 180) then
begin
Stream.Read(xSize,4);
getmem(buffer,xSize);
Stream.Read(buffer^,xSize);
SetPropertyFromStream(xCode,buffer,xSize);
FreeMem(Buffer,xSize);
end
else if (xCode >= 180) and (xCode < 220) then
begin
strval := ReadStringFromStream(Stream);
SetPropertyFromStream(xCode,pchar(strval),0);
end
else if (xCode >= 220) and (xCode < 240) then
begin
Stream.Read(dblval,8);
//Tolik 22/06/2021 -- ñáðîñèòü ìóñîð -- åñëè ïîïàäåòñÿ
if CompareValue(dblval, 0, 0.0000001) = 0 then
dblval := 0;
//
SetPropertyFromStream(xCode,@dblVal,8);
end
else
if (xCode >= 240) and (xCode < 245) then
begin
Stream.Read(Config,SizeOF(Config));
SetPropertyFromStream(xCode,@Config,SizeOF(Config));
end
until Stream.Position = Stream.Size;
end;
procedure TFigure.SetPropertyFromStream(xCode: Byte; data: pointer;size:integer);
begin
end;
procedure TFigure.GetVectorObjects(Objects:Tlist;BaseP: TDoublePoint);
begin
end;
Procedure TFigure.VerifyZeroPoints(orgV,orgH:Byte);
var cad :TPCdrawing;
h,w:Double;
x,y:double;
i: Integer;
begin
if assigned(owner) then
begin
cad := TPCDrawing(owner);
h := Cad.WorkHeight;
w := Cad.WorkWidth;
if orgV <> VertZero then
begin
for i := 1 to PointCount do
begin
x := ActualPoints[i].x;
y := ActualPoints[i].y;
ActualPoints[i] := DoublePoint(x,h-y);
OriginalPoints[i] := ActualPoints[i];
end;
end;
if orgH <> HorzZero then
begin
for i := 1 to PointCount do
begin
x := ActualPoints[i].x;
y := ActualPoints[i].y;
ActualPoints[i] := DoublePoint(w-x,y);
OriginalPoints[i] := ActualPoints[i];
end;
end;
end;
end;
Function TFigure.GetOrig(index: integer): TDoublePoint;
Begin
if index > Length(Originals) then begin
result := DoublePoint(0,0);
exit;
end;
result := Originals[index-1];
End;
Procedure TFigure.SetOrig(index: integer; xpoint: TDoublePoint);
var a:integer;
oSize: Integer;
Begin
oSize := Length(Originals);
if index > OSize then begin
SetLength(Originals,Index);
for a := oSize to index-1 do
begin
Originals[a] := DoublePoint(0,0);
end;
end;
Originals[index-1] := xpoint;
end;
Function TFigure.GetActual(index: integer): TDoublePoint;
Begin
if Length(Actuals) = 0 then begin
result := DoublePOint(0,0);
exit;
end;
if index > Length(Actuals) then begin
index := 1;
end;
result := Actuals[index-1];
End;
Procedure TFigure.SetActual(index: integer; xpoint: TDoublePoint);
var a:integer;
oSize: Integer;
Begin
oSize := Length(Actuals);
if index > OSize then begin
SetLength(Actuals,Index);
for a := oSize to index-1 do
begin
Actuals[a] := DoublePoint(0,0);
if fPointEvent then OnNewPoint;
end;
end;
//31.10.2011
if FIsLoadedBounds then
if (Actuals[index-1].x <> xpoint.x) or (Actuals[index-1].y <> xpoint.y) then
FIsLoadedBounds := false;
Actuals[index-1] := xpoint;
end;
procedure TFigure.GetPointArray(var Arr: TDoublePointArr);
var i: Integer;
begin
SetLength(Arr,PointCount);
for i := 0 to PointCount-1 do
Arr[i] := ActualPoints[i+1];
end;
procedure TFigure.GetPointArray(var Arr: TDoublePointArr; Count: Integer);
var i: Integer;
begin
if Count > PointCount then Count := PointCount;
SetLength(Arr,Count);
for i := 0 to Count-1 do
Arr[i] := ActualPoints[i+1];
end;
function TFigure.GetPoint(index: integer): TDoublePoint;
begin
result := GetActual(index);
end;
procedure TFigure.SetPoint(Index: integer; const Value: TDoublepoint);
begin
SetActual(index,Value);
end;
Function TFigure.GetAp1: TDoublePoint;
begin
result := FigurePoints[1];
end;
Function TFigure.GetAp2: TDoublePoint;
begin
result := FigurePoints[2];
end;
Function TFigure.GetAp3: TDoublePoint;
begin
result := FigurePoints[3];
end;
Function TFigure.GetAp4: TDoublePoint;
begin
result := FigurePoints[4];
end;
Function TFigure.getP1: TDoublePoint;
begin
result := actualpoints[1];
end;
// Tolik -- 07/07/2017 --
function TFigure.getCp: TDoublePoint;
var figMaxX,figMaxY,figMinX,figMinY:Double;
begin
if Self is TFigureGrp then
TFigureGRP(Self).GetBoundsWithoutAutoCreatedFigures(figMaxX,figMaxY,figMinX,figMinY)
else
if Self is TConnectorObject then
TConnectorObject(Self).GetBoundsDef(figMaxX,figMaxY,figMinX,figMinY)
else
getbounds(figMaxX,figMaxY,figMinX,figMinY);
Result := DoublePoint((figMaxX+figMinX)/2,(figMaxY+figMinY)/2);
//Result := DoublePoint(Trunc(((figMaxX+figMinX)/2)*10000)/10000,Trunc(((figMaxY+figMinY)/2)*10000)/10000);
end;
{
function TFigure.getCp: TDoublePoint;
var figMaxX,figMaxY,figMinX,figMinY:Double;
begin
getbounds(figMaxX,figMaxY,figMinX,figMinY);
Result := DoublePoint((figMaxX+figMinX)/2,(figMaxY+figMinY)/2);
end;
}
//
Procedure TFigure.move(deltax,deltay: Double);
var
a: integer;
moveFunc: TFigMoveEvent;
begin
for a:= 1 to pointcount do
begin
originalpoints[a] := DoublePoint(originalpoints[a].x + deltax,
originalpoints[a].y + deltay);
Actualpoints[a] := DoublePoint(actualpoints[a].x + deltax,
actualpoints[a].y + deltay);
end;
RotPoint := DoublePoint(RotPoint.x+deltaX,RotPoint.y+DeltaY);
ResetRegion;
for a := 0 to JoinedFigures.Count-1 do
begin
if TFigure(JoinedFigures[a]) is TLine then
TLine(JoinedFigures[a]).JoinFigureMoved(self,deltax,deltay)
else
if TFigure(JoinedFigures[a]) is TPolyLine then
TPolyLine(JoinedFigures[a]).JoinFigureMoved(self,deltax,deltay);
end;
if DimLines.Count > 0 then
CreateDimLines;
if assigned(Fill) and (assigned(Fill.Grp)) then
Fill.Move(deltaX,deltaY);
MoveClipFigures(deltaX,deltaY);
end;
Procedure TFigure.rotate(aAngle: Double; cPoint: TDoublePoint);
var a: integer;
point1,point2 :TPoint;
begin
If modified or ((cPoint.x <> rotpoint.x) or (cPoint.y <> rotpoint.y)) then
begin
angletoPoint := 0;
for a := 1 to pointcount do originalpoints[a] := actualpoints[a];
rotpoint.x := cPoint.x;
rotpoint.y := cPoint.y;
end;
angletoPoint := angletoPoint + Aangle;
for a:= 1 to pointcount do
begin
actualpoints[a] := RotatePoint(cPoint,originalpoints[a],angletoPoint);
end;
if DimLines.Count > 0 then CreateDimLines;
if assigned(Fill) then Fill.Rotate(aAngle,cPoint);
ResetRegion;
end;
procedure TFigure.scale(px,py: Double; rPoint: TDoublepoint);
var
a: integer;
oldcp, newcp: TDoublePoint;
rt: TRichText;
deltax, deltay: double;
begin
// åñëè TRichText - ïîäîãíàòü øðèôò ïîä îáëàñòü
// Tolik 02/11/2017 -- åñäè òàê îñòàâèòü, òî ïðè ïîïûòêå ñêåéëèíãà ãðóïïîâîé ôèãóðû
// ïîëîìàåòñÿ åå ðàçìåð, ò.ê. åå ðàçìåð íå ìîæåò áûòü ìåíüøå ÷åì ðàçìåð âõîäÿùèõ â íåå ôèãóð
// (÷òî, â ïðèíöèïå, ëîãè÷íî) ò.å. ñêåéëèíã íà óâåëè÷åíèå -- âðîäå áû êàê è íè÷åãî, íî íà óìåíüøåíèå --
// êàê òîëüêî íóæíî áóäåò ñäåëàòü ãðóïïîâóþ ìåíüøå ÷åì âõîäÿùèé â íåå RichText -- òóò æå ïîëó÷èì "áÿêó"
{
if Self.ClassName = 'TRichText' then
begin
// Åñëè TRichText â ãðóïïå íå îäèí
if (Parent = nil) or ((Parent is TFigureGrp) and (TFigureGrp(Parent).InFigures.Count > 1) ) then //28.04.2011
begin
rt := TRichText(Self);
oldcp.x := (rt.ap1.x + rt.ap2.x) / 2;
oldcp.y := (rt.ap1.y + rt.ap3.y) / 2;
newcp := ScalePoint(rPoint, oldcp, px, py);
deltax := newcp.x - oldcp.x;
deltay := newcp.y - oldcp.y;
for a := 1 to pointcount do
begin
actualpoints[a] := DoublePoint(actualpoints[a].x + deltax, actualpoints[a].y + deltay);
originalpoints[a] := DoublePoint(originalpoints[a].x + deltax, originalpoints[a].y + deltay);
end;
exit;
end;
end;
}
for a:= 1 to pointcount do
begin
actualpoints[a] := ScalePoint(rPoint,actualpoints[a],px,py);
originalpoints[a] := ScalePoint(rPoint,originalpoints[a],px,py);
end;
radius := radius * px;
if DimLines.Count > 0 then
CreateDimLines;
if assigned(Fill) then
Fill.Scale(px,py,rPoint);
ResetRegion;
end;
Procedure TFigure.Mirror(Point1,Point2: TDoublePoint);
var a:Integer;
begin
for a:= 1 to pointcount do
begin
actualpoints[a] := GetSymetricPoint(actualpoints[a],Point1,Point2);
originalpoints[a] := GetSymetricPoint(originalpoints[a],Point1,Point2);
end;
if DimLines.Count > 0 then CreateDimLines;
ResetRegion;
end;
procedure TFigure.draw(DEngine: TPCDrawEngine; isGrayed:Boolean);
begin
end;
Procedure TFigure.CollectFaces(Faces:TList);
var
aFace: TFaceRecord;
a3DPointArr: T3DPointArray;
i, j: integer;
Line: TOrthoLine;
GetConn: TConnectorObject;
InFigure: TFigure;
ScaleDelta: double;
begin
//
ScaleDelta := UOMToMetre(1000 / GCadForm.PCad.MapScale);
if (self.ClassName = 'TConnectorObject') or (self.ClassName = 'TOrthoLine') then
begin
SetLength(a3DPointArr, length(self.actuals));
for i := 0 to length(self.actuals) - 1 do
a3DPointArr[i] := self.actuals[i];
// CONNECTOR
if (self.ClassName = 'TConnectorObject') then
begin
if (TConnectorObject(self).ConnectorType <> ct_Clear) or (TConnectorObject(Self).Name = 'Anchor') then
begin
for i := 0 to high(a3DPointArr) do
a3DPointArr[i].z := TConnectorObject(self).ActualZOrder[i + 1] * ScaleDelta;
aFace := TFaceRecord.Create(a3DPointArr, clRed, ftPipe, 0.1, False, self);
Faces.Add(aFace);
end;
end
else
// ORTHOLINE
begin
for i := 0 to high(a3DPointArr) do
a3DPointArr[i].z := TOrthoLine(self).ActualZOrder[i + 1] * ScaleDelta;
Line := TOrthoLine(Self);
// ïåðåíàçíà÷èòü ïåðâóþ ñòîðîíó
if Line.JoinConnector1 <> nil then
begin
if TConnectorObject(Line.JoinConnector1).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(Line.JoinConnector1)
else
GetConn := TConnectorObject(TConnectorObject(Line.JoinConnector1).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
a3DPointArr[0].x := GetConn.ActualPoints[1].x;
a3DPointArr[0].y := GetConn.ActualPoints[1].y;
end;
end;
// ïåðåíàçíà÷èòü âòîðóþ ñòîðîíó
if Line.JoinConnector2 <> nil then
begin
if TConnectorObject(Line.JoinConnector2).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(Line.JoinConnector2)
else
GetConn := TConnectorObject(TConnectorObject(Line.JoinConnector2).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
a3DPointArr[1].x := GetConn.ActualPoints[1].x;
a3DPointArr[1].y := GetConn.ActualPoints[1].y;
end;
end;
aFace := TFaceRecord.Create(a3DPointArr, clBlack, ftLine, 0.1, False, self);
Faces.Add(aFace);
end;
// Tolik 24/05/2019 --
SetLength(a3DPointArr, 0);
//
end;
// TSCSFIGUREGRP
if (Self.ClassName = 'TSCSFigureGrp') then
begin
for j := 0 to TSCSFigureGrp(Self).InFigures.Count - 1 do
begin
InFigure := Tfigure(TSCSFigureGrp(Self).InFigures[j]);
if (InFigure.ClassName = 'TConnectorObject') or (InFigure.ClassName = 'TOrthoLine') then
begin
// a3DPointArr := T3DPointArray(InFigure.actuals);
SetLength(a3DPointArr, length(InFigure.actuals));
for i := 0 to length(InFigure.actuals) - 1 do
a3DPointArr[i] := InFigure.actuals[i];
// CONNECTOR
if (InFigure.ClassName = 'TConnectorObject') then
begin
if (TConnectorObject(InFigure).ConnectorType <> ct_Clear) or (TConnectorObject(InFigure).Name = 'Anchor') then
begin
for i := 0 to high(a3DPointArr) do
a3DPointArr[i].z := TConnectorObject(InFigure).ActualZOrder[i + 1] * ScaleDelta;
aFace := TFaceRecord.Create(a3DPointArr, clRed, ftPipe, 0.1, False, InFigure);
Faces.Add(aFace);
end;
end
else
// ORTHOLINE
begin
for i := 0 to high(a3DPointArr) do
a3DPointArr[i].z := TOrthoLine(InFigure).ActualZOrder[i + 1] * ScaleDelta;
Line := TOrthoLine(InFigure);
// ïåðåíàçíà÷èòü ïåðâóþ ñòîðîíó
if Line.JoinConnector1 <> nil then
begin
if TConnectorObject(Line.JoinConnector1).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(Line.JoinConnector1)
else
GetConn := TConnectorObject(TConnectorObject(Line.JoinConnector1).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
a3DPointArr[0].x := GetConn.ActualPoints[1].x;
a3DPointArr[0].y := GetConn.ActualPoints[1].y;
end;
end;
// ïåðåíàçíà÷èòü âòîðóþ ñòîðîíó
if Line.JoinConnector2 <> nil then
begin
if TConnectorObject(Line.JoinConnector2).JoinedConnectorsList.Count = 0 then
GetConn := TConnectorObject(Line.JoinConnector2)
else
GetConn := TConnectorObject(TConnectorObject(Line.JoinConnector2).JoinedConnectorsList[0]);
if GetConn <> nil then
begin
a3DPointArr[1].x := GetConn.ActualPoints[1].x;
a3DPointArr[1].y := GetConn.ActualPoints[1].y;
end;
end;
aFace := TFaceRecord.Create(a3DPointArr, clBlack, ftLine, 0.1, False, InFigure);
Faces.Add(aFace);
end;
// Tolik 24/05/2019 --
SetLength(a3DPointArr, 0);
//
end;
end;
end;
//
// if (self.ClassName = 'TBMPObject') then
// begin
// a3DPointArr := T3DPointArray(self.actuals);
// for i := 0 to high(a3DPointArr) do
// a3DPointArr[i].z := 0;
// aFace := TFaceRecord.Create(a3DPointArr, clBlack, ftPicture, 0.1, False, self);
// Faces.Add(aFace);
// end;
(*
if (self.ClassName <> 'TBlock') and (self.ClassName <> 'TFigureGrpMod') and (self.ClassName <> 'TFigureGrpNotMod') then
begin
a3DPointArr := T3DPointArray(self.actuals);
if (self.ClassName = 'TConnectorObject') or (self.ClassName = 'TOrthoLine') then
begin
for i := 0 to high(a3DPointArr) do
a3DPointArr[i].z := TOrthoLine(self).ActualZOrder[i + 1] * 100 ;
end;
if (self.ClassName = 'TConnectorObject') then
begin
aFace := TFaceRecord.Create(a3DPointArr, clBlack, ftPipe);
end
else
aFace := TFaceRecord.Create(a3DPointArr, clBlack, ftLine);
Faces.Add(aFace);
end;
*)
end;
procedure TFigure.DrawRotTrace(DEngine: TPCDrawEngine;isGrayed:Boolean);
var x,y,z: Double;
r:HRGN;
begin
DEngine.Canvas.pen.mode := pmXor;
x := RotPoint.x;
y := RotPoint.y;
z := 0;
DEngine.convertPoint(x,y,z);
r := 1;
Dengine.DrawCirclePix(Round(x),Round(y),PointDim+3,clLime,1,ord(psSolid),0,ord(bsClear),r);
Dengine.DrawCirclePix(Round(x),Round(y),PointDim,clLime,1,ord(psSolid),clLime,ord(bsSolid),r);
Draw(DEngine,isGrayed);
end;
procedure TFigure.getRotatePoints(ModList: TList);
var
CControl: TPCDrawing;
figMaxX, figMaxY, figMinX,figMinY:Double;
p1,p2,p3,p4,p5: TDoublePoint;
a: integer;
begin
CControl :=TPCDrawing(Owner);
getbounds(figMaxX,figMaxY,figMinX,figMinY);
p1 := DoublePoint(figMinX,figMinY);
p2 := DoublePoint(figMaxX,figMinY);
p3 := DoublePoint(figMaxX,figMaxY);
p4 := DoublePoint(figMinX,figMaxY);
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p1.x,p1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p2.x,p2.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p3.x,p3.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p4.x,p4.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptRotCenter,ptRCenter,clRed,pointdim,RotPoint.x,RotPoint.y,5));
end;
procedure TFigure.getModPoints(ModList: TMyList);
var
CControl: TPCDrawing;
MT,MR,MB,ML : TDoublePoint;
a: integer;
begin
CControl :=TPCDrawing(Owner);
case ShadowType of
stLine:
begin
ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,
pointDim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,
pointDim,ap2.x,ap2.y,2));
end;
stRectangle:
begin
MT := MPoint(ap1,ap2);
MR := MPoint(ap2,ap3);
MB := MPoint(ap3,ap4);
ML := MPoint(ap4,ap1);
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap2.x,ap2.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap3.x,ap3.y,5));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap4.x,ap4.y,7));
if not fDiagonal then
begin
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MT.x,MT.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MR.x,MR.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MB.x,MB.y,6));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ML.x,ML.y,8));
end;
end;
stCircle:
begin
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x,ap1.y + radius,0));
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x,ap1.y - radius,0));
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x+radius,ap1.y,0));
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x-radius,ap1.y,0));
end;
end;
end;
procedure TFigure.getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);
var
a: integer;
p1, p2: TDoublePoint;
ap: TDoublePoint;
begin
{//16.03.2012
case ShadowType of
stLine:
begin
if ap1.x > ap2.x then begin
figMaxX := ap1.x;figMinX := ap2.x;
end else begin
figMaxX := ap2.x;figMinX := ap1.x;
end;
if ap1.y > ap2.y then begin
figMaxY := ap1.y;figMinY := ap2.y;
end else begin
figMaxY := ap2.y;
figMinY := ap1.y;
end;
end;
stRectangle:
begin
figMaxX := ap1.x;
figMinX := ap1.x;
figMaxY := ap1.y;
figMinY := ap1.y;
For a := 1 to 4 do
begin
if actualpoints[a].x > figMaxX then figMaxX := actualpoints[a].x;
if actualpoints[a].x < figMinX then figMinX := actualpoints[a].x;
if actualpoints[a].y > figMaxY then figMaxY := actualpoints[a].y;
if actualpoints[a].y < figMinY then figMinY := actualpoints[a].y;
end;
end;
stCircle:
begin
figMaxX := ap1.x+radius;
figMinX := ap1.x-radius;
figMaxY := ap1.y+radius;
figMinY := ap1.y-radius;
end;
end;}
case ShadowType of
stLine:
begin
p1 := ap1;
p2 := ap2;
if p1.x > p2.x then
begin
figMaxX := p1.x;
figMinX := p2.x;
end
else
begin
figMaxX := p2.x;
figMinX := p1.x;
end;
if p1.y > p2.y then
begin
figMaxY := p1.y;
figMinY := p2.y;
end
else
begin
figMaxY := p2.y;
figMinY := p1.y;
end;
end;
stRectangle:
begin
p1 := ap1;
figMaxX := p1.x;
figMinX := p1.x;
figMaxY := p1.y;
figMinY := p1.y;
For a := 1 to 4 do
begin
ap := actualpoints[a];
if ap.x > figMaxX then
figMaxX := ap.x;
if ap.x < figMinX then
figMinX := ap.x;
if ap.y > figMaxY then
figMaxY := ap.y;
if ap.y < figMinY then
figMinY := ap.y;
end;
end;
stCircle:
begin
p1 := ap1;
figMaxX := p1.x+radius;
figMinX := p1.x-radius;
figMaxY := p1.y+radius;
figMinY := p1.y-radius;
end;
end;
end;
function TFigure.getboundRect: TDoubleRect;
var
figMaxX,figMaxY,figMinX,figMinY: Double;
begin
getbounds(figMaxX,figMaxY,figMinX,figMinY);
//result := Rect(figMinX,figMaxY,figMaxX,FigMinY);
result := DoubleRect(figMinX,figMinY,figMaxX,FigMaxY);
end;
function TFigure.GetBoundRect(UseGRpSize: boolean): TDoubleRect;
var
figMaxX,figMaxY,figMinX,figMinY: Double;
FigLayerHandle: LongInt;
begin
FigLayerHandle := -1;
if not UseGRpSize then
begin
// Tolik 24/10/2017 -- íà âñÿêèé
if assigned(Self.Owner) then
begin
FigLayerHandle := LongInt(TPowerCad(Self.Owner).Layers[2]);
end;
if Self.LayerHandle <> FigLayerHandle then
UseGRpSize := true;
//
end;
if UseGRpSize then //íà âñÿê ñëó÷àé ïóñêàé áåäåò
getbounds(figMaxX,figMaxY,figMinX,figMinY)
else
getboundsWithoutGrpSize(figMaxX,figMaxY,figMinX,figMinY);
result := DoubleRect(figMinX,figMinY,figMaxX,FigMaxY);
end;
procedure TFigure.GetRegionBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
var rx: Trect;
r: TDoubleRect;
CControl:TPCdrawing;
z: Double;
//Tolik
CanGetBounds: Boolean;
begin
// Tolik
CanGetBounds := False;
if RegHandle = 0 then
begin
if RegObject <> nil then
begin
CanGetBounds := GetRegionBox(rx) > 0;
end;
end
else
CanGetBounds := GetRgnBox(RegHandle,rx) <> 0;
//if GetRgnBox(RegHandle,rx) <> 0 then
//
if CanGetBounds then
begin
if owner <> nil then
begin
r := DoubleRect(rx.left,rx.top,rx.right,rx.bottom);
CControl := TPCDrawing(Owner);
z := 0;
CControl.DEngine.DeConvertPoint(r.left,r.top,z);
CControl.DEngine.DeConvertPoint(r.right,r.bottom,z);
if r.left > r.right then begin
figMaxX := r.Left;
figMinX := r.Right;
end else begin
figMinX := r.Left;
figMaxX := r.Right;
end;
if r.bottom > r.top then begin
figMaxY:= r.bottom;
figMinY := r.top;
end else begin
figMinY := r.bottom;
figMaxY := r.top;
end;
end;
end;
end;
procedure TFigure.getRegionPoints(var points: array of TDoublePoint);
begin
end;
function TFigure.isPointIn(x,y:Double): boolean;
var //apoint : TDoublePoint;
a: integer;
nx,ny,z: Double;
ctrl: Double;
ap,p1,p2,p3,p4: TDoublePoint;
DEngine: TPCDrawEngine;
result1 : Boolean;
begin
result := false;
// Tolik 28/08/2019 --
//apoint := DoublePoint(x,y); ap := aPoint;
ap := DoublePoint(x,y);
ap.z := 0;
//
p1 := ap1; p2 := ap2; p3 := ap3; p4 := ap4;
if assigned(Owner) then
begin
z:= 0;
DEngine := TPCDrawing(Owner).DEngine;
DEngine.ConvertPoint(ap.x,ap.y,z);
DEngine.ConvertPoint(p1.x,p1.y,z);
DEngine.ConvertPoint(p2.x,p2.y,z);
DEngine.ConvertPoint(p3.x,p3.y,z);
DEngine.ConvertPoint(p4.x,p4.y,z);
end;
if FullHitTest then begin
// if isPointInRegion(x,y) then result := true;
//Tolik
if IsPointInRegionByRegObj(x,y) then result := true;
//
if result then exit;
end;
case ShadowType of
stLine:
begin
if ispointinLine(p1,p2,ap,width) then result := true;
end;
stRectangle:
begin
if ( ispointinLine(p1,p2,ap,width) or
ispointinLine(p2,p3,ap,width) or
ispointinLine(p3,p4,ap,width) or
ispointinLine(p4,p1,ap,width) ) then
begin
result := true;
exit;
end;
if TBrushStyle(brs) <> bsClear then
begin
//result := isPointInRegion(x,y);
//Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
end;
stCircle:
begin
nx := x-ap1.x;
ny := y-ap1.y;
if (radius = 0) then exit;
ctrl := ((nx*nx)/(radius*radius))+((ny*ny)/(radius*radius));
if (ctrl < 1.1) and (ctrl > 0.9) then result := true;
if TBrushStyle(brs) <> bsClear then
begin
//if isPointInRegion(x,y) then result := true;
//Tolik
if IsPointInRegionByRegObj(x,y) then result := true;
//
end;
end;
end;
end;
function TFigure.isPointInRegion(x, y: Double): Boolean;
var CCOntrol:TPCDrawing;
z : Double;
isPoint: Integer;
begin
result := false;
if owner <> nil then
begin
CControl := TPCDrawing(Owner);
z := 0;
CControl.DEngine.ConvertPoint(X,Y,z);
//Tolik
// if ptInRegion(RegHandle,Round(x),Round(y)) then result := true;
if RegObject = nil then
begin
if RegHandle <> 0 then
begin
GetRegObject;
if RegObject <> nil then
begin
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
DeleteObject(RegHandle);
RegHandle := 0;
end;
end;
end;
if RegObject <> nil then
begin
result := IsPointInRegionByRegObj(Round(x),Round(y));
end
else // ïåðåáîð, íî, íà âñÿêèé....à òî õç...
if RegHandle <> 0 then
result := PtInRegion(RegHandle, Round(x), Round(y));
end;
end;
function TFigure.IsPointInRegion(x, y: Double; reg: Integer): Boolean;
var CCOntrol:TPCDrawing;
z: Double;
begin
result := false;
if owner <> nil then
begin
CControl := TPCDrawing(Owner);
z := 0;
CControl.DEngine.ConvertPoint(X,Y,Z);
//if ptInRegion(reg,Round(x),Round(y)) then result := true;
//Tolik
if IsPointInRegionByRegObj(Round(x),Round(y)) then result := true;
//
end;
end;
Function TFigure.CheckifInArea(area: TDoubleRect): boolean;
var bound : TDoubleRect;
AreaMaxX,AreaMaxY,AreaMinX,AreaMinY : Double;
boundMaxX,boundMaxY,boundMinX,boundMinY : Double;
begin
result := false;
getbounds(boundMaxX,boundMaxY,boundMinX,boundMinY);
if area.left > area.right then
begin
areaMaxX := area.left;
areaMinX := area.right;
end
else
begin
areaMaxX := area.right;
areaMinX := area.left;
end;
if area.top > area.bottom then
begin
areaMaxY := area.top;
areaMinY := area.bottom;
end
else
begin
areaMaxY := area.bottom;
areaMinY := area.top;
end;
if (areaMaxX >= boundMaxX) and
(areaMaxY >= boundMaxY) and
(areaMinX <= boundMinX) and
(areaMinY <= boundMinY)
then
begin
result := true;
end;
end;
//Tolik
// þçàåò îáúåêò ðåãèîí ôèãóðû
Function TFigure.IsPointInRegionByRegObj(x, y: Double): Boolean;
begin
result := ptInRegionByRegObj(x, y, Self.RegObject);
end;
// þçàåò îáúåò ðåãèîí õåð êàêîé ôèãóðû
Function TFigure.IsPointInRegionByRegObj(x, y: Double; RegObj: TRegionObject): Boolean;
begin
result := ptInRegionByRegObj(x, y, RegObj);
end;
function TFigure.ptInRegionByRegObj(x,y: Double; RegObj: TRegionObject): Boolean;
var a, i: Integer;
p: TDoublePoint;
z: Double;
CControl: TPCDrawing;
RectArray: array of TDoubleRect;
Rect: PRect;
nx, ny, ctrl: double;
ap,p1,p2,p3,p4: TDoublePoint;
apoint : TDoublePoint;
pp: Pbyte;
//pp: PAnsiChar;
function PointInPOlygonByPoints(x,y: Double): Integer;
var
i, j, cnt: Integer;
d, d2, d3: double;
ip, ipNext: TDoublePoint;
begin
result := 0;
cnt := TFigure(RegObj.RegObjOwner).PointCount + 1;
if cnt < 3 then
Exit;
ip := TFigure(RegObj.RegObjOwner).FigurePoints[1];
for i := 2 to cnt do
begin
if i < cnt then ipNext := TFigure(RegObj.RegObjOwner).FigurePoints[i]
else ipNext := TFigure(RegObj.RegObjOwner).FigurePoints[1];
if (ipNext.Y = Y) then
begin
if (ipNext.X = X) or ((ip.Y = Y) and
((ipNext.X > X) = (ip.X < X))) then
begin
result := -1;
Exit;
end;
end;
if ((ip.Y < Y) <> (ipNext.Y < Y)) then
begin
if (ip.X >= X) then
begin
if (ipNext.X > X) then
result := 1 - result
else
begin
d2 := (ip.X - X);
d3 := (ipNext.X - X);
d := d2 * (ipNext.Y - Y) - d3 * (ip.Y - Y);
if (d = 0) then
begin
result := -1;
Exit;
end;
if ((d > 0) = (ipNext.Y > ip.Y)) then
result := 1 - result;
end;
end
else
begin
if (ipNext.X > X) then
begin
d2 := (ip.X - X);
d3 := (ipNext.X - X);
d := d2 * (ipNext.Y - Y) - d3 * (ip.Y - Y);
if (d = 0) then
begin
result := -1;
Exit;
end;
if ((d > 0) = (ipNext.Y > ip.Y)) then
result := 1 - result;
end;
end;
end;
ip := ipNext;
end;
end;
function PointInPolygonByRects(x,y: Double): boolean;
var i, j: Integer;
ip: TDoublePoint;
z: double;
// CControl: TPCDrawing;
begin
result := false;
j := Length(RectArray) - 1;
ip.x := x;
ip.y := y;
z := 0;
if RegObj.RegObjData^.rdh.nCount > 0 then // Tolik 29/08/2019 --
begin
j := RegObj.RegObjData^.rdh.nCount - 1;
rect := Prect(@RegObj.RegObjData^.buffer); // Tolik 24/11/2019 -- çäåñü íà÷èíàþòñÿ ïðÿìîóãîëüíèêè
for i := 0 to j do
begin
{if PointInRect(ip, RectArray[i]) then
begin
Result := True;
break;
end;}
// 24/11/2019 --
//rect := @RegObj.RegObjData^.buffer[i*Sizeof(TRect)];
//
if PointInRect(ip, DoubleRect(Rect^.Left,Rect^.Top, Rect^.Right,Rect^.Bottom)) then
begin
Result := True;
break;
end;
inc(rect,1);
end;
end;
end;
begin
result := False;
if RegObject = nil then
EXIT;
if RegObj.RegObjData <> nil then
begin
// all the rectangles of Region
if RegObj.RegObjData^.rdh.iType = 1 {RDH_RECTANGLES äðóãîãî, âðîäå êàê è íå áûâàåò ...} then
begin
//SetLength(RectArray, PRgnData(Data)^.rdh.nCount);
{ for i := 0 to PRgnData(Data)^.rdh.nCount - 1 do
begin
rect := @PRgnData(Data)^.buffer[i*Sizeof(TRect)];
//RectArray[i] := Rect^;
RectArray[i].Top := Rect^.Top;
RectArray[i].Bottom := Rect^.Bottom;
RectArray[i].Left := Rect^.Left;
RectArray[i].Right := Rect^.Right;
end;}
end;
if RegObj.CheckPointByRects then
begin
if Owner <> nil then
begin
CControl := TPCDrawing(Owner);
p.x := x;
p.y := y;
z := 0;
CControl.DEngine.ConvertPoint(p.X,p.Y, z);
Result := PointInPolygonByRects(p.x,p.y);
end;
end
else
begin
i := PointInPOlygonByPoints(x,y);
if i <> 0 then
result := True;
end;
end;
// ïî êîíòóðàì
{
var apoint : TDoublePoint;
a: integer;
nx,ny,z: Double;
ctrl: Double;
ap,p1,p2,p3,p4: TDoublePoint;
DEngine: TPCDrawEngine;
result1 : Boolean;
begin
result := false;
apoint := DoublePoint(x,y); ap := aPoint;
p1 := ap1; p2 := ap2; p3 := ap3; p4 := ap4;
if assigned(Owner) then
begin
z:= 0;
DEngine := TPCDrawing(Owner).DEngine;
DEngine.ConvertPoint(ap.x,ap.y,z);
DEngine.ConvertPoint(p1.x,p1.y,z);
DEngine.ConvertPoint(p2.x,p2.y,z);
DEngine.ConvertPoint(p3.x,p3.y,z);
DEngine.ConvertPoint(p4.x,p4.y,z);
end;
}
if not Result then
begin
apoint := DoublePoint(x,y); ap := aPoint;
p1 := ap1; p2 := ap2; p3 := ap3; p4 := ap4;
if assigned(Owner) then
begin
z:= 0;
CControl := TPCDrawing(Owner);
CControl.DEngine.ConvertPoint(ap.x,ap.y,z);
CControl.DEngine.ConvertPoint(p1.x,p1.y,z);
CControl.DEngine.ConvertPoint(p2.x,p2.y,z);
CControl.DEngine.ConvertPoint(p3.x,p3.y,z);
CControl.DEngine.ConvertPoint(p4.x,p4.y,z);
end;
case ShadowType of
stLine:
begin
if ispointinLine(p1,p2,ap,width) then result := true;
end;
stRectangle:
begin
if ( ispointinLine(p1,p2,ap,width) or
ispointinLine(p2,p3,ap,width) or
ispointinLine(p3,p4,ap,width) or
ispointinLine(p4,p1,ap,width) ) then
begin
result := true;
exit;
end;
end;
stCircle:
begin
nx := x-ap1.x;
ny := y-ap1.y;
if (radius = 0) then exit;
ctrl := ((nx*nx)/(radius*radius))+((ny*ny)/(radius*radius));
if (ctrl < 1.1) and (ctrl > 0.9) then result := true;
end;
end;
end;
end;
Function TFigure.GetRegionBox(var r: TRect): Integer;
var rect: PRect;
begin
Result := 0;
if RegObject <> nil then
begin
rect := @RegObject.RegObjData.Rdh.rcBound;
r := rect^;
Result := 1;
end;
end;
Procedure TFigure.ResetRegObject;
begin
if RegObject <> nil then
begin
if RegObject.RegObjData <> nil then
begin
GlobalFreePtr(RegObject.RegObjData);
RegObject.RegObjData := nil;
end;
FreeAndNil(regObject);
end;
end;
procedure TFigure.GetRegObject;
begin
if RegObject = nil then
RegObject := TRegionObject.Create(Self);
if RegHandle <> 0 then
RegObject.GetRegData(RegHandle);
end;
//
Function TFigure.duplicate: TFigure;
var fStream:TMemoryStream;
begin
result := nil;
fStream := TMemoryStream.Create;
Self.WriteToStream(fStream);
fStream.Position := 0;
result := TFigure.CreateFromStream(fStream,LayerHandle,mydsNormal,Owner);
fStream.Free;
end;
procedure TFigure.CopyProperties(Figure: TFigure);
var a: integer;
begin
Figure.LayerHandle := LayerHandle;
Figure.AngletoPoint := AngleToPoint;
Figure.Angle := Angle;
Figure.PointCount := PointCount;
Figure.Width := Width;
Figure.Color := Color;
Figure.Style := Style;
For a := 1 to PointCount do
begin
Figure.ActualPoints[a] := ActualPoints[a];
Figure.OriginalPoints[a] := OriginalPoints[a];
end;
end;
procedure TFigure.ClearPoints;
begin
SetLength(originals,0);
SetLength(actuals,0);
PointCount := 0;
end;
procedure TFigure.RedimenPoints;
begin
SetLength(originals,PointCount);
SetLength(actuals,PointCount);
end;
destructor TFigure.Destroy;
var
a : integer;
begin
try
// Tolik 29/04/2021 -- åñëè èäåò çàêðûòèå êàäà - íåõ òàì äåñåëåêòèòü ....
//deselect;
if Assigned(Owner) then
if assigned(Owner.Owner) then
if not TF_Cad(Owner.Owner).FCadClose then
deselect;
//
SelPoints.Clear;
SelPoints.Free;
//
//selpoints.Destroy;
//deleteobject(RegHandle);
SetLength(originals, 0);
SetLength(actuals, 0);
ClearBounds;
//Tolik 24/03/2017 -- TracePoint íèãäå ÿâíî íå ñîçäàåòñÿ, à áóäåò ïðèñâàèâàòüñÿ èç ñïèñêà ModPoints PCada
// ïîýòîìó óíè÷òîæàòü åãî çäåñü íå íóæíî è íåïðàâèëüíî
{if TracePoint <> nil then
FreeAndNil(TracePoint);}
//
// JoinedFigures.destroy;
if JoinedFigures <> nil then
begin
JoinedFigures.Clear;
FreeAndNil(JoinedFigures);
end;
//JoinedFigures.Clear;
//
if assigned(CustomStream) then
CustomStream.Free;
ClearDimLines;
DimLines.Clear;
DimLines.Free;
if assigned(Fill) then
Fill.Free;
//Tolik
ResetRegObject;
// íà âñÿêèé...
if RegHandle <> 0 then
begin
DeleteObject(RegHandle);
end;
if Icon <> nil then
begin
Icon.FreeImage;
end;
SetLength(FTempPoints, 0);
//
ClearClipFigures;
ClipFigures.Free;
//Tolik
if Assigned(data) then
begin
FreeMem(data);
data := nil;
end;
//
inherited;
except
// on E: Exception do AddExceptionToLog('TFigure.Destroy (DrawObject)' + E.Message);
end;
// FClassIndex := 0;
end;
Procedure TFigure.ClearBounds;
var ln: TLine;
pln: TPolyLine;
f: Tfigure;
i: Integer;
begin
if Self is TLine then
begin
ln := TLine(self);
if assigned(ln.JoinFigure1) then
ln.JoinFigure1.JoinedFigures.Remove(self);
if assigned(ln.JoinFigure2) then
ln.JoinFigure2.JoinedFigures.Remove(self);
end else if Self is TPolyLine then
begin
pln := TPolyLine(self);
if assigned(pln.JoinFigure1) then
pln.JoinFigure1.JoinedFigures.Remove(self);
if assigned(pln.JoinFigure2) then
pln.JoinFigure2.JoinedFigures.Remove(self);
end;
for i := 0 to JoinedFigures.Count - 1 do
begin
f := TFigure(JoinedFigures[i]);
if f is TLine then
begin
ln := TLine(f);
if ln.Joinfigure1 = Self then
ln.JoinFigure1 := nil;
if ln.Joinfigure2 = Self then
ln.JoinFigure2 := nil;
end
else
if f is TPolyLine then
begin
pln := TPolyLine(f);
if pln.Joinfigure1 = Self then
pln.JoinFigure1 := nil;
if pln.Joinfigure2 = Self then
pln.JoinFigure2 := nil;
end;
end;
end;
procedure TFigure.UpdateMenu(var popMenu: TPopUpMenu; var sIndex: Integer);
begin
end;
procedure TFigure.MenuClicked(commandID:integer);
begin
end;
procedure TFigure.OnNewPoint;
begin
end;
procedure TFigure.OnFigureModified;
begin
// Tolik 30/11/2015
if not Modified then
begin
//
if DimLines.Count > 0 then
CreateDimLines;
if assigned(Owner) then
begin
if assigned(TPCDrawing(Owner).OnFigureModify) then
TPCDrawing(Owner).OnFigureModify(Owner,Self);
end;
end;
end;
(* ========================================================================== *)
// TLINE IMPLEMENTATION //
(* ========================================================================== *)
constructor Tline.create( aX1,aY1,aX2,aY2: Double;
w,s,c:integer;row: integer;
LHandle: LongInt; aDrawStyle:TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
RowStyle := row;
originalpoints[1] := DoublePoint(ax1,ay1);
originalpoints[2] := DoublePoint(ax2,ay2);
actualpoints[1] := DoublePoint(ax1,ay1);
actualpoints[2] := DoublePoint(ax2,ay2);
width := w;
color := c;
style := s;
end;
//Tolik
destructor TLine.destroy;
begin
inherited;
end;
class function TLine.ShadowType:TShadowType;
begin
Result := stLine;
end;
procedure TLine.Initialize;
begin
inherited;
pointcount := 2;
JoinFigure1 := nil;
JoinFigure2 := nil;
rowL := 3.5;
rowH := 1.2;
RowWhite := False;
KeepAngle := False;
EndMod := False;
end;
function TLine.ShadowClick(ClickIndex:Integer;x,y: Double): Boolean;
begin
result := false;
if clickIndex = 2 then begin
ActualPoints[2] := DoublePoint(x,y);
Result := True;
end;
end;
function TLine.ShadowTrace(ClickIndex: Integer; x, y:Double): Boolean;
var oAngle,Angle,delta,step: Double;
stepCnt,i:Integer;
p: TDoublePoint;
begin
if clickIndex = 1 then begin
(* p := DoublePoint(x,y);
Angle := GetRadOfLine(ap1,p);
delta := pi*15/180; // the snap distance angle
step := pi/4; //0 45 90 135 180 215 270 315 160
// for more acc change the step value ex:step := pi/18;
stepCnt := Trunc(2*pi/step);
oAngle := angle;
for i := 0 to StepCnt do begin
if abs(angle-(i*step))<delta then angle := i*step;
end;
if not EQD(angle,oAngle) then begin
p := RotatePoint(ap1,p, angle-Oangle);
x := p.x;
y := p.y;
end;
*)
ActualPoints[2] := DoublePoint(x,y);
Result := True;
end;
end;
class function TLine.CreateFromShadow(aOwner: TComponent;LHandle: LongInt;
Shadow:TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TLine.create( Shadow.ActualPoints[1].x,
Shadow.ActualPoints[1].y,
Shadow.ActualPoints[2].x,
Shadow.ActualPoints[2].y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultRowStyle),
LHandle,mydsNormal,cad);
end;
function TLine.TraceModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x, y: Double;Shift: TShiftState): boolean;
var angle,cAngle: Double;
xp :TDoublePoint;
begin
xp := DoublePoint(x,y);
if KeepAngle then begin
if MP.SeqNbr = 1 then begin
angle := GetRadOfLine(ap2,ap1);
cAngle := GetRadOfLine(ap2,xp);
xp := RotatePoint(ap2,xp,Angle-CAngle);
end else begin
angle := GetRadOfLine(ap1,ap2);
cAngle := GetRadOfLine(ap1,xp);
xp := RotatePoint(ap1,xp,Angle-CAngle);
end;
end;
TraceFigure.ActualPoints[MP.SeqNbr] := xp;
end;
function TLine.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean;
var ap: TDoublepoint;
cad: TPCDrawing;
angle,cAngle: Double;
xp :TDoublePoint;
begin
cad:= TPCDrawing(CadControl);
xp := DoublePoint(x,y);
if KeepAngle then begin
if MP.SeqNbr = 1 then begin
angle := GetRadOfLine(ap2,ap1);
cAngle := GetRadOfLine(ap2,xp);
xp := RotatePoint(ap2,xp,Angle-CAngle);
end else begin
angle := GetRadOfLine(ap1,ap2);
cAngle := GetRadOfLine(ap1,xp);
xp := RotatePoint(ap1,xp,Angle-CAngle);
end;
end;
ap := actualpoints[mp.SeqNbr];
ActualPoints[mp.SeqNbr] := DoublePoint(ActualPoints[mp.SeqNbr].x + (xp.x-ap.x),
ActualPoints[mp.SeqNbr].y + (xp.y-ap.y));
if (ssctrl in Shift) and (ssShift in Shift) then
Cad.BoundLinePoint(self.Handle,MP.SeqNbr,DoublePoint(xp.x,xp.y));
ResetRegion;
Modified := True;
end;
procedure TLine.SetJFigure1(jf: TFigure);
begin
if jf = JoinFigure1 then exit;
if jf = nil then
JoinFigure1.JoinedFigures.Remove(self);
JoinFigure1 := jf;
if jf <> nil then jf.JoinedFigures.Add(self);
end;
procedure TLine.SetJFigure2(jf: TFigure);
begin
if jf = JoinFigure2 then exit;
if jf = nil then
JoinFigure2.JoinedFigures.Remove(self);
JoinFigure2 := jf;
if jf <> nil then jf.JoinedFigures.Add(self);
end;
procedure TLine.JoinFigureMoved(Sender: TFigure; dx, dy: double);
begin
if (inMoveList) and ((JoinFigure1 = nil) or (JoinFigure2 = nil)) then exit;
if sender = JoinFigure1 then
ActualPoints[1] := DoublePoint(ActualPoints[1].x + dx ,ActualPoints[1].y + dy)
else if sender = JoinFigure2 then
ActualPoints[2] := DoublePoint(ActualPoints[2].x + dx ,ActualPoints[2].y + dy);
end;
procedure TLine.UnBound;
begin
SetJFigure1(nil);
SetJFigure2(nil);
end;
Procedure TLine.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var ByteVal: Byte;
begin
Case xcode of
220: rowH := pDouble(data)^;
221: rowL := pDouble(data)^;
end;
end;
procedure TLine.WriteToStream(Stream: TStream);
var xdbl: Double;
begin
inherited;
xDbl := RowH; WriteField(220,Stream,xDbl,8);
xDbl := RowL; WriteField(221,Stream,xDbl,8);
end;
procedure Tline.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
//const
// FlatPenStyle = PS_DashDot;
var
acolor : Tcolor;
// LogBrush: TLOGBRUSH;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then
DEngine.Canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
// LogBrush.lbStyle := BS_Solid;
// LogBrush.lbColor := aColor;
// LogBrush.lbHatch := 0;
// DEngine.canvas.pen.Handle := ExtCreatePen(FlatPenStyle, Width, LogBrush, 0, nil);
DEngine.drawline(ap1.x,ap1.y,ap2.x,ap2.y,acolor, aawidth,style,ord(RowStyle),rowL,rowH,rowWhite);
end;
procedure TLine.DrawFigureGuides(DEngine: TPCDrawEngine);
begin
inherited;
if DrawStyle = dsTrace then DEngine.Canvas.pen.mode := pmXor
else DEngine.canvas.pen.mode := pmCopy;
if JoinFigure1 <> nil then
DEngine.drawselectionpoint(ap1.x,ap1.y,ap1.z,ptCross,pointdim,clRed);
if JoinFigure2 <> nil then
DEngine.drawselectionpoint(ap2.x,ap2.y,ap1.z,ptCross,pointdim,clRed);
end;
procedure Tline.getModPoints(ModList: TMyList);
var
CControl: TPCDrawing;
begin
CControl :=TPCDrawing(Owner);
if not EndMod then ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,pointDim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,pointDim,ap2.x,ap2.y,2));
end;
procedure TLine.getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);
var
p1, p2: TDoublePoint;
begin
{ //16.03.2012
if ap1.x > ap2.x then
begin
figMaxX := ap1.x;
figMinX := ap2.x;
end else
begin
figMaxX := ap2.x;
figMinX := ap1.x;
end;
if ap1.y > ap2.y then
begin
figMaxY := ap1.y;
figMinY := ap2.y;
end else
begin
figMaxY := ap2.y;
figMinY := ap1.y;
end;}
p1 := GetActual(1);
p2 := GetActual(2);
if p1.x > p2.x then
begin
figMaxX := p1.x;
figMinX := p2.x;
end else
begin
figMaxX := p2.x;
figMinX := p1.x;
end;
if p1.y > p2.y then
begin
figMaxY := p1.y;
figMinY := p2.y;
end else
begin
figMaxY := p2.y;
figMinY := p1.y;
end;
end;
function Tline.isPointIn(x,y:double): boolean;
var
apoint,p1,p2: TDoublepoint;
DEngine: TPCDrawEngine;
z: Double;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
apoint := DoublePoint(x,y);
p1 := ap1; p2 := ap2;
if assigned(Owner) then
begin
DEngine := TPCDrawing(Owner).DEngine;
z := 0;
DEngine.ConvertPoint(apoint.x,apoint.y,z);
DEngine.ConvertPoint(p1.x,p1.y,z);
DEngine.ConvertPoint(p2.x,p2.y,z);
end;
if ispointinLine(p1,p2,apoint,width) then result := true;
end;
function TLine.DuplicateAsBezier: TFigure;
var points: TDoublePointArr;
cp1,cp2: TDoublePoint;
begin
SetLength(Points,4);
cp1 := MPoint(ap1,ap2);
cp1 := MPoint(ap1,cp1);
cp2 := MPoint(ap1,ap2);
cp2 := MPoint(ap2,cp2);
points[0] := ap1;
points[1] := cp1;
points[2] := cp2;
points[3] := ap2;
result := TPolyline.CreateFromBezierPoints(points,width,style,color,
0,0,rowStyle,false,LayerHandle,mydsNormal,owner);
SetLength(Points,0);
end;
function Tline.duplicate: TFigure;
var res : TLine;
begin
res := Tline.create( originalpoints[1].x,
originalpoints[1].y,
originalpoints[2].x,
originalpoints[2].y,
width,
style,
color,
RowStyle,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.rotpoint.x := rotpoint.x ;
res.rotpoint.y := rotpoint.y ;
res.AngleToPoint := AngleToPoint;
res.RowH := RowH;
res.RowL := RowL;
result := res;
end;
function TLine.BreakByPoint(p: TdoublePoint; var Figures: TList): boolean;
var fig: Tfigure;
begin
result := false;
if isPointIn(p.x,p.y) then begin
fig := TLine.create(ap1.x,ap1.y,p.x,p.y,width,style,color,
rowStyle,LayerHandle,mydsNormal,Owner);
Figures.Add(fig);
fig := TLine.create(p.x,p.y,ap2.x,ap2.y,width,style,color,
rowStyle,LayerHandle,mydsNormal,Owner);
Figures.Add(fig);
result := true;
end;
end;
function TLine.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var p: TDoublePoint;
begin
result := false;
if GetInterSectionPoint(ap1,ap2,p1,p2,p,False) then begin
SetLength(pArr,1);
pArr[0] := p;
result := true;
end;
end;
procedure TLine.GetVectorObjects(Objects: Tlist;BaseP: TDoublePoint);
var obj: TvectorObject;
p1,p2: TDoublePoint;
begin
p1 := ap1;
p2 := ap2;
p1 := DoublePoint(p1.x-baseP.x,p1.y-baseP.y);
p2 := DoublePoint(p2.x-baseP.x,p2.y-baseP.y);
obj := TVectorObject.CreateLineObject(p1,p2);
Objects.Add(obj);
end;
(* ========================================================================== *)
// TVertex IMPLEMENTATION //
(* ========================================================================== *)
constructor TVertex.create(aX,aY:Double; LHandle:LongInt;
aDrawStyle: TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
originalpoints[1] := DoublePoint(ax,ay);
actualpoints[1] := DoublePoint(ax,ay);
end;
procedure TVertex.Initialize;
begin
inherited;
PointCount := 1;
end;
function TVertex.CreateModification: TFigure;
begin
Result := TVertex.create(ap1.x,ap1.y,0,dsTrace,nil);
if assigned(Result) then Result.RotPoint := RotPoint;
end;
class function TVertex.CreateShadow(x,y: Double): TFigure;
begin
CreateShadow := TVertex.create(x,y,0,dsTrace,nil);
end;
function TVertex.ShadowClick(ClickIndex:Integer;x,y:Double): Boolean;
begin
result := false;
if clickindex = 1 then result := true;
end;
class function TVertex.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
result := TVertex.create(shadow.ap1.x,shadow.ap1.y,LHandle,mydsNormal,aOwner);
end;
procedure TVertex.WriteToStream(Stream: TStream);
begin
inherited;
end;
Procedure TVertex.Draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
Layer: TLayer;
acolor : Tcolor;
Begin
aColor := clRed;
if (isGrayed) then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then DEngine.Canvas.pen.mode := pmXor
else DEngine.canvas.pen.mode := pmCopy;
Dengine.DrawPoint(ap1,clBlue);
exit;
DEngine.drawline(
ap1.x-1,ap1.y,ap1.x+1,ap1.y,aColor,1,0,0);
DEngine.drawline(
ap1.x,ap1.y-1,ap1.x,ap1.y+1,aColor,1,0,0);
DEngine.drawline(
ap1.x-1,ap1.y-1,ap1.x+1,ap1.y+1,aColor,1,0,0);
DEngine.drawline(
ap1.x+1,ap1.y-1,ap1.x-1,ap1.y+1,aColor,1,0,0);
End;
procedure TVertex.getModPoints(ModList: TMyList);
var CControl: TPCdrawing;
Begin
CControl := TPCDrawing(Owner);
ModList.Add(CControl.RegisterModPoint(self,ptUndefined,ptCross,clBlue,
pointDim,ap1.x,ap1.y,0));
End;
function TVertex.isPointIn(x,y:double): boolean;
Begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
if ((x < (ap1.x+1)) and ( x > (ap1.x - 1))) and
((y < (ap1.y+1)) and ( y > (ap1.y - 1)))
then result := true;
End;
procedure TVertex.getbounds(var figMaxX,figMaxY,figMinX,figMinY:double);
Begin
figMaxX := ap1.x + 1;
figMaxY := ap1.y + 1;
figMinX := ap1.x - 1;
figMinY := ap1.y - 1;
End;
Function TVertex.duplicate:TFigure;
Begin
result := TVertex.create(originalpoints[1].x,
originalpoints[1].y, LayerHandle, DrawStyle,Owner);
result.actualpoints[1] := actualpoints[1];
result.AngleToPoint := AngleToPoint;
End;
procedure TVertex.GetVectorObjects(Objects: Tlist; BaseP: TDoublePoint);
var obj: TvectorObject;
p1 : TDoublePoint;
begin
p1 := ap1;
p1 := DoublePoint(p1.x-baseP.x,p1.y-baseP.y);
obj := TVectorObject.CreatePointObject(p1);
Objects.Add(obj);
end;
(* ========================================================================== *)
// TPolyLine IMPLEMENTATION //
(* ========================================================================== *)
{ TPlSegment }
constructor TPlSegment.Create(aIndex: Integer; aType: TSegmentType; cp1,
cp2: TDoublepoint);
begin
inherited create;
Index := aIndex;
Stype := aType;
CPoint1 := cp1;
CPoint2 := cp2;
TangentKnot := True;
Inverted:= False;
end;
Destructor TPlSegment.Destroy;
begin
inherited;
end;
procedure TPlSegment.SetVals(aType: TSegmentType; cp1, cp2: TDoublePoint);
begin
Stype := aType;
CPoint1 := cp1;
CPoint2 := cp2;
end;
Procedure TPlSegment.Move(deltax,deltay: double);
begin
CPoint1.x := CPoint1.x+deltax;
CPoint2.x := CPoint2.x+deltax;
CPoint1.y := CPoint1.y+deltay;
CPoint2.y := CPoint2.y+deltay;
end;
Procedure TPlSegment.Rotate(aAngle: double; cPoint: TDoublePoint);
begin
CPoint1 := RotatePoint(cPoint,CPoint1,aAngle);
CPoint2 := RotatePoint(cPoint,CPoint2,aAngle);
end;
Procedure TPlSegment.Mirror(Point1,Point2: TDoublePoint);
begin
CPoint1 := GetSymetricPoint(CPoint1,Point1,Point2);
CPoint2 := GetSymetricPoint(CPoint2,Point1,Point2);
inverted := not inverted;
end;
Procedure TPlSegment.Scale(percentx, percenty: double; rPoint: TDoublepoint);
begin
CPoint1 := ScalePoint(rPoint,cPoint1,percentx,percenty);
CPoint2 := ScalePoint(rPoint,cPoint2,percentx,percenty);
end;
function TPlSegment.Duplicate: TPlSegment;
begin
result := TPlSegment.Create(Index,sType,Cpoint1,CPoint2);
result.TangentKnot := TangentKnot;
result.Inverted := Inverted;
end;
function TPlSegment.BreakByPoint(knot1, knot2, bp: TDoublePoint;
var seg1,seg2: TPLsegment;Knifing:Boolean; kp1,kp2:TDoublePoint): Boolean;
var dPoint,cp1,cp2,cp3,cp4,cp:TDoublePoint;
dista,a,a1,a2,at,rad:Double;
ts: Double;
res: Boolean;
begin
result := false;
case sType of
sLine: begin
if isPointInLine(knot1,knot2,bp,2) then begin
seg1 := TPLSegment.Create(0,sLine,knot1,bp);
seg1.tp1 := knot1; seg1.tp2 := bp;;
seg2 := TPLSegment.Create(0,sLine,bp,knot2);
seg2.tp1 := bp; seg2.tp2 := knot2;
result := true;
end;
end;
sCurve: begin
if isPointInBezier(knot1,cpoint1,cpoint2,knot2,bp) then begin
dPoint := bp;
ts := -1;
if Knifing then begin
res := SubBezier(knot1,cpoint1,cpoint2,knot2,dPoint,cp1,cp2,cp3,cp4,-1,kp1,kp2);
end else begin
res := SubBezier(knot1,cpoint1,cpoint2,knot2,dPoint,cp1,cp2,cp3,cp4,-1);
end;
if res then
begin
seg1 := TPLSegment.Create(0,sCurve,cp1,cp2);
seg1.tp1 := knot1; seg1.tp2 := dPoint;
seg2 := TPLSegment.Create(0,sCurve,cp3,cp4);
seg2.tp1 := dPoint; seg2.tp2 := knot2;
result := true;
end;
end;
end;
sArc: begin
cp := Cpoint1;
rad := getLineLenght(knot1,cp);
a1 := GetRadOfLine(cp,knot1);
a2 := GetRadOfLine(cp,knot2);
if a2 = 0 then a2 := 2*pi;
if a1>a2 then
distA := 2*pi - a1+a2
else
distA := a2-a1;
if Inverted then
begin
at := a1;
a1 := a2;
a2 := at;
end;
if isPointInArc(bp,cp,rad,0,a1,a2) then begin
Seg1 := TPlSegment.Create(0,sArc,cp,cp);
seg1.tp1 := knot1; seg1.tp2 := dPoint;
Seg2 := TPlSegment.Create(0,sArc,cp,cp);
seg2.tp1 := dPoint; seg2.tp2 := knot2;
result := true;
end;
end;
end;
end;
//////////////
constructor TPolyLine.create(Points: TDoublepointArr;w,s,c,abrs,abrc:integer;
row: integer; aClosed: Boolean; LHandle:LongInt;aDrawStyle: TDrawStyle;aOwner: TComponent);
var a: integer;
begin
inherited create(0,0,0,0,0,0,0,0,LHandle,aDrawStyle,aOwner);
NeedBounds := True; //Tolik 02/08/2021 --
ClearPoints;
FPointEvent := True;
//initialize; // Tolik 29/07/2021
pointCount := Length(Points);
RowStyle := row;
SetLength(Originals, pointCount);
SetLength(Actuals, pointCount);
// Tolik 02/05/2019--
for a := 0 to pointCount-1 do
begin
// if ABS(points[a].z) <> 0 then
if ABS(points[a].x) < 0.000001 then
points[a].x := 0;
if ABS(points[a].y) < 0.000001 then
points[a].y := 0;
if ABS(points[a].z) < 0.000001 then
points[a].z := 0;
end;
//
for a := 0 to pointCount-1 do
begin
originalpoints[a+1]:= points[a];
Actuals[a] := DoublePoint(0,0);
if fPointEvent then
OnNewPoint;
actualpoints[a+1] := points[a];
end;
width := w;
color := c;
style := s;
brs:= abrs;
brc:= abrc;
closed := aClosed;
end;
class function TPolyline.CreateFromBezierPoints(Points: TDoublePointArr; w,
s, c, abrs, abrc, row: integer; aClosed: Boolean; LHandle: Integer;
aDrawStyle: TDrawStyle; aOwner: TComponent): TPolyline;
var pcnt,cnt,i: Integer;
p,p1,p2: TDoublePoint;
pp: TDoublePointArr;
res: TPolyline;
segOk: boolean;
begin
cnt := Length(Points);
pcnt := 0;
for i := 0 to cnt-1 do
begin
p := DoublePoint(Points[i].x,Points[i].y);
if (i mod 3) = 0 then begin
pCnt := pCnt+1;
SetLength(pp,pCnt);
pp[pcnt-1] := p;
end;
end;
if (aclosed) and (EQDP(pp[0],pp[pCnt-1])) then begin
pCnt := pCnt-1;
SetLength(pp,pCnt);
end;
res := Create(pp,w,s,c,aBrs,aBrc,row,aclosed,LHandle,aDrawStyle,aOwner);
// Tolik 24/05/2019 --
SetLength(pp, 0);
//
res.ConvertToBezier;
pCnt := 0;
for i := 0 to cnt-1 do
begin
p := DoublePoint(Points[i].x,Points[i].y);
if (i mod 3) = 1 then p1 := p;
if (i mod 3) = 2 then p2 := p;
segOk := False;
if ((i mod 3) = 0) and (i >0) then begin
pCnt := pCnt+1;
res.SetControlPointsOfSegment(pCnt,p1,p2);
segOk := True;
end;
end;
if not SegOk then begin
pCnt := pCnt+1;
res.SetControlPointsOfSegment(pCnt,p1,p2);
end;
result := res;
end;
procedure TPolyline.Initialize;
begin
inherited;
PointCount := 0;
SelectedPoint := 1;
Tracing := false;
Segments := TList.Create;
PenPattern := nil;
BrushBitmap := nil;
SetLength(HatchLines,0);
HatchSeg := -1;
SavedfigMaxX := -$FFFFFF;
SavedfigMaxY := -$FFFFFF;
SavedfigMinX := -$FFFFFF;
SavedfigMinY := -$FFFFFF;
SavedStateFig := '';
//NeedBounds := True; // Tolik 02/08/2021 --
end;
procedure TPolyline.AssignPenPattern(MasterPattern: TPattern);
begin
if assigned(PenPattern) then PenPattern.Free;
if assigned(MasterPattern) then
Penpattern := MasterPattern.Duplicate
else
Penpattern := nil;
end;
procedure TPolyline.OnNewPoint;
begin
inherited;
Segments.Add(TPlSegment.Create(PointCount,sLine,DoublePoint(0,0),DoublePoint(0,0)));
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.ArrangeSegment(SegNbr: integer; SegType: TSegmentType);
var Seg : TPLSegment;
i1,i2,i3: integer;
cp1,cp2,p1,p2: TDoublePoint;
mp : TDoublePoint;
preSeg,postSeg: integer;
mx,my: Double;
rad,rad1,rad2: DOuble;
begin
if SegNbr = 0 then exit;
Seg := Segments[SegNbr-1];
if assigned(seg) then seg.SType := SegType;
if SegType = sCurve then
begin
i2 := SegNbr;
if i2 = 1 then i1 := PointCount else i1 := i2-1;
if i2 = PointCount then i3 := 1 else i3 := i2+1;
if i2 = 1 then PreSeg := PointCount else preSeg := i2-1;
if TPLSegment(Segments[PreSeg-1]).SType = sCurve then
begin
cp1 := TPLSegment(Segments[i1-1]).Cpoint2;
mp := actualpoints[i2];
cp2 := RotatePoint(mp,cp1,pi);
end
else
GenerateBezierCPoints(actualpoints[i1],
actualpoints[i2],
actualpoints[i3],
cp1,cp2,false);
Seg.CPoint1 := cp2;
if SegNbr = PointCount then i2 := 1 else i2 := SegNbr+1;
if i2 = 1 then i1 := PointCount else i1 := i2-1;
if i2 = PointCount then i3 := 1 else i3 := i2+1;
PostSeg := i2;;
if TPLSegment(Segments[PostSeg-1]).SType = sCurve then
begin
cp2 := TPLSegment(Segments[PostSeg-1]).Cpoint1;
mp := actualpoints[i2];
cp1 := RotatePoint(mp,cp2,pi);
end
else
GenerateBezierCPoints(actualpoints[i1],
actualpoints[i2],
actualpoints[i3],
cp1,cp2,false);
Seg.CPoint2 := cp1;
end
else if SegType = sArc then
begin
//Get Prev Line
if SegNbr = 1 then
p1 := actualpoints[PointCount]
else
p1 := actualpoints[SegNbr-1];
p2 := actualpoints[SegNbr];
rad1 := getRadOfLine(p1,p2);
//Get Next Line
if SegNbr = PointCount then
i1 := 1
else
i1 := segnbr+1;
p1 := actualpoints[i1];
if i1 = PointCount then
i2 := 1
else
i2 := i1+1;
p2 := actualpoints[i2];
rad2 := getRadOfLine(p1,p2);
rad := rad1-rad2;
p1 := actualpoints[SegNbr];
if SegNbr = PointCount then
p2 := actualpoints[1]
else
p2 := actualpoints[SegNbr+1];
cp1 := GetArcCenter(p1,p2,rad);
Seg.CPoint1 := cp1;
Seg.CPoint2 := cp1;
if vertzero = 0 then seg.Inverted := true;
end;
ResetRegion;
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.ClearSegments;
var
Segment: TPlSegment;
a: integer;
begin
try
for a := 0 to Segments.Count - 1 do
begin
Segment := TPlSegment(Segments[a]);
Segment.Free;
end;
Segments.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPolyline.ClearSegments' + E.Message);
end;
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.ArrangeSelectedSegment(SegType: TSegmentType);
begin
ArrangeSegment(SelectedPoint,SegType);
end;
procedure TPolyline.InsertKnot(SegNbr: Integer);
var Seg : TPLSegment;
NewSeg: TPLSegment;
i: Integer;
begin
if SegNbr = 0 then exit;
Seg := Segments[SegNbr-1];
if assigned(seg) then begin
PointCount := PointCount+1;
ActualPoints[PointCount] := ActualPoints[PointCount-1];
OriginalPoints[PointCount] := OriginalPoints[PointCount-1];
for i := PointCount downto SegNbr+1 do
begin
ActualPoints[i] := ActualPoints[i-1];
OriginalPoints[i] := OriginalPoints[i-1];
end;
if SegNbr+1 = PointCount then begin
ActualPoints[SegNbr+1] := MPoint(ActualPoints[SegNbr],ActualPoints[1]);
OriginalPoints[Segnbr+1] := MPoint(OriginalPoints[SegNbr],OriginalPoints[1]);
end else begin
ActualPoints[SegNbr+1] := MPoint(ActualPoints[SegNbr],ActualPoints[SegNbr+2]);
OriginalPoints[Segnbr+1] := MPoint(OriginalPoints[SegNbr],OriginalPoints[SegNbr+2]);
end;
SegMents.Move(PointCount-1,SegNbr);
Seg := Segments[SegNbr-1];
ArrangeSegment(SegNbr, Seg.SType);
ArrangeSegment(SegNbr+1, Seg.SType);
NeedBounds := True; //Tolik 02/08/2021 --
end;
end;
procedure TPolyline.DeleteKnot(SegNbr: Integer);
var Seg : TPLSegment;
NewSeg: TPLSegment;
i: Integer;
begin
if SegNbr = 0 then
exit;
if PointCount < 3 then
exit;
Seg := Segments[SegNbr - 1];
if assigned(seg) then
begin
for i := segNbr to PointCount - 1 do
begin
ActualPoints[i] := ActualPoints[i+1];
OriginalPoints[i] := OriginalPoints[i+1];
end;
PointCount := PointCount-1;
ReDimenPoints;
Segments.Remove(seg);
Seg.Free;
NeedBounds := True; //Tolik 02/08/2021 --
end;
end;
procedure TPolyline.MoveControlPointsOfKnot(KnotNbr: Integer; DeltaX,
DeltaY: Double);
var s1,s2: integer;
Seg: TPlSegment;
begin
if KnotNbr =1 then
s1 := PointCount
else
s1 := KnotNbr-1;
s2 := KnotNbr;
seg := TPlSegment(Segments[s1-1]);
if seg.SType = sCurve then
begin
seg.CPoint2.x := seg.CPoint2.x +Deltax;
seg.CPoint2.y := seg.CPoint2.y +Deltay;
end
else
if seg.sType = sArc then
begin
ArrangeSegment(s1,sArc);
end;
seg := TPlSegment(Segments[s2-1]);
if seg.SType = sCurve then
begin
seg.CPoint1.x := seg.CPoint1.x +Deltax;
seg.CPoint1.y := seg.CPoint1.y +Deltay;
end
else
if seg.SType = sArc then
begin
ArrangeSegment(s2,sArc);
end;
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.GetControlPointsOfKnot(KnotNbr: integer; var cp1,
cp2: TDoublePoint);
var s1,s2: integer;
Seg: TPlSegment;
begin
if KnotNbr =1 then s1 := PointCount else s1 := KnotNbr-1;
s2 := KnotNbr;
seg := TPlSegment(Segments[s1-1]);
cp1 := seg.CPoint2;
seg := TPlSegment(Segments[s2-1]);
cp2 := seg.CPoint1;
end;
procedure TPolyline.GetControlPointsOfSegment(SegNbr: integer; var cp1,
cp2: TDoublePoint);
var Seg: TPlSegment;
begin
seg := TPlSegment(Segments[SegNbr-1]);
cp1 := seg.CPoint1;
cp2 := seg.CPoint2;
end;
procedure TPolyline.SetControlPointsOfKnot(KnotNbr: integer; cp1,
cp2: TDoublePoint);
var s1,s2: integer;
Seg: TPlSegment;
begin
if KnotNbr =1 then s1 := PointCount else s1 := KnotNbr-1;
s2 := KnotNbr;
seg := TPlSegment(Segments[s1-1]);
seg.CPoint2 := cp1;
seg := TPlSegment(Segments[s2-1]);
seg.CPoint1 := cp2;
end;
procedure TPolyline.SetControlPointsOfSegment(SegNbr: integer; cp1,
cp2: TDoublePoint);
var Seg: TPlSegment;
begin
seg := TPlSegment(Segments[SegNbr-1]);
seg.CPoint1 := cp1;
seg.CPoint2 := cp2;
end;
procedure TPolyline.BreakControlLine(KnotNbr: Integer);
begin
TPLSegment(Segments[KnotNbr-1]).TangentKnot := False;
end;
procedure TPolyline.TangentControlLine(KnotNbr: Integer);
var Seg: TPLSegment;
ap,cp1,cp2: TDoublePoint;
PreSeg: integer;
begin
Seg := Segments[KnotNbr-1];
Seg.TangentKnot := True;
cp1 := Seg.CPoint1;
ap := ActualPoints[KnotNbr];
cp2 := RotatePoint(ap,cp1,pi);
if KnotNbr = 1 then Preseg := PointCount else PreSeg := KnotNbr-1;
Seg := Segments[Preseg-1];
Seg.Cpoint2 := cp2;
end;
procedure TPolyline.InvertSegment(KnotNbr: Integer);
begin
TPLSegment(Segments[KnotNbr-1]).Inverted :=
not TPLSegment(Segments[KnotNbr-1]).Inverted;
end;
function TPolyline.IsKnotTangent(KnotNbr: Integer): Boolean;
begin
result := TPLSegment(Segments[KnotNbr-1]).TangentKnot;
end;
function TPolyline.TypeOfSegment(SegNbr: Integer): TSegmentType;
begin
result := TPLSegment(Segments[SegNbr-1]).sType;
end;
procedure TPolyline.Mirror(Point1, Point2: TDoublePoint);
var a: integer;
begin
inherited;
for a := 0 to segments.count-1 do
TPlSegment(Segments[a]).Mirror(Point1,Point2);
if Self.Parent <> nil then
if Self.Parent.Parent <> nil then
if Self.Parent.Parent.Cname = 'TFigureGrpMod' then
SavedStateFig := 'no state';
end;
Procedure TPolyline.VerifyZeroPoints(orgV,orgH:Byte);
var cad :TPCdrawing;
h,w:Double;
x,y:double;
i: Integer;
Seg: TPlSegment;
begin
inherited;
if assigned(owner) then
begin
cad := TPCDrawing(owner);
h := Cad.WorkHeight;
w := Cad.WorkWidth;
if (orgV <> VertZero) or (orgH <> HorzZero) then
begin
for i := 0 to segments.count-1 do
begin
Seg := TPlSegment(Segments[i]);
if orgV <> VertZero then begin
Seg.CPoint1.y := h - Seg.CPoint1.y;
Seg.CPoint2.y := h - Seg.CPoint2.y;
if Seg.SType = sArc then Seg.Inverted := not Seg.Inverted;
end;
if orgH <> HorzZero then begin
Seg.CPoint1.x := w - Seg.CPoint1.x;
Seg.CPoint2.x := w - Seg.CPoint2.x;
if Seg.SType = sArc then Seg.Inverted := not Seg.Inverted;
end;
end;
end;
end;
end;
procedure TPolyline.Move(deltax, deltay: double);
var a: integer;
begin
InMoveList := False;
if (JoinFigure1 = nil) or (JoinFigure2 = nil) then
begin
inherited;
for a := 0 to Segments.count-1 do
TPlSegment(Segments[a]).Move(deltaX,deltaY);
end else begin
for a:= 2 to pointcount-1 do
begin
originalpoints[a] := DoublePoint(originalpoints[a].x + deltax,
originalpoints[a].y + deltay);
Actualpoints[a] := DoublePoint(actualpoints[a].x + deltax,
actualpoints[a].y + deltay);
end;
for a := 0 to Segments.count-1 do
TPlSegment(Segments[a]).Move(deltaX,deltaY);
end;
if Self.Parent <> nil then
if Self.Parent.Parent <> nil then
if Self.Parent.Parent.Cname = 'TFigureGrpMod' then
SavedStateFig := 'no state';
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.Rotate(aAngle: double; cPoint: TDoublePoint);
var a: integer;
begin
inherited;
for a := 0 to segments.count-1 do
TPlSegment(Segments[a]).Rotate(aAngle,cPoint);
if Self.Parent <> nil then
if Self.Parent.Parent <> nil then
if Self.Parent.Parent.Cname = 'TFigureGrpMod' then
SavedStateFig := 'no state';
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.scale(percentx, percenty: double; rPoint: TDoublePoint);
var a: integer;
begin
inherited;
for a := 0 to segments.count-1 do
TPlSegment(Segments[a]).Scale(percentx,percenty,rPoint);
if Self.Parent <> nil then
if Self.Parent.Parent <> nil then
if Self.Parent.Parent.Cname = 'TFigureGrpMod' then
SavedStateFig := 'no state';
NeedBounds := True; //Tolik 02/08/2021 --
end;
Procedure TPolyline.UpdateMenu(var PopMenu: TPopUpMenu; var sIndex: integer);
var mnItem,mnSub: TMenuItem;
Seg: TPLSegment;
Cad: TPCDrawing;
i:Integer;
xPattern:TPattern;
begin
Seg := TPLSegment(Segments[SelectedPoint-1]);
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmCurveAll;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Tag := sIndex+1;
mnItem.Caption := fmLineAll;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
if Closed then begin
mnItem.Tag := sIndex+2;
mnItem.Caption := fmOpenFigure;
end else begin
mnItem.Tag := sIndex+3;
mnItem.Caption := fmCloseFigure;
end;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmControlLine;
mnItem.Tag := sIndex+4;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmTangentLine;
mnSub.Tag := sIndex+5;
if Seg.TangentKnot then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBrokenLegs;
mnSub.Tag := sIndex+6;
if not Seg.TangentKnot then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmInsertKnot;
mnItem.Tag := sIndex+7;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDeleteKnot;
mnItem.Tag := sIndex+8;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmSegment;
mnItem.Tag := 0;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmLinear;
mnSub.Tag := sIndex+9;
if Seg.SType = sLine then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmCurve;
mnSub.Tag := sIndex+10;
if Seg.SType = sCurve then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmArc;
mnSub.Tag := sIndex+11;
if Seg.SType = sArc then mnSub.Checked := True;
mnItem.Add(mnSub);
if Seg.SType = sArc then
begin
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := '-';
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmInvertArcSegment;
mnSub.Tag := sIndex+12;
mnItem.Add(mnSub);
end;
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := '-';
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmDimensionLine;
mnSub.Tag := sIndex+15;
mnSub.Checked := Seg.ShowDim;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDivideTo3;
mnItem.Tag := sIndex+14;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmRoundCorner;
mnItem.Tag := sIndex+16;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmPenPattern;
mnItem.Tag := 0;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmNoPattern;
mnSub.Tag := sIndex+13;
if PenPattern = nil then mnSub.Checked := True;
mnItem.Add(mnSub);
if assigned(owner) then begin
Cad := TPCDrawing(Owner);
for i := 0 to Cad.PenPatternCount-1 do
begin
xPattern := Cad.PenPattern[i];
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := xpattern.Patname;
mnSub.Tag := sIndex+17+i;
if Assigned(PenPattern) and (PenPattern.PatName = xPattern.PatName) then mnSub.Checked := True;
mnItem.Add(mnSub);
end;
end;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmBrushPattern;
mnItem.Tag := 0;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmNoBPattern;
mnSub.Tag := sIndex+100;
if PenPattern = nil then mnSub.Checked := True;
mnItem.Add(mnSub);
if assigned(owner) then begin
Cad := TPCDrawing(Owner);
for i := 0 to Cad.BrushPatternCount-1 do
begin
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := 'Brush'+inttostr(i+1);
mnSub.Tag := sIndex+101+i;
mnItem.Add(mnSub);
end;
end;
sIndex := sIndex+200;
end;
procedure TPolyline.MenuClicked(commandID:integer);
var idx: integer;
i: Integer;
Cad: TPCDrawing;
rad: Double;
begin
idx := commandID-menuIndex;
case idx of
0: ConvertToBezier;
1: ConvertToPolyLine;
2: Closed := false;
3: Closed := true;
5: TangentControlLine(SelectedPoint);
6: BreakControlLine(SelectedPoint);
7: begin
InsertKnot(SelectedPoint);
if SelectedPoint = PointCount then SelectedPoint :=1 else SelectedPoint :=SelectedPoint+1;
end;
8: begin
if PointCount < 3 then exit;
DeleteKnot(SelectedPoint);
if SelectedPoint > PointCount then SelectedPoint := PointCount else
if SelectedPoint > 1 then SelectedPoint := SelectedPoint-1;
end;
9: ArrangeSegment(SelectedPoint,sLine);
10: ArrangeSegment(SelectedPoint,sCurve);
11: ArrangeSegment(Selectedpoint,sArc);
12: InvertSegment(Selectedpoint);
13: AssignPenPattern(nil);
14: begin
DivideSegment(SelectedPoint,3);
if SelectedPoint = PointCount then SelectedPoint :=1 else SelectedPoint :=SelectedPoint+1;
end;
15: begin
ToggleSegmentDimension(SelectedPoint-1);
end;
16: begin
Rad := 5;
if InputDouble('Round Corner By Arc','Ener Arc Corner',Rad) then begin
RoundCornerByArc(SelectedPoint,Rad);
end;
end;
end;
if (idx > 16) and (idx < 100) then
begin
i := idx -17;
if assigned(Owner) then begin
Cad := TPCDrawing(Owner);
AssignPenPattern(Cad.PenPattern[i]);
end;
end;
if (idx >=100) then begin
if idx = 100 then begin
BrushBitmap := nil
end else if assigned(owner) then begin
i := idx -101;
Cad := TPCDrawing(Owner);
BrushBitmap := (Cad.BrushList[i]);
end;
end;
end;
class function TPolyline.CreateShadow(x, y: double): TFigure;
var points: TDoublePointArr;
begin
SetLength(points,2);
points[0] := DoublePoint(x,y);
points[1] := DoublePoint(x,y);
Result := TPolyLine.create(Points,1,1,clLime,0,0,ord(rsNone),false,0,dsTrace,nil);
TPolyLine(Result).KeyControl := PolylineKeyControl;
PolylineKeyControl := False;
end;
function TPolyline.ShadowClick(ClickIndex:Integer; x, y: Double): Boolean;
var dx,dy: Double;
xp: TDoublePoint;
Snapped: Boolean;
begin
result := false;
if KeyControl then begin
Snapped := False;
dx := ABS(actualPoints[1].x - x);
dy := ABS(actualPoints[1].y - y);
if (PointCount > 2) and (dx < 3) and (dy < 3) then begin
x := actualPoints[1].x;
y := actualPoints[1].y;
Snapped := True;
end;
xp := actualpoints[PointCount-1];
dx := x- xp.x;
dy := y- xp.y;
if abs(dx) > abs(dy) then begin
if Snapped then actualpoints[PointCount-1] := DoublePoint(actualpoints[PointCount-1].x,y) else y := xp.y;
end else begin
if Snapped then actualpoints[PointCount-1] := DoublePoint(x,actualpoints[PointCount-1].y) else x := xp.x;
end;
end else begin
dx := ABS(actualPoints[1].x - x);
dy := ABS(actualPoints[1].y - y);
if (PointCount > 2) and (dx < 3) and (dy < 3) then begin
x := actualPoints[1].x;
y := actualPoints[1].y;
end;
end;
if clickindex > 1 then begin
PointCount := PointCount+1;
actualPoints[clickIndex] := DoublePoint(x,y);
actualPoints[clickIndex+1] := DoublePoint(x,y);
if (ActualPoints[1].x = x) and (ActualPoints[1].y = y) and (ClickIndex > 2) then begin
result := True;
Closed := True;
end;
end;
end;
Function TPolyline.ShadowTrace(ClickIndex:Integer; x, y: double): Boolean;
var dx,dy: Double;
xp: TDoublePOint;
snapped: Boolean;
begin
if KeyControl then begin
if ClickIndex = 1 then exit;
Snapped := False;
dx := ABS(actualPoints[1].x - x);
dy := ABS(actualPoints[1].y - y);
if (PointCount > 2) and (dx < 3) and (dy < 3) then begin
x := actualPoints[1].x;
y := actualPoints[1].y;
Snapped := True;
end;
xp := actualpoints[PointCount-1];
dx := x- xp.x;
dy := y- xp.y;
if abs(dx) > abs(dy) then begin
if Snapped then actualPoints[PointCount-1] := DoublePoint(actualPoints[PointCount-1].x,y) else y := xp.y;
end else begin
if Snapped then actualPoints[PointCount-1] := DoublePoint(x,actualPoints[PointCount-1].y) else x := xp.x;
end;
end else begin
dx := ABS(actualPoints[1].x - x);
dy := ABS(actualPoints[1].y - y);
if (PointCount > 2) and (dx < 3) and (dy < 3) then begin
x := actualPoints[1].x;
y := actualPoints[1].y;
end;
end;
actualPoints[clickindex+1] := DoublePoint(x,y);
result := false;
end;
class function TPolyline.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
points: TDoublePointArr;
a: integer;
begin
result := nil;
cad := TPCDrawing(aOwner);
if Shadow.PointCount < 4 then exit;
SetLength(points,Shadow.PointCount-2);
for a := 1 to Shadow.PointCount-2 do begin
points[a-1] := Shadow.ActualPoints[a];
end;
result := TPolyLine.create(points,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultRowStyle),
TPolyline(Shadow).Closed or
Cad.DefaultPLineClosed,
LHandle,mydsNormal,aOwner);
end;
function TPolyline.CreateModification: TFigure;
var points: TDoublePointArr;
a: integer;
Res: TPolyLine;
p: PPoint;
ps: TBezierPoint;
begin
SetLength(points,PointCount);
for a := 1 to PointCount do
begin
points[a-1] := ActualPoints[a];
end;
Res := TPolyLine.create(points,1,1,clLime,0,0,0,closed,0,dsTrace,nil);
Res.Segments.Clear;
for a := 0 to Segments.Count -1 do
Res.Segments.Add(TPlSegment(Segments[a]).Duplicate);
res.SelectedPoint := SelectedPoint;
if assigned(res) then res.RotPoint := RotPoint;
CreateModification := res;
// Tolik 24/05/2019 - -
SetLength(points, 0);
//
end;
function TPolyline.TraceModification(CadControl: Pointer;mp: TModPoint;
TraceFigure:TFigure;x,y: double;Shift: TShiftState): boolean;
var cp1,cp2: TDoublePoint;
xp,p1,p2: TDoublePoint;
ptIndex: integer;
cIndex,r1 : integer;
ang1,ang2: double;
isTan: Boolean;
rad1,rad2: double;
a,b: double;
begin
TPolyLine(TraceFigure).Tracing := true;
if (mp.PType = ptPolyPoint) or (mp.PType = ptRectPoint) then begin
p1 := TraceFigure.ActualPoints[mp.SeqNbr];
TraceFigure.ActualPoints[mp.SeqNbr]:= DoublePoint(x,y);
TPolyLine(TraceFigure).MoveControlPointsOfKnot(mp.SeqNbr,x-p1.x,y-p1.y);
end else if mp.PType = ptControlPoint then begin
ptIndex := (mp.SeqNbr div 10);
cIndex := (mp.SeqNbr mod 10);
isTan := TPolyLine(TraceFigure).IsKnotTangent(ptIndex);
p1 := TraceFigure.ActualPoints[ptIndex];
TPolyline(TraceFigure).GetControlPointsOfKnot(ptIndex,cp1,cp2);
if cIndex = 1 then begin
ang1 := GetRadOfLine(p1,cp1);
cp1 := DoublePoint(x,y);
if isTan and (TPolyline(TraceFigure).TypeOfSegment(ptIndex) = sCurve)
then begin
ang2 := GetRadOfLine(p1,cp1);
cp2 := RotatePoint(p1,cp2,ang2-ang1);
end;
end
else if cIndex = 2 then begin
ang1 := GetRadOfLine(p1,cp2);
cp2 := DoublePoint(x,y);
if ptIndex = 1 then cIndex := PointCount else cIndex := ptIndex-1;
if isTan and (TPolyline(TraceFigure).TypeOfSegment(cIndex) = sCurve)
then begin
ang2 := GetRadOfLine(p1,cp2);
cp1 := RotatePoint(p1,cp1,ang2-ang1);
end;
end;
TPolyline(TraceFigure).SetControlPointsOfKnot(ptIndex,cp1,cp2);
end else if mp.PType = ptArcControl then begin
ptIndex := mp.SeqNbr;
p1 := TraceFigure.ActualPoints[ptIndex];
if ptIndex <> PointCount then
p2 := TraceFigure.ActualPoints[ptIndex+1]
else
p2 := TraceFigure.ActualPoints[1];
GetControlPointsOfKnot(ptIndex,cp1,cp2);
xp := DoublePoint((p1.x+p2.x) / 2,(p1.y+p2.y) / 2);
if (xp.x = cp2.x) and (xp.y = cp2.y) then begin
PointTo90Line(p1,p2,x,y);
end else
PointToLine(xp,cp2,x,y);
cp2 := DoublePoint(x,y);
TPolyline(TraceFigure).SetControlPointsOfKnot(ptIndex,cp1,cp2);
end;
end;
function TPolyline.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y: double;Shift: TShiftState): boolean;
var xp,p1,p2: TDoublePoint;
cp1,cp2: TDoublePoint;
ptIndex: integer;
cindex,r1 : integer;
ang1,ang2: double;
Cad: TPCdrawing;
isTan:Boolean;
rad1,rad2: double;
begin
Tracing := false;
Cad := TPCDrawing(CadControl);
if (mp.PType = ptPolyPoint) or (mp.PType = ptRectPoint) then begin
p1 := ActualPoints[MP.SeqNbr];
ActualPoints[MP.SeqNbr] :=
DoublePoint(ActualPoints[MP.SeqNbr].x + (x-p1.x),
ActualPoints[MP.SeqNbr].y + (y-p1.y));
MoveControlPointsOfKnot(mp.SeqNbr,x-p1.x,y-p1.y);
end
else
if mp.PType = ptControlPoint then
begin
ptIndex := (mp.SeqNbr div 10);
cIndex := (mp.SeqNbr mod 10);
isTan := IsKnotTangent(ptIndex);
p1 := ActualPoints[ptIndex];
GetControlPointsofKnot(ptIndex,cp1,cp2);
if cIndex = 1 then
begin
ang1 := GetRadOfLine(p1,cp1);
cp1 := DoublePoint(x,y);
if isTan and (TypeOfSegment(ptIndex) = sCurve)
then
begin
ang2 := GetRadOfLine(p1,cp1);
cp2 := RotatePoint(p1,cp2,ang2-ang1);
end;
end
else if cIndex = 2 then
begin
ang1 := GetRadOfLine(p1,cp2);
cp2 := DoublePoint(x,y);
if ptIndex = 1 then cIndex := PointCount else cIndex := ptIndex-1;
if isTan and (TypeOfSegment(cIndex) = sCurve)
then begin
ang2 := GetradOfLine(p1,cp2);
cp1 := RotatePoint(p1,cp1,ang2-ang1);
end;
end;
SetControlPointsofKnot(ptIndex,cp1,cp2);
end
else if mp.PType = ptArcControl then
begin
ptIndex := mp.SeqNbr;
p1 := ActualPoints[ptIndex];
if ptIndex <> PointCount then
p2 := ActualPoints[ptIndex+1]
else
p2 := ActualPoints[1];
GetControlPointsOfKnot(ptIndex,cp1,cp2);
xp := DoublePoint((p1.x+p2.x) / 2,(p1.y+p2.y) / 2);
if (xp.x = cp2.x) and (xp.y = cp2.y) then
begin
PointTo90Line(p1,p2,x,y);
end
else
PointToLine(xp,cp2,x,y);
cp2 := DoublePoint(x,y);
SetControlPointsOfKnot(ptIndex,cp1,cp2);
end;
if ((MP.SeqNbr = 1) or (MP.SeqNbr = PointCount ))
and (ssCtrl in Shift) and (ssShift in Shift) then
begin
Cad.BoundLinePoint(self.Handle,MP.SeqNbr,DoublePoint(x,y));
end;
ResetRegion;
Modified := True;
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.setClosed(const Value: Boolean);
begin
fClosed := Value;
end;
Procedure TPolyline.ConvertToBezier;
var a: integer;
begin
for a := 1 to pointcount do
ArrangeSegment(a,sCurve);
NeedBounds := True; //Tolik 02/08/2021 --
end;
Procedure TPolyline.ConvertToPolyLine;
var a: integer;
begin
for a := 1 to pointcount do
ArrangeSegment(a,sLine);
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.JoinFigureMoved(Sender: TFigure; dx, dy: double);
begin
if inMoveList then exit;
if sender = JoinFigure1 then
ActualPoints[1] := DoublePoint(ap1.x + dx ,ap1.y + dy);
if sender = JoinFigure2 then
ActualPoints[PointCount] := DoublePoint(ActualPoints[PointCount].x + dx ,
ActualPoints[PointCount].y + dy);
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TPolyline.SetJFigure1(jf: TFigure);
begin
if jf = JoinFigure1 then exit;
if jf = nil then
JoinFigure1.JoinedFigures.Remove(self);
JoinFigure1 := jf;
if jf <> nil then jf.JoinedFigures.Add(self);
end;
procedure TPolyline.SetJFigure2(jf: TFigure);
begin
if jf = JoinFigure2 then exit;
if jf = nil then
JoinFigure2.JoinedFigures.Remove(self);
JoinFigure2 := jf;
if jf <> nil then jf.JoinedFigures.Add(self);
end;
procedure TPolyline.UnBound;
begin
JoinFigure1 := nil;
JoinFigure2 := nil;
end;
procedure TPolyline.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt,a: Integer;
xDbl: Double;
xStr: String;
ps: TBezierPoint;
Seg: TPlSegment;
sType: Byte;
SegStream: TMemoryStream;
begin
inherited;
//Tolik 22/11/2019--
//xByte := RowStyle;
if RowStyle = -1 then
xByte := 255
else
xByte := LoByte(LoWord(RowStyle));
WriteField(90,Stream,xByte,1);
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(91,Stream,xByte,1);
// Tolik 22/11/219 --
if closed then
xByte := 1
else
xByte := 0;
WriteField(92,Stream,xByte,1);
{if closed then
begin
xByte := 1;
WriteField(92,Stream,xByte,1);
end
else
begin
xByte := 0;
WriteField(92,Stream,xByte,1);
end;}
//
xInt := brc;
WriteField(20,Stream,xInt,4);
xInt := HatchSeg;
WriteField(21,Stream,xInt,4);
xDbl := HatchDist;
WriteField(220,Stream,xDbl,8);
SegStream := TMemoryStream.Create;
SegmentsToStream(SegStream);
if SegStream.Size > 0 then begin
WriteStreamField(151,Stream,SegStream);
end;
SegStream.Free;
if assigned(PenPattern) then
begin
SegStream := TMemoryStream.Create;
Penpattern.SaveToStream(SegStream);
WriteStreamField(152,Stream,SegStream);
SegStream.Free;
end;
end;
Procedure TPolyLine.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var ByteVal: Byte;
a,cpIndex: integer;
SegStr: TMemoryStream;
preSeg,Seg: TPlSegment;
cp: TPoint;
pStyle1,pStyle2: Byte;
pStyles: array of Byte;
pIdx: Integer;
cp1,cp2,cp11,cp22: TPoint;
ap1,ap2: TDoublePoint;
begin
Case xcode of
20: brc := pInt(data)^;
21: HatchSeg := pInt(data)^;
90:
begin
if pByte(data)^ = 255 then
RowStyle := -1
else
RowStyle := pByte(data)^;
end;
91:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
92: closed := (pByte(data)^ = 1);
220: HatchDist := pDouble(data)^;
150: begin
// old style polyline - stored pointstyles
pIdx := 0;
Setlength(pStyles,Size);
for a := 1 to Size do
begin
// Tolik 26/03/2019 --
pStyles[a-1] := pByte(pChar(data)+a-1)^;
// pStyles[a-1] := pByte(pAnsiChar(data)+a-1)^;
//
end;
for a := 1 to Size do
begin
pStyle1 := pStyles[a-1];
ap1 := ActualPoints[a];
if a = Size then pStyle2 := pStyles[0] else pStyle2 := pStyles[a];
if a = Size then ap2 := ActualPoints[1] else ap2 := ActualPoints[a+1];
if pStyle1 <> 0 then begin
cp1 := fTempPoints[pIdx];inc(pIdx);
cp2 := fTempPoints[pIdx];inc(pIdx);
end;
if pStyle2 <> 0 then begin
cp11 := fTempPoints[pIdx];
cp22 := fTempPoints[pIdx+1];
end;
if (pStyle1 = 0) and (pStyle2 = 0) then begin
TPLSegment(Segments[a-1]).SType := sLine ;
end else if (pStyle1 = 0) and (pStyle2 <> 0) then begin
TPLSegment(Segments[a-1]).SType := sCurve;
TPLSegment(Segments[a-1]).CPoint1 := ap1;
TPLSegment(Segments[a-1]).CPoint2 := DoublePoint(cp11.x/10,cp11.y/10);
end else if (pStyle1 <> 0) and (pStyle2 = 0) then begin
TPLSegment(Segments[a-1]).SType := sCurve;
TPLSegment(Segments[a-1]).CPoint2 := ap2;
TPLSegment(Segments[a-1]).CPoint1 := DoublePoint(cp2.x/10,cp2.y/10);
TPLSegment(Segments[a-1]).TangentKnot := (pStyle1 = 1);
end else if (pStyle1 <> 0) and (pStyle2 <> 0) then begin
TPLSegment(Segments[a-1]).SType := sCurve;
TPLSegment(Segments[a-1]).CPoint1 := DoublePoint(cp2.x/10,cp2.y/10);
TPLSegment(Segments[a-1]).CPoint2 := DoublePoint(cp11.x/10,cp11.y/10);
TPLSegment(Segments[a-1]).TangentKnot := (pStyle1 = 1);
end;
end;
// Tolik 24/05/2019 - -
Setlength(pStyles, 0);
//
end;
151: begin
// new style polyline - stored segments
SegStr := TMemoryStream.Create;
SegStr.Write(pByte(data)^,size);
SegStr.Position := 0;
SegmentsFromStream(SegStr);
SegStr.Free;
end;
152: begin
// pattern
SegStr := TMemoryStream.Create;
SegStr.Write(pByte(data)^,size);
SegStr.Position := 0;
PenPattern := Tpattern.Create(nil,0,0);
if oldPatternFormat then
PenPattern.LoadFromStreamOldFormat(SegStr)
else
PenPattern.LoadFromStream(SegStr);
SegStr.Free;
end;
end;
end;
procedure TPolyline.SegmentsFromStream(xStream: TStream);
var sType: Byte;
index: Integer;
Seg: TPlSegment;
cx,cy: Double;
ix,iy: Integer;
xByte: Byte;
begin
repeat
xStream.Read(Index,4);
Seg := TPlSegment(Segments[Index-1]);
xStream.Read(sType,1);
Seg.Stype := TSegmentType(sType);
if Seg.sType = sCurve then
begin
if oldStyleLoad then
begin
xStream.Read(ix,4);
xStream.Read(iy,4);
Seg.CPoint1.x := ix/10;
Seg.CPoint1.y := iy/10;
xStream.Read(ix,4);
xStream.Read(iy,4);
Seg.CPoint2.x := ix/10;
Seg.CPoint2.y := iy/10;
end
else
begin
xStream.Read(cx,8);
if CompareValue(cx, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
cx := 0;
xStream.Read(cy,8);
if CompareValue(cy, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
cy := 0;
Seg.CPoint1.x := cx;
Seg.CPoint1.y := cy;
xStream.Read(cx,8);
if CompareValue(cx, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
cx := 0;
xStream.Read(cy,8);
if CompareValue(cy, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
cy := 0;
Seg.CPoint2.x := cx;
Seg.CPoint2.y := cy;
end;
xStream.Read(xByte,1);
Seg.TangentKnot := (xByte = 1);
end else if Seg.sType = sArc then
begin
if oldStyleLoad then begin
xStream.Read(ix,4);
xStream.Read(iy,4);
Seg.CPoint1.x := ix/10;
Seg.CPoint1.y := iy/10;
end
else
begin
xStream.Read(cx,8);
if CompareValue(cx, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
cx := 0;
xStream.Read(cy,8);
if CompareValue(cy, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
cy := 0;
Seg.CPoint1.x := cx;
Seg.CPoint1.y := cy;
end;
xStream.Read(xByte,1);
Seg.Inverted := (xByte = 1);
end;
until xStream.Position >= xStream.Size;
end;
procedure TPolyline.SegmentsToStream(xStream: TStream);
var xByte: Byte;
sType: Byte;
a: integer;
Seg: TPlSegment;
begin
For a := 1 to PointCount do
begin
Seg := TPlSegment(Segments[a-1]);
sType := ord(Seg.sType);
if sType = ord(sCurve) then
begin
// Index | Type | c1 | c2 | isTangent
xStream.Write(a,4);
xStream.Write(sType,1);
xStream.Write(seg.Cpoint1.x,8);
xStream.Write(seg.Cpoint1.y,8);
xStream.Write(seg.Cpoint2.x,8);
xStream.Write(seg.Cpoint2.y,8);
if Seg.TangentKnot then
xByte := 1
else
xByte := 0;
xStream.Write(xByte,1);
end
else
if sType = ord(sArc) then
begin
// Index | Type | c1 | Inverted
xStream.Write(a,4);
xStream.Write(sType,1);
xStream.Write(seg.Cpoint1.x,8);
xStream.Write(seg.Cpoint1.y,8);
if Seg.Inverted then
xByte := 1
else
xByte := 0;
xStream.Write(xByte,1);
end;
end;
end;
procedure TPolyLine.CollectPolyBezierPoints(var pdPoints: TDoublePointArr);
var rpS1,rpS2,rpE1,rpE2:TDoublePoint;
fLine,lLine:Boolean;
begin
CollectPolyBezierPoints(pdPoints,rpS1,rpS2,rpE1,rpE2,fLine,lLine);
end;
procedure TPolyLine.CollectPolyBezierPoints(var pdPoints: TDoublePointArr;
var rpS1,rpS2,rpE1,rpE2:TDoublePoint;
var fLine,lLine:Boolean);
var
a,ax: integer;
cp1,cp2,c1,c2: TDoublePoint;
p1,p2: TDoublePoint;
ps1,ps2: TBezierPoint;
pcnt: integer;
pIdx: integer;
Segment: TPLSegment;
lp: integer;
a1,a2,at,distA: double;
radius: Double;
cnt,i,ix: integer;
Fpoints : T2DPointArray;
Inverted: Boolean;
valid:Boolean;
begin
if Closed then lp := PointCount else lp := PointCount-1;
pIdx := 0;
fLine := False;
lLine := False;
ax := 0;
For a := 1 to lp do
begin
Segment := TPlSegment(Segments[a-1]);
p1 := actualpoints[a];
if a = PointCount then p2 := actualpoints[1]
else p2 := actualpoints[a+1];
valid := not EQDP(p1,p2);
if valid then begin
ax := ax+1;
if (Segment.SType = sLine) then
begin
if ax = 1 then begin
SetLength(pdPoints,pIdx+4);
pdPoints[pIdx] := p1;inc(pIdx);
rpS1 := p1;
rps2 := p2;
fLine := True;
end else
SetLength(pdPoints,pIdx+3);
if a = PointCount-1 then
begin
rpE1 := p1;
rpE2 := p2;
lLine := True;
end;
pdPoints[pIdx] := p1;inc(pIdx);
pdPoints[pIdx] := p2;inc(pIdx);
pdPoints[pIdx] := p2;inc(pIdx);
end else if (Segment.SType = sArc) then
begin
c1 := Segment.CPoint1;
a1 := GetRadOfLine(c1,p1);
a2 := GetRadOfLine(c1,p2);
if a2 = 0 then a2 := 2*pi;
if a1>a2 then
distA := 2*pi - a1+a2
else
distA := a2-a1;
Inverted := Segment.Inverted;
if Inverted then
begin
at := a1;
a1 := a2;
a2 := at;
end;
radius := GetLineLenght(p1,c1);
BezierArcPoints(FPoints,c1.x,c1.y,Radius,a1,a2);
cnt := Length(FPoints);
if a = 1 then begin
SetLength(pdPoints,pIdx+cnt);
pdPoints[pIdx] := p1;inc(pIdx);
end else
SetLength(pdPoints,pIdx+cnt-1);
for I := 1 to cnt-1 do
begin
if Inverted then ix := cnt-I-1
else ix := i;
pdPoints[pIdx] := DoublePoint(FPoints[Ix].X,
FPoints[Ix].Y);
inc(pIdx);
end;
// Tolik 24/05/2019 --
SetLength(Fpoints, 0);
//
end else if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
if a = 1 then begin
SetLength(pdPoints,pIdx+4);
pdPoints[pIdx] := p1;inc(pIdx);
end else
SetLength(pdPoints,pIdx+3);
pdPoints[pIdx] := c1;inc(pIdx);
pdPoints[pIdx] := c2;inc(pIdx);
pdPoints[pIdx] := p2;inc(pIdx);
end;
end;
end;
end;
procedure TPolyline.OffSetSegments(var NewSegs: TList; w: Double);
var
a: integer;
cp1,cp2,c1,c2: TDoublePoint;
p1,p2,np1,np2: TDoublePoint;
Segment: TPLSegment;
lp,i: integer;
ww: Double;
xSeg: TPLSegment;
seg1,seg2: TPLSegment;
valid: Boolean;
bArr: TDoublePOintArr;
begin
if Closed then lp := PointCount else lp := PointCount-1;
For a := 1 to lp do
begin
Segment := TPlSegment(Segments[a-1]);
p1 := actualpoints[a];
if a = PointCount then p2 := actualpoints[1]
else p2 := actualpoints[a+1];
valid := not EQDP(p1,p2);
if valid then begin
if (Segment.SType = sLine) then
begin
GetParallelPoints(p1,p2,np1,np2,w);
xSeg := TPLSegment.Create(0,sLine,np1,np2);
xSeg.tp1 := np1;
xSeg.tp2 := np2;
NewSegs.Add(xSeg);
end else if (Segment.SType = sArc) then
begin
c1 := Segment.CPoint1;
ww := w;
if Segment.Inverted then ww := -w;
OffsetPoint(p1,c1,np1,ww);
OffsetPoint(p2,c1,np2,ww);
xSeg := TPLSegment.Create(0,sArc,c1,c1);
xSeg.tp1 := np1;
xSeg.tp2 := np2;
xSeg.Inverted := Segment.Inverted;
NewSegs.Add(xSeg);
end else if Segment.SType = sCurve then
begin
cp1 := Segment.CPoint1;
cp2 := Segment.CPoint2;
DoubleBezier(p1,cp1,cp2,p2,bArr,w);
for i:= 0 to Length(bArr)-2 do
begin
np1 := bArr[i];
np2 := bArr[i+1];
xSeg := TPLSegment.Create(0,sLine,np1,np2);
xSeg.tp1 := np1;
xSeg.tp2 := np2;
NewSegs.Add(xSeg);
end;
SetLength(bArr,0);
end;
end;
end;
if Closed then lp := NewSegs.Count else lp := NewSegs.Count-1;
i := 1;
while i <= lp do begin
Seg1 := TPlSegment(NewSegs[i-1]);
if i > NewSegs.Count-1 then
Seg2 := TPlSegment(NewSegs[0])
else
Seg2 := TPlSegment(NewSegs[i]);
if not IntersectSegments(seg1,seg2) then begin
xSeg := TPLSegment.Create(0,sLine,Seg1.tp2 ,Seg2.tp1);
xSeg.tp1 := Seg1.tp2;
xSeg.tp2 := Seg2.tp1;
NewSegs.Insert(i,xSeg);
lp := lp+1;
end;
i := i +1;
end;
end;
procedure TPolyLine.OffsetPolyBezierPoints(var pdPoints: TDoublePointArr;W:Double);
var tSegments: TList;
a: Integer;
Segment: TPlSegment;
pIdx,cnt,I,Ix: Integer;
a1,a2,at,distA: Double;
c1,c2,p1,p2: TdoublePoint;
Inverted:Boolean;
FPoints: T2DPointArray;
begin
tSegments := Tlist.Create;
OffsetSegments(tSegments,w);
pIdx := 0;
For a := 1 to tSegments.Count do
begin
Segment := TPlSegment(TSegments[a-1]);
p1 := Segment.tp1;
p2 := Segment.tp2;
if (Segment.SType = sLine) then
begin
if a = 1 then begin
SetLength(pdPoints,pIdx+4);
pdPoints[pIdx] := p1;inc(pIdx);
end else
SetLength(pdPoints,pIdx+3);
pdPoints[pIdx] := p1;inc(pIdx);
pdPoints[pIdx] := p2;inc(pIdx);
pdPoints[pIdx] := p2;inc(pIdx);
end else if (Segment.SType = sArc) then
begin
c1 := Segment.CPoint1;
a1 := GetRadOfLine(c1,p1);
a2 := GetRadOfLine(c1,p2);
if a2 = 0 then a2 := 2*pi;
if a1>a2 then
distA := 2*pi - a1+a2
else
distA := a2-a1;
Inverted := Segment.Inverted;
if Inverted then
begin
at := a1;
a1 := a2;
a2 := at;
end;
radius := GetLineLenght(p1,c1);
BezierArcPoints(FPoints,c1.x,c1.y,Radius,a1,a2);
cnt := Length(FPoints);
if a = 1 then begin
SetLength(pdPoints,pIdx+cnt);
pdPoints[pIdx] := p1;inc(pIdx);
end else
SetLength(pdPoints,pIdx+cnt-1);
for I := 1 to cnt-1 do
begin
if Inverted then ix := cnt-I-1
else ix := i;
pdPoints[pIdx] := DoublePoint(FPoints[Ix].X,
FPoints[Ix].Y);
inc(pIdx);
end;
end else if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
if a = 1 then begin
SetLength(pdPoints,pIdx+4);
pdPoints[pIdx] := p1;inc(pIdx);
end else
SetLength(pdPoints,pIdx+3);
pdPoints[pIdx] := c1;inc(pIdx);
pdPoints[pIdx] := c2;inc(pIdx);
pdPoints[pIdx] := p2;inc(pIdx);
end;
end;
try
for i := 0 to TSegments.Count-1 do
begin
Segment := TPlSegment(TSegments[i]);
Segment.Free;
end;
TSegments.Free;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPolyLine.OffsetPolyBezierPoints' + E.Message);
end;
end;
Function IntersectSegments(var seg1,seg2: TPLSegment):Boolean;
var p1,p2,p3,p4,np,cp1,cp2,cp3,cp4,np1,np2: TDoublePoint;
radius,rad1,rad2: Double;
iCnt:Integer;
begin
p1 := Seg1.tp1;p2 := Seg1.tp2;
p3 := Seg2.tp1;p4 := Seg2.tp2;
cp1 := Seg1.Cpoint1;cp2 := Seg1.Cpoint2;
cp3 := Seg2.Cpoint1;cp4 := Seg2.Cpoint2;
result := false;
if (seg1.SType = sLine) and (seg2.SType = sLine) then begin
if GetInterSectionPoint(p1,p2,p3,p4,np) then begin
Seg1.tp2 := np;
Seg2.tp1 := np;
result := True;
end;
end else if (seg1.SType = sLine) and (seg2.SType = sArc) then begin
radius := GetLineLenght(p3,cp3);
if GetLineCircleIntersection(p1,p2,cp3,radius,np1,np2,iCnt) then begin
if icnt = 1 then np := np1 else np := GetClosePoint(p2,np1,np2);
Seg1.tp2 := np;
Seg2.tp1 := np;
result := True;
end;
end else if (seg1.SType = sArc) and (seg2.SType = sLine) then begin
radius := GetLineLenght(p1,cp1);
if GetLineCircleIntersection(p3,p4,cp1,radius,np1,np2,iCnt) then begin
if icnt = 1 then np := np1 else np := GetClosePoint(p3,np1,np2);
Seg1.tp2 := np;
Seg2.tp1 := np;
result := True;
end;
end else if (seg1.SType = sArc) and (seg2.SType = sArc) then begin
rad1 := GetLineLenght(p1,cp1);
rad2 := GetLineLenght(p3,cp3);
if GetCircleCircleIntersection(cp1,rad1,cp3,rad2,np1,np2,iCnt) then begin
if icnt = 1 then np := np1 else np := GetClosePoint(p2,np1,np2);
Seg1.tp2 := np;
Seg2.tp1 := np;
result := True;
end;
end;
end;
procedure TPolyLine.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
Layer: TLayer;
acolor,bColor : Tcolor;
FirstLine,LastLine:boolean;
Grayedd : boolean;
rpS1,rps2: TDoublepoint;
rpE1,rpE2: TDoublepoint;
pdPoints: TDoublePointArr;
Segment: TPLSegment;
c1,c2,p1,p2,cp: TdoublePoint;
tPoints: TDoublePointArr;
i,cnt1,cnt2,k,cnt3: Integer;
valid: Boolean;
mp:TDoublePoint;
Curved: Boolean;
xp1,xp2: TDoublePoint;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then
begin
aColor := TLayer(LayerHandle).PenColor;
end;
bColor := brc;
if (bColor = -255) and (LayerHandle <> 0) then
begin
bColor := TLayer(LayerHandle).BrushColor;
end;
Grayedd := false;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bColor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
Grayedd := true;
end;
if drawStyle = dsTrace then
DEngine.Canvas.Pen.Mode := pmXor
else
DEngine.Canvas.Pen.Mode := pmCopy;
Curved := False;
for i := 0 to Segments.Count - 1 do
if TPLSegment(Segments[i]).SType <> sLine then
Curved := True;
if assigned(PenPattern) then
Curved := True;
if (not curved) and (Pointcount > 2) then
begin
if (actualpoints[1].x = 0) then
begin
//actualpoints[1] := actualpoints[PointCount];
end;
if (actualpoints[PointCount].x = 0) and (actualpoints[PointCount].y = 0) then
begin
// actualpoints[PointCount] := actualpoints[1];
end;
end;
if Curved then
begin
CollectPolyBezierPoints(pdPoints,rpS1,rps2,rpE1,rpE2,firstLine,LastLine);
valid := Length(pdPoints) > 3;
end
else
begin
CollectPolyLinePoints(pdPoints);
valid := Length(pdPoints) > 1;
end;
if valid then
begin
if Curved then
begin
DEngine.drawbezier(pdpoints,Length(pdPoints),aColor, aawidth,style,bColor,GDIbrs,
closed and (drawStyle = mydsNormal) and (brs <> ord(bsClear)),
InCombined,PenPattern,RegHandle,RowStyle,rowL,rowH,BrushBitmap);
end
else
begin
if closed then
DEngine.drawpolygon(pdPoints,acolor, aawidth,style,brc,GDIbrs,RegHandle,BrushBitmap)
else
Dengine.drawpolyline(pdPoints,acolor, aawidth,style,RowStyle);
end;
//Tolik
if Closed then
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
if modified and closed and (HatchSeg > -1) then
begin
HatchBySegment(HatchSeg,HatchDist);
end
else
if closed and (HatchSeg > -1) and (Length(HatchLines) = 0) then
begin
HatchBySegment(HatchSeg,HatchDist);
end;
if Closed and (HatchSeg > -1) then
begin
//Tolik
if RegHandle = 0 then
begin
if RegObject <> nil then
begin
RegHandle := ExtCreateRegion(nil, RegObject.RegObjDataLength, RegObject.RegObjData^);
end;
end;
if RegHandle <> 0 then
begin
//
Dengine.ClipAnd(RegHandle);
for i := 0 to (Length(HatchLines) div 2)-1 do
begin
xp1 := HatchLines[i*2];
xp2 := HatchLines[i*2+1];
DEngine.drawline(xp1,xp2,brc,1,ord(psSolid),0);
end;
Dengine.ClipBack;
//
end;
//
end;
end;
if (drawStyle = dsTrace) and (PointCount > 2) and (ap1.x = ActualPoints[PointCount].x) and (ap1.y = ActualPoints[PointCount].y) then
begin
DEngine.drawselectionpoint(ap1.x,ap1.y,ap1.z,ptECircle,6,clLime,True);
end;
if (drawStyle = dsTrace) then
DEngine.drawselectionpoint(ap1.x,ap1.y,ap1.z,ptECircle,3,clLime,True);
if tracing and (SelectedPoint > 0) then
begin
p1 := ActualPoints[SelectedPoint];
Segment := TPLSegment(Segments[SelectedPoint-1]);
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
if (Segment.SType = sCurve) then
DEngine.drawline(c1.x,c1.y,p1.x,p1.y,clLime,1,1,0)
else
if (Segment.SType = sArc) then
begin
DEngine.drawline(c1.x,c1.y,p1.x,p1.y,clLime,1,1,0);
c2 := ActualPoints[SelectedPoint+1];
DEngine.drawline(c1.x,c1.y,c2.x,c2.y,clLime,1,1,0);
end;
if SelectedPoint = 1 then
Segment := TPLSegment(Segments[PointCount-1])
else
Segment := TPLSegment(Segments[SelectedPoint-2]);
c2 := Segment.CPoint2;
if Segment.SType = sCurve then
DEngine.drawline(c2.x,c2.y,p1.x,p1.y,clLime,1,1,0);
end;
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
Procedure TPolyline.DrawRows(DEngine: TPCDrawEngine;xColor: TColor;
rpS1,rpS2,rpE1,rpE2:TDoublePoint;firstLine,lastLine:Boolean);
begin
if (not Closed) and (drawStyle = mydsNormal) then
begin
DEngine.Canvas.Brush.Style := bsSolid;
DEngine.Canvas.Brush.Color := xColor;
DEngine.Canvas.Pen.Color := xColor;
DEngine.Canvas.Pen.Style := psSolid;
if FirstLine then
begin
if (RowStyle = 2) or (RowStyle = 3) then
Dengine.drawrow(Round(rps2.x),Round(rps2.y),Round(rps1.x),Round(rps1.y),true);
if (RowStyle = 5) or (RowStyle = 6) then
Dengine.drawrow(Round(rps2.x),Round(rps2.y),Round(rps1.x),Round(rps1.y),false);
end;
If LastLine then
begin
if (RowStyle = 1) or (RowStyle = 3) then
Dengine.drawrow(Round(rpe1.x),Round(rpe1.y),Round(rpe2.x),Round(rpe2.y),true);
if (RowStyle = 4) or (RowStyle = 6) then
Dengine.drawrow(Round(rpe1.x),Round(rpe1.y),Round(rpe2.x),Round(rpe2.y),false);
end;
end;
end;
procedure TPolyline.DrawFigureGuides(DEngine: TPCDrawEngine);
var
acolor : Tcolor;
pdPoints: TDoublePointArr;
r: HRGN;
begin
inherited;
if drawStyle = dsTrace then DEngine.Canvas.Pen.Mode := pmXor
else DEngine.Canvas.Pen.Mode := pmCopy;
if JoinFigure1 <> nil then
DEngine.drawselectionpoint(actualpoints[1].x,actualpoints[1].y,actualpoints[1].z,ptCross,pointdim,clRed);
if JoinFigure2 <> nil then
DEngine.drawselectionpoint(actualpoints[pointcount].x,actualpoints[pointcount].y,actualpoints[pointcount].z,ptCross,pointdim,clRed);
if assigned(PenPattern) and (drawStyle = mydsNormal) and (selected) then
begin
aColor := clRed;
DEngine.Canvas.Pen.Mode := pmCopy;
CollectPolyBezierPoints(pdPoints);
r := 1;
DEngine.drawbezier(pdpoints,Length(pdPoints),aColor,width,style,aColor,brs,false,false,
nil,r,0,rowL,rowH);
end;
end;
procedure TPolyline.drawselectionpoints(DEngine: TPCDrawEngine;isGrayed:Boolean);
var Layer: TLayer;
a : integer;
pt : TModPoint;
aColor : TColor;
fKnot:TPoint;
lColor: integer;
idx: Integer;
x,y,z: Double;
ap: TDoublePoint;
begin
if rMode then begin
inherited;
exit;
end;
// Tolik 24/21/2019 --
//For a := 0 to SelPoints.Count -1 do
for a := SelPoints.Count -1 downto 0 do
//
begin
pt := TModPoint(SelPoints[a]);
if pt = nil then
SelPoints.delete(a)
else
begin
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
aColor := pt.Color;
if isGrayed then
lcolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
lColor := clred;
if pt.pType = ptPolyPoint then
begin
if selectedpoint = pt.SeqNbr then
begin
aColor := clRed;
if SelectedPoint = PointCount then
ap := ActualPoints[1]
else
ap := ActualPoints[selectedpoint+1];
DEngine.DrawLine(pt.CoordX,pt.CoordY,ap.x,ap.y,lcolor,1,ord(psDot),0);
end;
DrawSelPoint(DEngine,isGrayed,pt);
end
else
if pt.PType = ptControlPoint then
begin
idx := pt.SeqNbr div 10;
if idx = SelectedPoint then
begin
DrawSelPoint(DEngine,isGrayed,pt);
ap := ActualPoints[idx];
DEngine.DrawLine(pt.CoordX,pt.CoordY,ap.x,ap.y,lcolor,1,style,0);
end;
end
else
if pt.PType = ptArcControl then
begin
DrawSelPoint(DEngine,isGrayed,pt);
ap := ActualPoints[pt.SeqNbr];
DEngine.DrawLine(pt.CoordX,pt.CoordY,ap.x,ap.y,lcolor,1,style,0);
if pt.SeqNbr = PointCount then
idx := 1
else
idx := pt.SeqNbr+1;
ap := ActualPoints[idx];
DEngine.DrawLine(pt.CoordX,pt.CoordY,ap.x,ap.y,lcolor,1,style,0);
end;
x := pt.CoordX;
y := pt.CoordY;
z := pt.CoordY;
DEngine.ConvertPoint(x,y,z);
pt.PixX := Round(x);
pt.PixY := Round(y);
end;
end;
end;
procedure TPolyLine.getModPoints(ModList: TMyList);
var
Layer: TLayer;
ap : TDoublepoint;
a: integer;
ps1,ps2: TBezierPoint;
cp1,cp2: TDoublePoint;
cpx: integer;
CControl:TPCdrawing;
Segment: TPlSegment;
begin
CControl := TPCDrawing(Owner);
cpx := 0;
For a := 1 to PointCount do
begin
ap := actualpoints[a];
Segment := TPlSegment(Segments[a-1]);
if (Segment.SType = sCurve) and
not ((a = PointCount) and (not closed)) then
begin
cp1 := Segment.Cpoint1;
cp2 := Segment.Cpoint2;
cpx := (a*10)+2;
ModList.Add(CControl.RegisterModPoint(self,ptControlPoint,ptRect,clRed,2,
cp1.x,cp1.y,cpx));
if a = PointCount then cpx := ((1)*10)+1
else cpx := ((a+1)*10)+1;
ModList.Add(CControl.RegisterModPoint(self,ptControlPoint,ptRect,clRed,2,cp2.x,cp2.y,cpx));
end else if (Segment.SType = sArc) then
begin
cp1 := Segment.Cpoint1;
cpx := a;
ModList.Add(CControl.RegisterModPoint(self,ptArcControl,ptRect,clGreen,2,
cp1.x,cp1.y,cpx));
end;
ModList.Add(CControl.RegisterModPoint(self,ptPolyPoint,ptCircle,clBlue,2,ap.x,ap.y,a));
end;
end;
//Tolik 02/08/2021 -- ñòàðàÿ çàêîììåí÷åíà - ñì íèæå
Procedure TPolyLine.getbounds(var figMaxX,figMaxY,figMinX,figMinY:double);
var p1,p2 : TDoublePoint;
a : integer;
c1,c2: TDoublePoint;
bfigMaxX,bfigMaxY,bfigMinX,bfigMinY: double;
lp: integer;
Segment: TPLSegment;
a1,a2,at: double;
radius: double;
//aStateFig: string;
begin
// Tolik 02/05/2019
Try
//
{aStateFig := '';
try
if Self.Parent <> nil then
if Self.Parent.Parent <> nil then
if Self.Parent.Parent.Cname = 'TFigureGrpMod' then
aStateFig := SavedStateFig;
except
end;
if (aStateFig = '') or (aStateFig = 'no state') then
begin
if Closed then lp := PointCount else lp := PointCount - 1;
For a := 1 to lp do
begin
Segment := TPLSegment(Segments[a-1]);
c1.x := 0;
c1.y := 0;
c1.z := 0;
c2.x := 0;
c2.y := 0;
c2.z := 0;
p1 := actualpoints[a];
if a = pointcount then
p2 := actualpoints[1]
else
p2 := actualpoints[a+1];
aStateFig := aStateFig + '#' + FloatToStr(p1.x) + '*' + FloatToStr(p1.y) + '*' + FloatToStr(p1.z) + '*' +
FloatToStr(p2.x) + '*' + FloatToStr(p2.y) + '*' + FloatToStr(p2.z);
if Segment.SType = sLine then
begin
aStateFig := aStateFig + '*sLine';
end else if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
aStateFig := aStateFig + '*sCurve';
end else if Segment.SType = sArc then
begin
c1 := Segment.CPoint1;
if Segment.Inverted then
aStateFig := aStateFig + '*sArcInv'
else
aStateFig := aStateFig + '*sArc';
end;
aStateFig := aStateFig + '*' + FloatToStr(c1.x) + '*' + FloatToStr(c1.y) + '*' + FloatToStr(c1.z) + '*' +
FloatToStr(c2.x) + '*' + FloatToStr(c2.y) + '*' + FloatToStr(c2.z);
end;
end;
}
if (SavedfigMaxX = -$FFFFFF) and (SavedfigMaxY = -$FFFFFF) and (SavedfigMinX = -$FFFFFF) and (SavedfigMinY = -$FFFFFF) then
begin
//SavedStateFig := 'no state';
NeedBounds := True;
end;
//if (aStateFig <> SavedStateFig) or (aStateFig = '') or (aStateFig = 'no state') then
if NeedBounds then
begin
figMaxX := ap1.x;
figMinX := ap2.x;
figMaxY := ap1.y;
figMinY := ap2.y;
if Closed then lp := PointCount else lp := PointCount -1;
For a := 1 to lp do
begin
Segment := TPLSegment(Segments[a-1]);
p1 := actualpoints[a];
if a = pointcount then p2 := actualpoints[1] else
p2 := actualpoints[a+1];
if Segment.SType = sLine then
begin
if p1.x > figMaxX then figMaxX := p1.x;
if p1.x < figMinX then figMinX := p1.x;
if p1.y > figMaxY then figMaxY := p1.y;
if p1.y < figMinY then figMinY := p1.y;
if p2.x > figMaxX then figMaxX := p2.x;
if p2.x < figMinX then figMinX := p2.x;
if p2.y > figMaxY then figMaxY := p2.y;
if p2.y < figMinY then figMinY := p2.y;
end
else
if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
GetBezierBounds(p1,c1,c2,p2,bfigMaxX,bfigMaxY,bfigMinX,bfigMinY);
if bfigMaxX > figMaxX then figMaxX := bfigMaxX;
if bfigMinX < figMinX then figMinX := bfigMinX;
if bfigMaxY > figMaxY then figMaxY := bfigMaxY;
if bfigMinY < figMinY then figMinY := bfigMinY;
end
else
if Segment.SType = sArc then
begin
c1 := Segment.CPoint1;
a1 := GetRadOfLine(c1,p1);
a2 := GetRadOfLine(c1,p2);
if Segment.Inverted then
begin
at := a1;
a1 := a2;
a2 := at;
end;
radius := GetLineLenght(p1,c1);
GetArcBounds(c1,radius,radius,0,a1,a2,0,bfigMaxX,bfigMaxY,bfigMinX,bfigMinY);
if bfigMaxX > figMaxX then figMaxX := bfigMaxX;
if bfigMinX < figMinX then figMinX := bfigMinX;
if bfigMaxY > figMaxY then figMaxY := bfigMaxY;
if bfigMinY < figMinY then figMinY := bfigMinY;
end;
end;
//SavedStateFig := aStateFig; // Tolik 29/07/2021 --
SavedfigMaxX := figMaxX;
SavedfigMinX := figMinX;
SavedfigMaxY := figMaxY;
SavedfigMinY := figMinY;
NeedBounds := False;
end
else
begin
figMaxX := SavedfigMaxX;
figMinX := SavedfigMinX;
figMaxY := SavedfigMaxY;
figMinY := SavedfigMinY;
end;
Except
On E:Exception do
begin
AddExceptionToLog('TPolyLine.GetBouns Error = ' + E.Message);
//ShowMessage('PolyLine Get Bouns Error. Id = ' + Inttostr(Id));
figMaxX := 0;
figMinX := 0;
figMaxY := 0;
figMinY := 0;
end;
End;
//aStateFig := '';//Tolik 29/07/2021 --
end;
(*
Procedure TPolyLine.getbounds(var figMaxX,figMaxY,figMinX,figMinY:double);
var p1,p2 : TDoublePoint;
a : integer;
c1,c2: TDoublePoint;
bfigMaxX,bfigMaxY,bfigMinX,bfigMinY: double;
lp: integer;
Segment: TPLSegment;
a1,a2,at: double;
radius: double;
aStateFig: string;
begin
// Tolik 02/05/2019
Try
//
aStateFig := '';
try
if Self.Parent <> nil then
if Self.Parent.Parent <> nil then
if Self.Parent.Parent.Cname = 'TFigureGrpMod' then
aStateFig := SavedStateFig;
except
end;
if (aStateFig = '') or (aStateFig = 'no state') then
begin
if Closed then lp := PointCount else lp := PointCount - 1;
For a := 1 to lp do
begin
Segment := TPLSegment(Segments[a-1]);
c1.x := 0;
c1.y := 0;
c1.z := 0;
c2.x := 0;
c2.y := 0;
c2.z := 0;
p1 := actualpoints[a];
if a = pointcount then
p2 := actualpoints[1]
else
p2 := actualpoints[a+1];
aStateFig := aStateFig + '#' + FloatToStr(p1.x) + '*' + FloatToStr(p1.y) + '*' + FloatToStr(p1.z) + '*' +
FloatToStr(p2.x) + '*' + FloatToStr(p2.y) + '*' + FloatToStr(p2.z);
if Segment.SType = sLine then
begin
aStateFig := aStateFig + '*sLine';
end else if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
aStateFig := aStateFig + '*sCurve';
end else if Segment.SType = sArc then
begin
c1 := Segment.CPoint1;
if Segment.Inverted then
aStateFig := aStateFig + '*sArcInv'
else
aStateFig := aStateFig + '*sArc';
end;
aStateFig := aStateFig + '*' + FloatToStr(c1.x) + '*' + FloatToStr(c1.y) + '*' + FloatToStr(c1.z) + '*' +
FloatToStr(c2.x) + '*' + FloatToStr(c2.y) + '*' + FloatToStr(c2.z);
end;
end;
if (SavedfigMaxX = -$FFFFFF) and (SavedfigMaxY = -$FFFFFF) and (SavedfigMinX = -$FFFFFF) and (SavedfigMinY = -$FFFFFF) then
begin
SavedStateFig := 'no state';
end;
if (aStateFig <> SavedStateFig) or (aStateFig = '') or (aStateFig = 'no state') then
begin
figMaxX := ap1.x;
figMinX := ap2.x;
figMaxY := ap1.y;
figMinY := ap2.y;
if Closed then lp := PointCount else lp := PointCount -1;
For a := 1 to lp do
begin
Segment := TPLSegment(Segments[a-1]);
p1 := actualpoints[a];
if a = pointcount then p2 := actualpoints[1] else
p2 := actualpoints[a+1];
if Segment.SType = sLine then
begin
if p1.x > figMaxX then figMaxX := p1.x;
if p1.x < figMinX then figMinX := p1.x;
if p1.y > figMaxY then figMaxY := p1.y;
if p1.y < figMinY then figMinY := p1.y;
if p2.x > figMaxX then figMaxX := p2.x;
if p2.x < figMinX then figMinX := p2.x;
if p2.y > figMaxY then figMaxY := p2.y;
if p2.y < figMinY then figMinY := p2.y;
end else if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
GetBezierBounds(p1,c1,c2,p2,bfigMaxX,bfigMaxY,bfigMinX,bfigMinY);
if bfigMaxX > figMaxX then figMaxX := bfigMaxX;
if bfigMinX < figMinX then figMinX := bfigMinX;
if bfigMaxY > figMaxY then figMaxY := bfigMaxY;
if bfigMinY < figMinY then figMinY := bfigMinY;
end else if Segment.SType = sArc then
begin
c1 := Segment.CPoint1;
a1 := GetRadOfLine(c1,p1);
a2 := GetRadOfLine(c1,p2);
if Segment.Inverted then
begin
at := a1;
a1 := a2;
a2 := at;
end;
radius := GetLineLenght(p1,c1);
GetArcBounds(c1,radius,radius,0,a1,a2,0,bfigMaxX,bfigMaxY,bfigMinX,bfigMinY);
if bfigMaxX > figMaxX then figMaxX := bfigMaxX;
if bfigMinX < figMinX then figMinX := bfigMinX;
if bfigMaxY > figMaxY then figMaxY := bfigMaxY;
if bfigMinY < figMinY then figMinY := bfigMinY;
end;
end;
//SavedStateFig := aStateFig; // Tolik 29/07/2021 --
SavedfigMaxX := figMaxX;
SavedfigMinX := figMinX;
SavedfigMaxY := figMaxY;
SavedfigMinY := figMinY;
end
else
begin
figMaxX := SavedfigMaxX;
figMinX := SavedfigMinX;
figMaxY := SavedfigMaxY;
figMinY := SavedfigMinY;
end;
Except
On E:Exception do
begin
//ShowMessage('PolyLine Get Bouns Error. Id = ' + Inttostr(Id));
figMaxX := 0;
figMinX := 0;
figMaxY := 0;
figMinY := 0;
end;
End;
aStateFig := '';//Tolik 29/07/2021 --
end;
*)
function TPolyLine.isPointIn(x,y:double): boolean;
var
a : integer;
lp: Integer;
begin
result := false;
if ((TBrushStyle(brs) <> bsClear) or (brushbitmap <> nil) or (HatchSeg > -1) ) and (closed) then
begin
{if IsPointInRegion(x,y) then
result := true;}
//Tolik
if IsPointInRegionByRegObj(x,y) then
result := True;
//
end;
if result = true then
exit;
if closed then
lp := PointCount
else
lp := pointcount-1;
For a := 1 to lp do
begin
if IsPointInSegment(a, x, y) then
begin
result := true;
SelectedPoint := a;
exit;
end;
end;
end;
function TPolyLine.isPointInSegment(SegNbr: Integer; x, y: Double): boolean;
var
p1,p2 : TDoublePoint;
c1,c2 : TDoublePoint;
Segment: TPLSegment;
a1,a2,at,z: Double;
Radius: Double;
DEngine : TPCDrawEngine;
begin
result := false;
Segment := TPLSegment(Segments[SegNbr-1]);
p1 := actualpoints[SegNbr];
if SegNbr = PointCount then
p2 := actualpoints[1]
else
p2 := actualpoints[SegNbr+1];
if Segment.SType = sLine then
begin
if assigned(owner) then
begin
DEngine := TPCDrawing(owner).DEngine;
z := 0;
Dengine.ConvertPoint(p1.x,p1.y,z);
Dengine.ConvertPoint(p2.x,p2.y,z);
Dengine.ConvertPoint(x,y,z);
end;
if ispointinLine(p1,p2,DoublePoint(x,y),width) then
begin
result := true;
end;
end
else
if Segment.SType = sCurve then
begin
c1 := Segment.CPoint1;
c2 := Segment.CPoint2;
if ispointinBezier(p1,c1,c2,p2,DoublePoint(x,y)) then
begin
result := true;
end;
end
else
if Segment.SType = sArc then
begin
c1 := Segment.CPoint1;
a1 := GetRadOfLine(c1,p1);
a2 := GetRadOfLine(c1,p2);
if Segment.Inverted then
begin
at := a1;
a1 := a2;
a2 := at;
end;
radius := GetLineLenght(p1,c1);
if IspointInArc(DoublePoint(x,y),c1,Radius,0,a1,a2) then
result := true;
end;
end;
function TPolyline.Knife(p1, p2: TdoublePoint; Figures: TList): Boolean;
begin
KnifePoint1 := p1;
KnifePoint2 := p2;
Knifing := True;
result := inherited Knife(p1,p2,Figures);
Knifing := False;
NeedBounds := True; //Tolik 02/08/2021 --
end;
function TPolyline.BreakByPoint(p: TdoublePoint;var Figures: TList): boolean;
var lCnt,pCnt: Integer;
xp1,xp2,xp3,xp4: TdoublePoint;
pArr: TDoublePointArr;
i,k,idx,oIndex: Integer;
Fig: TPolyline;
res: boolean;
segment,seg1,seg2,xSeg,ySeg: TPLSegment;
begin
if closed then lCnt := PointCount
else
lCnt := PointCount-1;
result := false;
pCnt := 0;
for i := 1 to lcnt do
begin
xp1 := ActualPoints[i];
xp2 := ActualPoints[i+1];
segment := TPLSegment(Segments[i-1]);
if segment.BreakByPoint(xp1,xp2,p,seg1,seg2,knifing,knifepoint1,knifepoint2) then
begin
result := true;
if closed then
begin
pCnt := PointCount +2;
SetLength(pArr,pCnt);
pArr[0] := p;
idx := 0;
for k := i+1 to PointCount do
begin
idx := idx+1;
pArr[idx] := ActualPoints[k];
end;
for k := 1 to i do
begin
idx := idx+1;
pArr[idx] := ActualPoints[k];
end;
pArr[pCnt-1] := p;
fig := TPolyline.create(pArr,width,style,color,brs,brc,ord(rowstyle),false,LayerHandle,mydsNormal,owner);
Figures.Add(fig);
xSeg := TPlSegment(fig.Segments[0]);
xSeg.CopyFrom(seg2);
for k := 2 to fig.PointCount-2 do
begin
xSeg := TPlSegment(fig.Segments[k-1]);
oIndex := i+k-1;
if oIndex > PointCount then oIndex := oIndex-PointCount;
ySeg := Segments[oIndex-1];
xSeg.CopyFrom(ySeg);
end;
xSeg := TPlSegment(fig.Segments[fig.PointCount-2]);
xSeg.CopyFrom(seg1);
end
else
begin
pCnt := PointCount - i +1;
SetLength(pArr,pCnt);
pArr[0] := p;
for k := i+1 to PointCount do pArr[k-i] := ActualPoints[k];
fig := TPolyline.create(pArr,width,style,color,brs,brc,ord(rowstyle),false,LayerHandle,mydsNormal,owner);
Figures.Add(fig);
xSeg := TPlSegment(fig.Segments[0]);
xSeg.CopyFrom(seg2);
for k := 2 to fig.PointCount-1 do begin
xSeg := TPlSegment(fig.Segments[k-1]);
oIndex := i+k-1;
if oIndex > PointCount then oIndex := oIndex-PointCount;
ySeg := Segments[oIndex-1];
xSeg.CopyFrom(ySeg);
end;
pCnt := i+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := p;
for k := 1 to i do pArr[k-1] := ActualPoints[k];
fig := TPolyline.create(pArr,width,style,color,brs,brc,ord(rowstyle),false,LayerHandle,mydsNormal,owner);
Figures.Add(fig);
for k := 1 to fig.PointCount-2 do begin
xSeg := TPlSegment(fig.Segments[k-1]);
oIndex := k;
ySeg := Segments[oIndex-1];
xSeg.CopyFrom(ySeg);
end;
xSeg := TPlSegment(fig.Segments[fig.PointCount-2]);
xSeg.CopyFrom(seg1);
end;
end;
end;
//Tolik 24/05/2019 --
SetLength(pArr, 0);
//
end;
function TPolyline.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var lCnt,pCnt,i,k,iCnt: Integer;
xp1,xp2,xp3,xp4,p,cp,np1,np2: TdoublePoint;
ires: Boolean;
pbArr: TDoublePointArr;
a,rad: Double;
seg: TPLsegment;
function isAngleIn(ang:Double):Boolean;
begin
result := true;
end;
begin
if closed then lCnt := PointCount else lCnt := PointCount-1;
pCnt := 0;
for i := 1 to lcnt do
begin
xp1 := ActualPoints[i];
xp2 := ActualPoints[i+1];
ires := false;
seg := TPLSegment(Segments[i-1]);
if seg.SType = sLine then begin
ires := GetIntersectionPoint(p1,p2,xp1,xp2,p,false);
if ires then
begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := p;
end;
end
else
if seg.SType = sCurve then
begin
xp4 := xp2;
xp2 := TPLSegment(Segments[i-1]).CPoint1;
xp3 := TPLSegment(Segments[i-1]).CPoint2;
SetLength(pbArr,0);
ires := GetLineBezierIntersection(p1,p2,xp1,xp2,xp3,xp4,pbArr,iCnt,false);
if ires then
begin
pCnt := pCnt+iCnt;
SetLength(pArr,pCnt);
for k := 1 to iCnt do pArr[pCnt-k] := pbArr[iCnt-k];
end;
end
else
begin
cp := seg.CPoint1;
rad := GetLineLenght(xp1,cp);
if GetLineCircleIntersection(p1,p2,cp,rad,np1,np2,icnt,false) then
begin
if iCnt > 0 then
begin
a := GetradOfLine(cp,np1);
if isPointInSegment(i,np1.x,np1.y) then
begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := np1;
end;
end;
if iCnt > 1 then
begin
if isPointInSegment(i,np2.x,np2.y) then
begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := np2;
end;
end;
end;
end;
end;
result := (pCnt > 0);
// Tolik 24/05/2019- -
SetLength(pbArr, 0);
//
end;
function TPolyLine.duplicate:TFigure;
var res : TPolyLine;
newpoints : TDoublePointArr;
a: integer;
ps: TBezierPoint;
begin
SetLength(newPoints,2);
newPoints[0] := ap1;
newPoints[1] := ap2;
res := TPolyLine.create( newPoints,
width,
style,
color,
brs,
brc,
RowStyle,
Closed,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.PointCount := PointCount;
for a := 1 to PointCount do
begin
res.originalpoints[a] := originalpoints[a];
res.actualpoints[a] := actualpoints[a] ;
end;
res.ClearSegments;
for a := 0 to Segments.Count-1 do
res.Segments.Add(TplSegment(segments[a]).Duplicate);
res.rotPoint.x := rotpoint.x ;
res.rotPoint.y := rotpoint.y ;
res.AngleToPoint := AngleToPoint;
if assigned(PenPattern) then
res.PenPattern := PenPattern.Duplicate
else
res.PenPattern := nil;
result := res;
// Tolik 24/05/2019- -
SetLength(NewPoints, 0);
//
end;
destructor TPolyline.Destroy;
begin
SavedStateFig := '';//Tolik 29/07/2021 --
ClearSegments;
Segments.free; // Tolik 16/01/2020
//Tolik
if PenPattern <> nil then
FreeAndNil(PenPattern);
//
// Tolik 24/05/2019 --
SetLength(HatchLines, 0);
//
inherited;
end;
procedure TPolyline.GetVectorObjects(Objects: Tlist; BaseP: TDoublePoint);
var obj: TvectorObject;
p: array of TDoublePoint;
p1: TDoublePoint;
i: Integer;
seg: TPlSegment;
begin
SetLength(p,PointCount);
for i := 1 to pointcount do
begin
p1 := ActualPoints[i];
p1 := DoublePoint(p1.x-baseP.x,p1.y-baseP.y);
p[i-1] := p1;
end;
if closed then
obj := TVectorObject.CreatePolygonObject(PointCount,p)
else
obj := TVectorObject.CreatePolylineObject(PointCount,p);
Objects.Add(obj);
// Tolik 24/05/2019 --
SetLength(p, 0);
//
end;
(* ========================================================================== *)
// TELLIPSE IMPLEMENTATION //
(* ========================================================================== *)
constructor TEllipse.create(cX,cY,len1,len2,aAngle:Double;
w,s,c,abrs,abrc:integer;LHandle:LongInt;
aDrawStyle: TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle, aDrawStyle,aOwner);
initialize;
alen := len1;
blen := len2;
actualpoints[1] := DoublePoint(cx,cy);
originalpoints[1] := DoublePoint(cx,cy);
originalpoints[2] := RotatePoint(ap1,DoublePoint(ap1.x + aLen,ap1.y),aAngle);
actualpoints[2] := originalpoints[2];
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
angle := aAngle;
//RefreshBounds;
end;
(*
Constructor TEllipse.create3P(cX,cY,x1,y1,x2,y2:Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt;aDrawStyle : TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
originalpoints[1] := DoublePoint(cx,cy);
originalpoints[2] := DoublePoint(x1,y1);
originalpoints[3] := DoublePoint(x2,y2);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
//RefreshBounds;
end;
*)
class Function TEllipse.CreateShadow(x,y:Double): TFigure;
begin
result := TEllipse.create(x,y,0,0,0,1,1,clLime,0,0,0,dsTrace,nil);
end;
Function Tellipse.CreateModification: TFigure;
begin
result := TEllipse.create(ap1.x,ap1.y,ALen,Blen,angle,1,1,clLime,0,0,0,dsTrace,nil);
if assigned(result) then result.RotPoint := RotPoint;
end;
procedure TEllipse.Initialize;
begin
inherited;
pointcount := 2;
end;
function TEllipse.EndModification(CadControl: Pointer;mp: TModPoint; TraceFigure: TFigure; x,
y: Double;Shift: TShiftState): boolean;
var xAngle: Double;
p1: TDoublePOint;
begin
if mp.SeqNbr = 2 then
ALen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y) )
else if mp.SeqNbr = 3 then
BLen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y) )
else if (mp.SeqNbr = 4) then
begin
p1 := DoublePoint(x,y);
xAngle := GetRadOfLine(ap1,p1);
p1 := DoublePoint(ap1.x-ALen,ap1.y);
ActualPoints[2] := RotatePoint(ap1,p1,xAngle);
end;
ResetRegion;
Modified := True;
end;
function TEllipse.ShadowClick(ClickIndex:Integer;x,y:Double): Boolean;
var cp,p1: TDoublePoint;
begin
result := false;
if clickIndex = 2 then begin
ALen := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
BLen := ALen;
end else if clickIndex = 3 then begin
BLen := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
result := True;
end;
end;
class function TEllipse.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TEllipse.create(shadow.ap1.x,shadow.ap1.y,
TEllipse(shadow).aLen,
TEllipse(shadow).bLen,0,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
end;
function TEllipse.ShadowTrace(ClickIndex:Integer;x, y: Double): Boolean;
var rad:Double;
begin
If ClickIndex = 1 then
begin
rad := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
ALen := rad;
BLen := rad;
end else If ClickIndex = 2 then
begin
rad := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
BLen := Rad;
end;
end;
function TEllipse.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x, y: Double;Shift: TShiftState): boolean;
var xAngle: Double;
p1: TDoublePOint;
begin
if (mp.SeqNbr = 2) then
begin
TEllipse(TraceFigure).Alen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y));
end else if (mp.SeqNbr = 3) then
begin
TEllipse(TraceFigure).BLen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y));
end else if (mp.SeqNbr = 4) then
begin
p1 := DoublePoint(x,y);
xAngle := GetRadOfLine(ap1,p1);
p1 := DoublePoint(ap1.x-ALen,ap1.y);
TEllipse(TraceFigure).ActualPoints[2] := RotatePoint(ap1,p1,xAngle);
end;
end;
procedure TEllipse.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xDbl: Double;
begin
inherited;
// Tolik 22/11/2019 --
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(90,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xDbl := alen;
WriteField(220,Stream,xDbl,8);
xDbl := bLen;
WriteField(221,Stream,xDbl,8);
end;
Procedure TEllipse.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var ByteVal: Byte;
begin
Case xcode of
20: brc := pInt(data)^;
21: aLen := pInt(data)^/10;
22: bLen := pInt(data)^/10;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
220: aLen := pDouble(data)^;
221: bLen := pDouble(data)^;
end;
end;
procedure TEllipse.SetSpecialPropertiesFromStream(Stream: TStream);
var p1: TDOublePoint;
begin
inherited;
if PointCount = 3 then begin // old format
PointCount := 2;
RedimenPoints;
p1 := DoublePoint(ap1.x-ALen,ap1.y);
ActualPoints[2] := RotatePoint(ap1,p1,Angle);
end;
end;
function TEllipse.DuplicateAsBezier: TFigure;
var Points: T2DPointArray;
cnt,i: Integer;
p: TDoublePoint;
pp: TDoublePointArr;
res: TPolyline;
begin
if (ap2.y = ap1.y) then
if (ap2.x > ap1.x) then angle := 0 else angle := pi
else
if (ap2.x = ap1.x) then
if (ap2.y > ap1.y) then angle := -1*(pi/2) else angle := pi/2
else
begin
Angle := GetRadOfLine(ap1,ap2);
end;
BezierElpArcPoints(Points,ap1.x,ap1.y,ALen,Blen,angle,0,2*pi);
cnt := Length(Points);
SetLength(pp,cnt);
for i := 0 to cnt-1 do
begin
p := DoublePoint(Points[i].x,Points[i].y);
pp[i] := p;
end;
SetLength(Points,0);
result := TPolyline.createFromBezierPoints(pp,Width,Style,color,Brs,Brc,0,
True,Layerhandle,mydsNormal,owner);
// Tolik 24/05/2019 --
SetLength(pp,0);
//
end;
function TEllipse.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var np1,np2: TDoublePoint;
icnt: Integer;
begin
result := false;
if GetLineEllipseIntersection(p1,p2,ap1,aLen,bLen,Angle,np1,np2,icnt,false) then begin
SetLength(pArr,iCnt);
if icnt > 0 then pArr[0] := np1;
if icnt > 1 then pArr[1] := np2;
result:= true;
end;
end;
function TEllipse.BreakByPoint(p: TdoublePoint;
var Figures: TList): boolean;
var a1:Double;
fig: TFigure;
pt: TDoublePoint;
begin
result := false;
pt := DoublePoint(p.x,p.y);
pt := RotatePoint(ap1,pt,-1*angle);
a1 := GetRadOfLine(ap1,pt);
if isPointInEllipse(p.x,p.y,ap1.x,ap1.y,Alen,Blen,Angle) then begin
result := true;
fig := TElpArc.create(ap1.x,ap1.y,aLen,Blen,a1,a1,Angle,width,style,color,
brs,brc,0,LayerHandle,mydsNormal,owner);
Figures.Add(fig);
end;
end;
procedure TEllipse.draw(DEngine:TPCDrawEngine;isGrayed:Boolean);
var
acolor,bcolor : Tcolor;
nbrPoints : integer;
a: Integer;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
acolor := color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
bColor := brc;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if dRawStyle = dsTrace then
DEngine.canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
if (ap2.y = ap1.y) then
if (ap2.x > ap1.x) then angle := 0 else angle := pi
else
if (ap2.x = ap1.x) then
if (ap2.y > ap1.y) then angle := -1*(pi/2) else angle := pi/2
else
begin
Angle := GetRadOfLine(ap1,ap2);
end;
if NeedRegion then
DEngine.drawbezierEllipse(ap1.x,ap1.y,alen,blen,angle,acolor, aawidth,style,
bcolor,GDIbrs,regHandle,InCombined);
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
DEngine.drawbezierEllipse(ap1.x,ap1.y,alen,blen,angle,acolor, aawidth,style,
bcolor,GDIbrs,regHandle,InCombined);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
deleteObject(RegHandle);
RegHandle := 0;
end;
end;
Procedure TEllipse.Scale(percentx,percenty: double; rPoint: TDoublepoint);
var p1,p2:TDoublePoint;
cp: TDoublePOint;
Begin
cp := ap1;
Inherited;
p1 := DoublePoint(cp.x+Alen,cp.y);
p2 := DoublePoint(cp.x,cp.y+Blen);
p1 := RotatePoint(cp,p1,Angle);
p2 := RotatePoint(cp,p2,Angle);
p1 := ScalePoint(rPoint,p1,percentx,percenty);
p2 := ScalePoint(rPoint,p2,percentx,percenty);
ALen := GetLineLenght(ap1,p1);
Blen := GetLineLenght(ap1,p2);
End;
procedure TEllipse.Mirror(Point1, Point2: TDoublepoint);
begin
inherited;
//RefreshBounds;
end;
procedure TEllipse.Move(deltax, deltay: Double);
begin
inherited;
//RefreshBounds;
end;
procedure TEllipse.Rotate(aAngle: double; cPoint: TDoublepoint);
begin
inherited;
//RefreshBounds;
end;
procedure TEllipse.getModPoints(ModList: TMyList);
var
p4,p5,p6: TDoublePoint;
CControl: TPCDrawing;
begin
CControl := TPCDrawing(Owner);
p4 := DoublePoint(ap1.x+Alen,ap1.y);
p5 := DoublePoint(ap1.x,ap1.y+Blen);
p6 := DoublePoint(ap1.x-Alen,ap1.y);
p4 := RotatePoint(ap1,p4,Angle);
p5 := RotatePoint(ap1,p5,Angle);
p6 := RotatePoint(ap1,p6,Angle);
if (Alen = 0) and (Blen = 0) then begin
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,p4.x,p4.y,4));
end else begin
ModList.Add(CControl.RegisterModPoint(self,ptUndefined,ptCross,clBlue,pointdim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clRed,2,p4.x,p4.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clRed,2,p5.x,p5.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clGreen,4,p6.x,p6.y,4));
end;
end;
procedure TEllipse.VerifyZeroPoints(orgV, orgH: Byte);
begin
inherited;
//RefreshBounds;
end;
(*
procedure TEllipse.RefreshBounds;
var DeltaX,Deltay: Double;
begin
if (ap2.y = ap1.y) then
if (ap2.x > ap1.x) then angle := 0 else angle := pi
else
if (ap2.x = ap1.x) then
if (ap2.y > ap1.y) then angle := -1*(pi/2) else angle := pi/2
else
begin
DeltaX := (ap2.x - ap1.x);
DeltaY := (ap2.y - ap1.y);
Angle := GetRadOfLine(ap1,ap2);
end;
ALen := sqrt(sqr(ap2.x-ap1.x)+sqr(ap2.y-ap1.y));
BLen := sqrt(sqr(ap3.x-ap1.x)+sqr(ap3.y-ap1.y));
GetEllipseBounds(ap1.x,ap1.y,alen,blen,-1*angle,elpRes,ElpBounds);
end;
*)
procedure TEllipse.getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);
begin
GetArcBounds(ap1,Alen,Blen,0,0,2*pi,Angle,figMaxX,figMaxY,figMinX,figMinY);
end;
function TEllipse.isPointIn(x,y:Double):boolean;
var cx,cy,nx,ny: Double;
ctrl: real;
p2,pt,pc : TDoublePoint;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
result := isPointInellipse(x,y,ap1.x,ap1.y,Alen,Blen,Angle);
if (not result) and (TBrushStyle(brs) <> bsClear) then
if IsPointInRegion(x,y) then result := true;
//Tolik
if (not result) and (TBrushStyle(brs) <> bsClear) then
// if IsPointInRegion(x,y) then result := true;
if IsPointInRegionByRegObj(x,y) then result := true;
//
end;
function TEllipse.duplicate:TFigure;
var res : TEllipse;
begin
res := TEllipse.create( originalpoints[1].x,
originalpoints[1].y,
alen,
blen,
angle,
width,
style,
color,
brs,
brc,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
result := res;
end;
procedure TEllipse.GetVectorObjects(Objects: Tlist; BaseP: TDoublePoint);
var obj: TvectorObject;
p1: TDoublePoint;
begin
p1 := DoublePoint(ap1.x-baseP.x,ap1.y-baseP.y);
obj := TVectorObject.CreateEllipseObject(p1,aLen,bLen);
Objects.Add(obj);
end;
(* ========================================================================== *)
// TCIRCLE IMPLEMENTATION //
(* ========================================================================== *)
constructor TCircle.create(cX,cY,rad: Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(cx,cy);
actualpoints[1] := DoublePoint(cx,cy);
radius := rad;
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
Hatched := False;
end;
class function TCircle.ShadowType:TShadowType;
begin
result := stCircle;
end;
procedure TCircle.Initialize;
begin
inherited;
pointcount := 1;
end;
procedure TCircle.scale(percentx, percenty: double; rPoint: Tdoublepoint);
var cad: TPCDrawing;
Index: Integer;
elp: TEllipse;
begin
if percentx <> percenty then
begin
if assigned(owner) then
begin
Cad := TPCdrawing(owner);
Index := Cad.Figures.IndexOf(Self);
if Index <> -1 then begin
elp := TEllipse.create(ap1.x,ap1.y,radius,radius,0,Width,Style,
Color,brs,brc,LayerHandle,mydsNormal,Owner);
elp.Scale(percentx,percenty,rPoint);
Cad.Figures[Index] := elp;
Destroy;
end;
end;
end else
inherited;
end;
function TCircle.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean;
begin
Radius := TCircle(TraceFigure).Radius;
ResetRegion;
Modified := True;
end;
function TCircle.ShadowClick(ClickIndex:Integer;x, y: Double): Boolean;
begin
result := false;
if clickindex = 2 then result := true;
end;
class function TCircle.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TCircle.create(shadow.ap1.x,shadow.ap1.y,
shadow.radius,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
end;
function TCircle.ShadowTrace(ClickIndex:Integer;x,y: Double): Boolean;
begin
radius := sqrt( sqr(x - ap1.x)+
sqr(y - ap1.y));
end;
function TCircle.TraceModification(CadControl: Pointer;mp: TModPoint; TraceFigure:TFigure;
x, y: Double;Shift: TShiftState): boolean;
begin
TraceFigure.Radius := sqrt( sqr(x - TraceFigure.ap1.x)+
sqr(y - TraceFigure.ap1.y) );
end;
procedure TCircle.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xDbl: Double;
begin
inherited;
// Tolik 22/11/2019 --
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(90,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xDbl := Radius;
WriteField(220,Stream,xDbl,8);
end;
Procedure TCircle.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
begin
Case xcode of
20: brc := pInt(data)^;
21: Radius := pInt(data)^/10;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
220: Radius := pDouble(data)^;
end;
end;
procedure TCircle.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
acolor,bcolor : Tcolor;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
acolor := color;
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
if NeedRegion then
DEngine.drawcircle(ap1.x,ap1.y,radius,acolor, aawidth,style,bcolor,GDIbrs,RegHandle,InCombined,Hatched);
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
DEngine.drawcircle(ap1.x,ap1.y,radius,acolor, aawidth,style,bcolor,GDIbrs,RegHandle,InCombined,Hatched);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TCircle.DrawFigureGuides(DEngine: TPCDrawEngine);
begin
inherited;
// if DrawStyle = dsTrace then DEngine.canvas.pen.mode := pmXor else
// DEngine.canvas.pen.mode := pmCopy;
// Dengine.drawselectionpoint(ap1.x,ap1.y,ap1.z,ptCross,pointdim,clRed);
end;
procedure TCircle.getModPoints(ModList: TMyList);
var CControl : TPCDrawing;
begin
CControl := TPCDrawing(Owner);
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x,ap1.y + radius,0));
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x,ap1.y - radius,0));
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x+radius,ap1.y,0));
ModList.Add(CControl.RegisterModPoint(self,ptCirclePoint,ptRect,clBlue,pointdim,ap1.x-radius,ap1.y,0));
end;
procedure TCircle.getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);
begin
figMaxX := ap1.x+radius;
figMinX := ap1.x-radius;
figMaxY := ap1.y+radius;
figMinY := ap1.y-radius;
end;
function TCircle.isPointIn(x,y:Double):boolean;
var a,b,cx,cy,nx,ny: real;
ctrl: real;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
result := isPointInCircle(x,y,ap1.x,ap1.y,radius);
if TBrushStyle(brs) <> bsClear then
begin
if isPointInRegion(x,y) then result := true;
//Tolik
if IsPointInRegionByRegObj(x,y) then result := true;
//
end;
end;
function TCircle.DuplicateAsBezier: TFigure;
var Points: T2DPointArray;
cnt,i: Integer;
p: TDoublePoint;
pp: TDoublePointArr;
res: TPolyline;
begin
BezierElpArcPoints(Points,ap1.x,ap1.y,Radius,Radius,0,0,2*pi);
cnt := Length(Points);
SetLength(pp,cnt);
for i := 0 to cnt-1 do
begin
p := DoublePoint(Points[i].x,Points[i].y);
pp[i] := p;
end;
SetLength(Points,0);
result := TPolyline.createFromBezierPoints(pp,Width,Style,color,Brs,Brc,0,
True,Layerhandle,mydsNormal,owner);
end;
function TCircle.duplicate:TFigure;
var res : TCircle;
begin
res := Tcircle.create( originalpoints[1].x,
originalpoints[1].y,
radius,
width,
style,
color,
brs,
brc,
LayerHandle,
drawstyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
result := res;
end;
function TCircle.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var np1,np2: TDoublePoint;
icnt: Integer;
begin
result := false;
if GetLineCircleIntersection(p1,p2,ap1,radius,np1,np2,icnt,false) then begin
SetLength(pArr,iCnt);
if icnt > 0 then pArr[0] := np1;
if icnt > 1 then pArr[1] := np2;
result:= true;
end;
end;
function TCircle.BreakByPoint(p: TdoublePoint;var Figures: TList): boolean;
var a1:Double;
fig: TFigure;
begin
result := false;
if isPointInCircle(p.x,p.y,ap1.x,ap1.y,Radius) then begin
result := true;
a1 := GetradOfLine(ap1,p);
fig := TArc.create(ap1.x,ap1.y,radius,a1,a1,width,style,color,
brs,brc,0,LayerHandle,mydsNormal,owner);
Figures.Add(fig);
end;
end;
procedure TCircle.GetVectorObjects(Objects: Tlist; BaseP: TDoublePoint);
var obj: TvectorObject;
p1: TDoublePoint;
begin
p1 := DoublePoint(ap1.x-baseP.x,ap1.y-baseP.y);
obj := TVectorObject.CreateCircleObject(p1,Radius);
Objects.Add(obj);
end;
// ----- Tolik --- TOVERLAPPEDCIRCLE IMPLEMENTATION ------------------
constructor TOverLappedCircle.create(cX,cY,cX1,cY1,rad, CutRad: Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(cx,cy);
actualpoints[1] := DoublePoint(cx,cy);
originalpoints[2] := DoublePoint(cx1,cy1);
actualpoints[2] := DoublePoint(cx1,cy1);
radius := rad;
CutRadius := CutRad;
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
Hatched := False;
end;
procedure TOverLappedCircle.Initialize;
begin
inherited;
pointcount := 2;
end;
procedure TOverLappedCircle.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
acolor,bcolor : Tcolor;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
acolor := color;
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
if NeedRegion then
DEngine.DrawOverLappedCircle(ap1.x, ap1.y, ap2.x, ap2.y, radius, CutRadius, acolor, aawidth,style,bcolor,GDIbrs,RegHandle,InCombined,Hatched);
DEngine.DrawOverLappedCircle(ap1.x, ap1.y, ap2.x, ap2.y, radius, CutRadius, acolor, aawidth, style, bcolor, GDIbrs, RegHandle, InCombined, Hatched);
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
// ---------------- TOverlappedEllipse Implementation -- (Tolik)
constructor TOverlappedEllipse.create(cX, cY, cX1, cY1, Rad1, Rad2, CutRad1, CutRad2: Double;w,s,c,abrs,abrc:integer;
LHandle: LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(cx,cy);
actualpoints[1] := DoublePoint(cx,cy);
originalpoints[2] := DoublePoint(cx1,cy1);
actualpoints[2] := DoublePoint(cx1,cy1);
radius := rad1;
Radius1 := Rad2;
CutRadius1 := CutRad1;
CutRadius2 := CutRad2;
width := 1;
color := c;
style := s;
brs := 0;
brc := abrc;
Hatched := False;
Owner := GCadForm.PCad;
end;
procedure TOverlappedEllipse.Initialize;
begin
inherited;
pointcount := 2;
end;
procedure TOverlappedEllipse.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
acolor,bcolor : Tcolor;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
acolor := color;
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
if NeedRegion then
DEngine.DrawOverLappedEllipse(ap1.x, ap1.y, ap2.x, ap2.y, radius, radius1, CutRadius1, CutRadius2, acolor, aawidth,style,bcolor,GDIbrs,RegHandle);
DEngine.DrawOverLappedEllipse(ap1.x, ap1.y, ap2.x, ap2.y, radius, radius1, CutRadius1, CutRadius2, acolor, aawidth, style, bcolor, GDIbrs, RegHandle);
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TOverLappedEllipse.getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);
begin
figMaxX := ap1.x + Radius;
figMaxY := ap1.y + Radius;
figMinX := ap1.x - Radius;
figMinY := ap1.y - Radius;
end;
Function TOverLappedEllipse.GetClassName:String;
begin
Result := 'OverLappedEllipse';
end;
Procedure TOverLappedEllipse.WriteToStream(Stream:TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited WriteToStream(Stream);
// Tolik 22/11/2019 --
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(90,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
//xDbl := Radius; WriteField(222,Stream,xDbl,8);
xDbl := Radius1;
WriteField(252,Stream,xDbl,8);
{xStr := DLabel;WriteStrField(180,Stream,xStr);
xStr := Prefix;WriteStrField(181,Stream,xStr);
xStr := Suffix;WriteStrField(182,Stream,xStr);
xStr := TextFont;WriteStrField(183,Stream,xStr);
xDbl := TextHeight; WriteField(230,Stream,xDbl,8);
xDbl := GuideLen; WriteField(231,Stream,xDbl,8); }
xDbl := CutRadius1;
WriteField(232,Stream,xDbl,8); // cutRadius
xDbl := CutRadius2;
WriteField(251,Stream,xDbl,8);
{ if TextBold then xByte := 1 else xByte := 0;
WriteField(100,Stream,xByte,1);
if TextItalic then xByte := 1 else xByte := 0;
WriteField(101,Stream,xByte,1);
if AutoText then xByte := 1 else xByte := 0;
WriteField(102,Stream,xByte,1);
if DrawGuides then xByte := 1 else xByte := 0;
WriteField(103,Stream,xByte,1);
xByte := ord(LStyle);WriteField(104,Stream,xByte,1);}
end;
Procedure TOverLappedEllipse.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
begin
inherited;
Case xcode of
20: brc := pInt(data)^;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
222: Radius := pDouble(data)^;
232: CutRadius1 := pDouble(data)^; // cut Radius (from center Point)
251: CutRadius2 := pDouble(data)^;
252: Radius1 := pDouble(data)^;
253: isAutocreatedFigure := pByte(data)^;
254: Transparency := PInteger(data)^;
end;
end;
//
(* ========================================================================== *)
// TARC IMPLEMENTATION //
(* ========================================================================== *)
constructor TArc.create(cx, cy, rad,a1, a2: Double; w, s, c,
abrs, abrc, aArcStyle, LHandle: Integer; aDrawStyle: TDrawStyle;
aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(cx,cy);
actualpoints[1] := DoublePoint(cx,cy);
originalpoints[2] := DoublePoint(cx,cy);
actualpoints[2] := DoublePoint(cx,cy);
originalpoints[3] := DoublePoint(cx,cy);
actualpoints[3] := DoublePoint(cx,cy);
SAngle:= a1;
FAngle:= a2;
radius := rad;
ArcStyle := TarcStyle(aArcStyle);
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
end;
function TArc.CreateModification: TFigure;
begin
result := TArc.create(ap1.x,
ap1.y,
Radius,
SAngle,
FAngle,
1,1,clLime,0,0,0,0,dsTrace,nil);
Tarc(result).ArcStyle := ArcStyle;
Result.RotPoint := RotPoint;
end;
class function TArc.CreateShadow(x, y: Double): TFigure;
begin
result := TArc.create(x,y,0,0,0,1,1,clLime,0,0,0,0,dsTrace,nil);
end;
procedure TArc.Initialize;
begin
inherited;
pointcount := 3;
end;
function TArc.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean;
var Angle: Double;
cp,p1: TDoublepoint;
r: integer;
begin
cp := ap1;
p1 := DoublePoint(x,y);
Angle := GetradOfLine(cp,p1);
if mp.SeqNbr = 2 then
SAngle := Angle
else if mp.SeqNbr = 3 then
FAngle := Angle
else if mp.SeqNbr = 4 then
Radius := sqrt( sqr(x - cp.x)+sqr(y - cp.y) );
ResetRegion;
Modified := True;
end;
function TArc.ShadowClick(ClickIndex:Integer;x,y: Double): Boolean;
var cp,p1: TDoublePoint;
begin
result := false;
if clickIndex = 2 then begin
radius := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
cp := ap1;
p1 := DoublePoint(x,y);
SAngle := GetradOfLine(cp,p1);
FAngle := SAngle;
result := false;
end else if clickindex = 3 then begin
cp := ap1;
p1 := DoublePoint(x,y);
FAngle := GetradOfLine(cp,p1);
result := true;
end;
end;
class function TArc.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TArc.Create(
shadow.ap1.x,
shadow.ap1.y,
shadow.radius,
TArc(Shadow).SAngle,
TArc(Shadow).FAngle,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultArcStyle),LHandle,mydsNormal,aOwner);
end;
function TArc.ShadowTrace(ClickIndex:Integer;x,y:Double): Boolean;
var rad:Double;
cp,p1,p2: TDoublepoint;
begin
If ClickIndex = 1 then
begin
rad := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
radius := rad;
cp := ap1;
p1 := DoublePoint(x,y);
SAngle := GetradOfLine(cp,p1);
FAngle := SAngle;
end
else if ClickIndex = 2 then
begin
cp := ap1;
p1 := DoublePoint(x,y);
FAngle := GetradOfLine(cp,p1);
end;
end;
function TArc.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x, y: Double;Shift: TShiftState): boolean;
var Angle: Double;
cp,p1: TDoublepoint;
begin
cp := ap1;
p1 := DoublePoint(x,y);
Angle := GetRadOfLine(cp,p1);
if mp.SeqNbr = 2 then
TArc(TraceFigure).SAngle := Angle
else if mp.SeqNbr = 3 then
Tarc(TraceFigure).FAngle := Angle
else if (mp.SeqNbr = 4) or (mp.SeqNbr = 5) then
begin
TArc(TraceFigure).Radius := sqrt( sqr(x - cp.x)+sqr(y - cp.y));
Tarc(TraceFigure).Fangle := Tarc(TraceFigure).Sangle;
end;
end;
procedure TArc.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xDbl: Double;
begin
inherited;
// Tolik 22/11/2019 --
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(90,Stream,xByte,1);
xByte := ord(ArcStyle);
WriteField(91,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xDbl := Radius;
WriteField(222,Stream,xDbl,8);
xDbl := SAngle;
WriteField(220,Stream,xDbl,8);
xDbl := FAngle;
WriteField(221,Stream,xDbl,8);
end;
Procedure TArc.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
begin
Case xcode of
20: brc := pInt(data)^;
21: Radius := pInt(data)^/10;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
91: ArcStyle := TArcStyle(pByte(data)^);
220: SAngle := pDouble(data)^;
221: FAngle := pDouble(data)^;
222: Radius := pDouble(data)^;
end;
end;
procedure TArc.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
acolor,bColor : Tcolor;
dx,dy: real;
Angle: Double;
p1,p2: TDOublePoint;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
if (FAngle = 0) and (SAngle = 0)
then
begin
Angle := GetradOfLine(ap1,ap2);
SAngle := Angle;
Angle := GetradOfLine(ap1,ap3);
FAngle := Angle;
end;
acolor := color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
bColor := brc;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.Canvas.Pen.Mode := pmXor
else
DEngine.Canvas.Pen.Mode := pmCopy;
if Needregion and (ArcStyle <> asOpen) then
DEngine.drawbezarc(ap1.x,ap1.y,radius,SAngle,FAngle,acolor, aawidth,style,
bColor,GDIbrs,Ord(ArcStyle),RegHandle,p1,p2,InCombined,RowStyle);
if ArcStyle <> asOpen then DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
DEngine.drawbezarc(ap1.x,ap1.y,radius,SAngle,FAngle,acolor, aawidth,style,
bColor,GDIbrs,Ord(ArcStyle),RegHandle,p1,p2,InCombined,RowStyle);
actualpoints[2] := NormalizePoint(p1);
actualpoints[3] := NormalizePoint(p2);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TArc.getModPoints(ModList: TMyList);
var
p4: TDoublePoint;
CControl: TPCDrawing;
dx,dy: Double;
MAngle: Double;
begin
CControl := TPCDrawing(Owner);
if FAngle = SAngle then
begin
p4 := DoublePoint(ap1.x+radius,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;
p4 := DoublePoint(ap1.x+radius,ap1.y);
p4 := RotatePoint(ap1,p4,MAngle);
end;
if radius = 0 then begin
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,p4.x,p4.y,4));
end else begin
ModList.Add(CControl.RegisterModPoint(self,ptUndefined,ptCross,clBlue,pointdim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clBlue,pointdim,ap2.x,ap2.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clBlue,pointdim,ap3.x,ap3.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,p4.x,p4.y,4));
end;
end;
procedure TArc.getbounds(var figMaxX,figMaxY,figMinX,figMinY:Double);
begin
GetArcBounds(ap1,Radius,Radius,ord(arcstyle),sAngle,fAngle,0,figMaxX,figMaxY,figMinX,figMinY);
end;
function TArc.isPointIn(x,y:Double):boolean;
var CControl:TPCdrawing;
a: Double;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
a := GetRadOfLine(ap1,DoublePOint(x,y));
result := isPointInCircle(x,y,ap1.x,ap1.y,Radius) and isAngleIn(a);
if (not result) and ((ArcStyle <> asOpen) or (SAngle = FAngle)) and (brs <> ord(bsClear)) then
begin
if IsPointInRegion(x,y) then result := true;
// Tolik
if IsPointInRegionByRegObj(x,y) then result := true;
//
end;
end;
function TArc.isAngleIn(a: Double): boolean;
begin
if FAngle > SAngle then begin
result := Between(a,SAngle,FAngle);
end else if FAngle = SAngle then begin
result := true;
end else begin
result := not Between(a,SAngle,FAngle);
end;
end;
function TArc.DuplicateAsBezier: TFigure;
var Points: T2DPointArray;
cnt,cntA,i: Integer;
p: TDoublePoint;
pp: TDoublePointArr;
res: TPolyline;
cx,cy: Double;
begin
cx := ap1.x;
cy := ap1.y;
BezierElpArcPoints(Points,ap1.x,ap1.y,Radius,Radius,0,SAngle,FAngle);
cnt := Length(Points);
cntA := 0;
if arcStyle = asPie then cntA := 6
else if ArcStyle = asChord then cntA := 3;
SetLength(pp,cnt+cntA);
for i := 0 to cnt-1 do
begin
p := DoublePoint(Points[i].x,Points[i].y);
pp[i] := p;
end;
if arcStyle = asPie then begin
pp[cnt-1+1] := QrPoint(pp[cnt-1],ap1);
pp[cnt-1+2] := QrPoint(ap1,pp[cnt-1]);
pp[cnt-1+3] := ap1;
pp[cnt-1+4] := QrPoint(ap1,pp[0]);
pp[cnt-1+5] := QrPoint(pp[0],ap1);
pp[cnt-1+6] := pp[0];
end else if ArcStyle = asChord then begin
pp[cnt-1+1] := QrPoint(pp[cnt-1],pp[0]);
pp[cnt-1+2] := QrPoint(pp[0],pp[cnt-1]);
pp[cnt-1+3] := pp[0];
end;
SetLength(Points,0);
result := TPolyline.createFromBezierPoints(pp,Width,Style,color,Brs,Brc,0,
(ArcStyle <> asOpen),Layerhandle,mydsNormal,owner);
// Tolik 24/05/2019 --
SetLength(pp, 0);
//
end;
function TArc.duplicate:TFigure;
var res : TArc;
begin
res := TArc.create( originalpoints[1].x,
originalpoints[1].y,
radius,
sAngle,
FAngle,
width,
style,
color,
brs,
brc,
ord(ArcStyle),
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
result := res;
end;
function TArc.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var np1,np2:TDoublePoint;
iCnt,xCnt: Integer;
a: Double;
begin
result := false;
if GetLineCircleIntersection(p1,p2,ap1,radius,np1,np2,icnt,false) then begin
xCnt := 0;
if iCnt > 0 then begin
a := GetradOfLine(ap1,np1);
if isPointInCircle(np1.x,np1.y,ap1.x,ap1.y,Radius) and isAngleIn(a) then begin
xCnt := xcnt+1;
SetLength(pArr,xCnt);
pArr[xCnt-1] := np1;
end;
end;
if iCnt > 1 then begin
a := GetradOfLine(ap1,np2);
if isPointInCircle(np2.x,np2.y,ap1.x,ap1.y,Radius) and isAngleIn(a) then begin
xCnt := xcnt+1;
SetLength(pArr,xCnt);
pArr[xCnt-1] := np2;
end;
end;
if xCnt > 0 then result := True;
end;
end;
function TArc.BreakByPoint(p: TdoublePoint; var Figures: TList): boolean;
var a: Double;
Fig: Tfigure;
begin
a := GetradOfLine(ap1,p);
result := false;
if isPointInCircle(p.x,p.y,ap1.x,ap1.y,Radius) and isAngleIn(a) then begin
fig := TArc.create(ap1.x,ap1.y,radius,SAngle,a,width,style,color,
brs,brc,ord(arcStyle),LayerHandle,mydsNormal,owner);
Figures.Add(fig);
fig := TArc.create(ap1.x,ap1.y,radius,a,Fangle,width,style,color,
brs,brc,ord(arcStyle),LayerHandle,mydsNormal,owner);
Figures.Add(fig);
result := true;
end;
end;
Procedure TArc.Invert;
var tA: double;
Begin
ta := SAngle;
Sangle := FAngle;
FAngle := ta;
Resetregion;
Modified := true;
End;
procedure TArc.VerifyZeroPoints(orgV, orgH: Byte);
begin
inherited;
if (orgV <> VertZero) then
begin
SAngle := 2*pi - SAngle;
FAngle := 2*pi - FAngle;
Invert;
end;
if (orgH <> HorzZero) then
begin
SAngle := pi - SAngle;
FAngle := pi - FAngle;
Invert;
end;
end;
procedure TArc.ArrangeStyle(val: TArcStyle);
begin
ArcStyle := val;
Resetregion;
end;
Procedure TArc.Mirror(Point1,Point2: TDoublePoint);
Begin
inherited Mirror(Point1,Point2);
SAngle := GetradOfLine(ap1,ap2);
FAngle := GetradOfLine(ap1,ap3);
Invert;
end;
procedure TArc.Rotate(aAngle: Double; cPoint: TDoublePoint);
begin
inherited;
Fangle := 0;
SAngle := 0;
draw(GCadForm.PCad.DEngine, False);
// SAngle := GetradOfLine(ap1,ap2);
// FAngle := GetradOfLine(ap1,ap3);
// SAngle := SAngle + aAngle;
// if SAngle > 2 * pi then
// SAngle := SAngle - 2 * pi;
// FAngle := FAngle + aAngle;
// if FAngle > 2 * pi then
// FAngle := FAngle - 2 * pi;
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TArc.MenuClicked(CommandId: integer);
var mnIdx: integer;
begin
mnIdx := CommandId-MenuIndex;
case mnIdx of
0: ArcStyle:= asOpen;
1: ArcStyle:= asPie;
2: ArcStyle:= asChord;
3: Invert;
end;
end;
procedure TArc.UpdateMenu(var popMenu: TPopUpMenu; var sIndex: Integer);
var mnItem:TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmOpenArc;
mnItem.Tag := sIndex;
if arcStyle = asOpen then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmPieArc;
mnItem.Tag := sIndex+1;
if arcStyle = asPie then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmChordArc;
mnItem.Tag := sIndex+2;
if arcStyle = asChord then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmInvertArc;
mnItem.Tag := sIndex+3;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+4;
end;
(* ========================================================================== *)
// TRECTANGLE IMPLEMENTATION //
(* ========================================================================== *)
constructor TRectangle.create(aX1,aY1,aX2,aY2:Double;w,s,c,abrs,abrc:integer;
LHandle:LongInt;aDrawStyle: TDrawStyle;aOwner: TComponent);
begin
inherited create(LHandle, aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(ax1,ay1);
originalpoints[2] := DoublePoint(ax2,ay1);
originalpoints[3] := DoublePoint(ax2,ay2);
originalpoints[4] := DoublePoint(ax1,ay2);
actualpoints[1] := DoublePoint(ax1,ay1);
actualpoints[2] := DoublePoint(ax2,ay1);
actualpoints[3] := DoublePoint(ax2,ay2);
actualpoints[4] := DoublePoint(ax1,ay2);
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
//Initialize;
end;
procedure TRectangle.Initialize;
begin
inherited;
pointcount := 4;
DimLeft:=False;
DimRight:=True;
DimTop:=True;
DimBottom:= False;
GetMem(FDrawPoints, 5*8); //31.10.2011 - ïàìÿòü äëÿ îòðèñîâêè òî÷åê íà TPCDrawEngine.WPolygon
end;
class function TRectangle.ShadowType: TShadowType;
begin
result := stRectangle;
end;
function TRectangle.CreateModification: TFigure;
var res: TRectangle;
begin
res := TRectangle.create(ap1.x,ap1.y,
ap3.x,ap3.y,
1,1,clLime,1,clWhite,0,dsTrace,nil);
res.actualpoints[1] := ap1;
res.actualpoints[2] := ap2;
res.actualpoints[3] := ap3;
res.actualpoints[4] := ap4;
res.RotPoint := RotPoint;
CreateModification := res;
end;
class function TRectangle.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TRectangle.create(Shadow.ap1.x,Shadow.ap1.y,
Shadow.ap3.x,Shadow.ap3.y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
end;
function TRectangle.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean;
var a: integer;
ap: TDoublePoint;
begin
For a := 1 to PointCount do
begin
ap := ActualPoints[a];
ActualPoints[a] :=
DoublePoint(
ap.x+(TraceFigure.ActualPoints[a].x- ap.x),
ap.y+(TraceFigure.ActualPoints[a].y- ap.y)
);
end;
ResetRegion;
Modified := True;
If assigned(OnModified) then OnModified(self);
end;
function TRectangle.ShadowClick(ClickIndex:Integer;x,y:Double): Boolean;
begin
result := false;
if clickindex = 2 then result := true;
end;
function TRectangle.ShadowTrace(ClickIndex:Integer;x,y:Double): Boolean;
var x1,y1: Double;
begin
if clickindex = 1 then begin
x1 := ap1.x;
y1 := ap1.y;
actualPoints[2] := DoublePoint(x,y1);
actualPoints[3] := DoublePoint(x,y);
actualPoints[4] := DoublePoint(x1,y);
end;
end;
function TRectangle.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x,y: Double;Shift: TShiftState): boolean;
var
p1,p2,p3,p4,hitPoint,orPoint : TDoublePoint;
rad,dist,distx,disty,distx1,disty1,dx,dy,xAngle : Double;
ang1,ang2:Double;
w,h:Double;
ddx,ddy: integer;
idx: Integer;
fg: Tfigure;
begin
fg := mp.Figure;
dx := (fg.ActualPoints[3].x - fg.ActualPoints[4].x );
dy := (fg.ActualPoints[3].y - fg.ActualPoints[4].y );
p1 := fg.ap1;
p2 := fg.ap2;
p3 := fg.ap3;
p4 := fg.ap4;
if (dx <> 0) and (dy <> 0) then
xAngle := (ArcTan(dy / dx))
else if dx = 0 then xAngle := pi/2
else if dy = 0 then xAngle := 0;
if fDiagonal then
begin
w := GetLineLenght(p1,p2);
h := GetLineLenght(p2,p3);
end;
hitPoint := RotatePoint(p4,DoublePoint(x,y),-1*xAngle);
if mp.SeqNbr = 1 then
begin
orPoint := RotatePoint(p4,p1,-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
ddx := 1;ddy := 1;
if distx < 0 then ddx := -1;
if disty < 0 then ddy := -1;
if p1.x < p2.x then ddx := ddx*-1;
if p1.y < p3.y then ddy := ddy*-1;
if fDiagonal then
begin
if abs(distx / w) > abs(disty/h) then begin
disty := abs((distx/w)*h);
if ddx = 1 then begin
if p1.y < p3.y then disty := -1*disty;
end else begin
if p1.y > p3.y then disty := -1*disty;
end;
end else begin
distx := abs((disty/h)*w);
if ddy = 1 then begin
if p1.x < p2.x then distx := -1*distx;
end else begin
if p1.x > p2.x then distx := -1*distx;
end;
end;
end;
orPoint := RotatePoint(p4,p4,-1*xAngle);
TraceFigure.ActualPoints[4] :=
RotatePoint(p4,DoublePoint(orPoint.x + distx,orPoint.y ),xAngle);
orPoint := RotatePoint(p4,p2,-1*xAngle);
TraceFigure.ActualPoints[2] :=
RotatePoint(p4,DoublePoint(orPoint.x,orPoint.y+disty),xAngle);
orPoint := RotatePoint(p4,p1,-1*xAngle);
TraceFigure.ActualPoints[1] :=
RotatePoint(p4,DoublePoint(orPoint.x+distx,orPoint.y+disty),xAngle);
end
else if mp.SeqNbr = 2 then
begin
orPoint := RotatePoint(p4,MPoint(p1,p2),-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
orPoint := RotatePoint(p4,p1,-1*xAngle);
TraceFigure.ActualPoints[1] := RotatePoint(p4,MVPoint(orPoint,disty),xAngle);
orPoint := RotatePoint(p4,p2,-1*xAngle);
TraceFigure.ActualPoints[2] := RotatePoint(p4,MVPoint(orPoint,disty),xAngle);
end
else if mp.SeqNbr = 3 then
begin
orPoint := RotatePoint(p4,p2,-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
ddx := 1;ddy := 1;
if distx < 0 then ddx := -1;
if disty < 0 then ddy := -1;
if p1.x > p2.x then ddx := ddx*-1;
if p1.y < p3.y then ddy := ddy*-1;
if fDiagonal then
begin
if abs(distx / w) > abs(disty/h) then begin
disty := abs((distx/w)*h);
if ddx = 1 then begin
if p1.y < p3.y then disty := -1*disty;
end else begin
if p1.y > p3.y then disty := -1*disty;
end;
end else begin
distx := abs((disty/h)*w);
if ddy = 1 then begin
if p1.x > p2.x then distx := -1*distx;
end else begin
if p1.x < p2.x then distx := -1*distx;
end;
end;
end;
orPoint := RotatePoint(p4,p3,-1*xAngle);
TraceFigure.ActualPoints[3] :=
RotatePoint(p4,MHPoint(orPoint,distx),xAngle);
orPoint := RotatePoint(p4,p1,-1*xAngle);
TraceFigure.ActualPoints[1] :=
RotatePoint(p4,MVPoint(orPoint,disty),xAngle);
orPoint := RotatePoint(p4,p2,-1*xAngle);
TraceFigure.ActualPoints[2] :=
RotatePoint(p4,MovePoint(orPoint,distx,disty),xAngle);
end
else if mp.SeqNbr = 4 then
begin
orPoint := RotatePoint(p4,MPoint(p2,p3),-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
orPoint := RotatePoint(p4,p2,-1*xAngle);
TraceFigure.ActualPoints[2] :=
RotatePoint(p4,MHPoint(orPoint,distx),xAngle);
orPoint := RotatePoint(p4,p3,-1*xAngle);
TraceFigure.ActualPoints[3] :=
RotatePoint(p4,MHPoint(orPoint,distx),xAngle);
end
else if mp.SeqNbr = 5 then
begin
orPoint := RotatePoint(p4,p3,-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
ddx := 1;ddy := 1;
if distx < 0 then ddx := -1;
if disty < 0 then ddy := -1;
if p1.x > p2.x then ddx := ddx*-1;
if p1.y > p3.y then ddy := ddy*-1;
if fDiagonal then
begin
if abs(distx / w) > abs(disty/h) then begin
disty := abs(abs(distx/w)*h);
if ddx = 1 then begin
if p1.y > p3.y then disty := -1*disty;
end else begin
if p1.y < p3.y then disty := -1*disty;
end;
end else begin
distx := abs((disty/h)*w);
if ddy = 1 then begin
if p1.x > p2.x then distx := -1*distx;
end else begin
if p1.x < p2.x then distx := -1*distx;
end;
end;
end;
TraceFigure.ActualPoints[4] :=
RotatePoint(p4,MVPoint(p4,disty),xAngle);
orPoint := RotatePoint(p4,p2,-1*xAngle);
TraceFigure.ActualPoints[2] :=
RotatePoint(p4,MHPoint(orpoint,distx),xAngle);
orPoint := RotatePoint(p4,p3,-1*xAngle);
TraceFigure.ActualPoints[3] :=
RotatePoint(p4,MovePoint(orpoint,distx,disty),xAngle);
end
else if mp.SeqNbr = 6 then
begin
orPoint := RotatePoint(p4,MPoint(p3,p4),-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
orPoint := RotatePoint(p4,p3,-1*xAngle);
TraceFigure.ActualPoints[3] :=
RotatePoint(p4,MVPoint(orpoint,disty),xAngle);
orPoint := RotatePoint(p4,p4,-1*xAngle);
TraceFigure.ActualPoints[4] :=
RotatePoint(p4,MVPoint(orpoint,disty),xAngle);
end
else if mp.SeqNbr = 7 then
begin
orPoint := RotatePoint(p4,p4,-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
ddx := 1;ddy := 1;
if distx < 0 then ddx := -1;
if disty < 0 then ddy := -1;
if p1.x < p2.x then ddx := ddx*-1;
if p1.y > p3.y then ddy := ddy*-1;
if fDiagonal then
begin
if abs(distx / w) > abs(disty/h) then begin
disty := abs(abs(distx/w)*h);
if ddx = 1 then begin
if p1.y > p3.y then disty := -1*disty;
end else begin
if p1.y < p3.y then disty := -1*disty;
end;
end else begin
distx := abs((disty/h)*w);
if ddy = 1 then begin
if p1.x < p2.x then distx := -1*distx;
end else begin
if p1.x > p2.x then distx := -1*distx;
end;
end;
end;
orPoint := RotatePoint(p4,p3,-1*xAngle);
TraceFigure.ActualPoints[3] :=
RotatePoint(p4,MVPoint(orPoint,distY),xAngle);
orPoint := RotatePoint(p4,p1,-1*xAngle);
TraceFigure.ActualPoints[1] :=
RotatePoint(p4,MHPoint(orPoint,distX),xAngle);
orPoint := RotatePoint(p4,p4,-1*xAngle);
TraceFigure.ActualPoints[4] :=
RotatePoint(p4,MovePoint(orPoint,distX,distY),xAngle);
end
else if mp.SeqNbr = 8 then
begin
orPoint := RotatePoint(p4,MPoint(p1,p4),-1*xAngle);
distx := hitPoint.x - orPoint.x;
disty := hitPoint.y - orPoint.y;
orPoint := RotatePoint(p4,p4,-1*xAngle);
TraceFigure.ActualPoints[4] :=
RotatePoint(p4,MHPoint(orPoint,distX),xAngle);
orPoint := RotatePoint(p4,p1,-1*xAngle);
TraceFigure.ActualPoints[1] :=
RotatePoint(p4,MHPoint(orPoint,distX),xAngle);
end;
end;
procedure TRectangle.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
begin
inherited;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
WriteField(90,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
WriteField(91,Stream,DimLeft,1);
WriteField(92,Stream,DimRight,1);
WriteField(93,Stream,DimTop,1);
WriteField(94,Stream,DimBottom,1);
end;
Procedure TRectangle.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
begin
Case xcode of
20: brc := pInt(data)^;
90: begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
91: DimLeft := Boolean(pByte(data)^);
92: DimRight := Boolean(pByte(data)^);
93: DimTop := Boolean(pByte(data)^);
94: DimBottom := Boolean(pByte(data)^);
end;
end;
procedure TRectangle.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
acolor,bcolor : Tcolor;
points : TDoublePointArr;
xBrs: Integer;
xp: TPoint; //31.10.2011
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
acolor := color;
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then DEngine.Canvas.Pen.Mode := pmXor
else DEngine.Canvas.Pen.Mode := pmCopy;
{//31.10.2011}
SetLength(points,4);
points[0] := ap1;
points[1] := ap2;
points[2] := ap3;
points[3] := ap4;{}
{//31.10.2011 - òî÷êè äëÿ îòðèñîâêè
xp := DEngine.ConvertCoordToPt(ap1);
PInt(PChar(FDrawPoints)+0*8+0)^:= xp.x;
PInt(PChar(FDrawPoints)+0*8+4)^:= xp.y;
PInt(PChar(FDrawPoints)+4*8+0)^:= xp.x;
PInt(PChar(FDrawPoints)+4*8+4)^:= xp.y;
xp := DEngine.ConvertCoordToPt(ap2);
PInt(PChar(FDrawPoints)+1*8+0)^:= xp.x;
PInt(PChar(FDrawPoints)+1*8+4)^:= xp.y;
xp := DEngine.ConvertCoordToPt(ap3);
PInt(PChar(FDrawPoints)+2*8+0)^:= xp.x;
PInt(PChar(FDrawPoints)+2*8+4)^:= xp.y;
xp := DEngine.ConvertCoordToPt(ap4);
PInt(PChar(FDrawPoints)+3*8+0)^:= xp.x;
PInt(PChar(FDrawPoints)+3*8+4)^:= xp.y;}
if NeedRegion then
//{//31.10.2011 }DEngine.drawpolygon(points,acolor,width,style,bcolor,GdiBrs,RegHandle, nil, FDrawPoints);
DEngine.drawrect(ap1, ap2, ap3, ap4, acolor, aawidth, Style, bcolor, GdiBrs, RegHandle);
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
//{//31.10.2011 }DEngine.drawpolygon(points,acolor,width,style,bcolor,GdiBrs,RegHandle, nil, FDrawPoints);
DEngine.drawrect(ap1, ap2, ap3, ap4, acolor, aawidth, Style, bcolor, GdiBrs, RegHandle);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TRectangle.getModPoints(ModList: TMyList);
var
CControl: TPCDrawing;
MT,MR,MB,ML : TDoublePoint;
begin
CControl := TPCDrawing(Owner);
MT := MPoint(ap1,ap2);
MR := MPoint(ap2,ap3);
MB := MPoint(ap3,ap4);
ML := MPoint(ap4,ap1);
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MT.x,MT.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap2.x,ap2.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MR.x,MR.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap3.x,ap3.y,5));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MB.x,MB.y,6));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap4.x,ap4.y,7));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ML.x,ML.y,8));
end;
procedure TRectangle.getbounds(var figMaxX,figMaxY,figMinX,figMinY:Double);
var a : integer;
begin
//Tolik
// ïðè ïîëó÷åíèè ãðàíèö êàáèíåòà àð íå âñåãäà ìîãóò áûòü ïðîèíèöèàëèçèðîâàíû, ìîæíî ïîëó÷èòü
// "ìóñîð" ïðè ðàñ÷åòàõ
figMaxX := ap1.x;
figMinX := ap1.x;
figMaxY := ap1.y;
figMinY := ap1.y;
{
figMaxX := actualpoints[1].x;
figMinX := actualpoints[1].x;
figMaxY := actualpoints[1].y;
figMinY := actualpoints[1].y;
}
//
For a := 1 to 4 do
begin
if actualpoints[a].x > figMaxX then figMaxX := actualpoints[a].x;
if actualpoints[a].x < figMinX then figMinX := actualpoints[a].x;
if actualpoints[a].y > figMaxY then figMaxY := actualpoints[a].y;
if actualpoints[a].y < figMinY then figMinY := actualpoints[a].y;
end;
end;
function TRectangle.isPointIn(x,y:Double): boolean;
var apoint,p1,p2,p3,p4: TDoublePoint;
DEngine: TPCDrawEngine;
z: Double;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
apoint.x := x;
apoint.y := y;
aPoint.z := 0; // Tolik 28/08/2019 -- íà âñÿêèé...
p1 := ap1; p2 := ap2; p3 := ap3; p4 := ap4;
if assigned(owner) then begin
z := 0;
DEngine := TPCDrawing(owner).DEngine;
Dengine.ConvertPoint(p1.x,p1.y,z);
Dengine.ConvertPoint(p2.x,p2.y,z);
Dengine.ConvertPoint(p3.x,p3.y,z);
Dengine.ConvertPoint(p4.x,p4.y,z);
Dengine.ConvertPoint(apoint.x,apoint.y,z);
end;
if ( ispointInLine(p1,p2,apoint,width) or
ispointInLine(p2,p3,apoint,width) or
ispointInLine(p3,p4,apoint,width) or
ispointInLine(p4,p1,apoint,width) ) then
begin
result := true;
exit;
end;
if TBrushStyle(brs) <> bsClear then
begin
result := isPointInRegion(x,y);
//Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
end;
function TRectangle.BreakByPoint(p: TdoublePoint;var Figures: TList): boolean;
var pArr: TDoublePointArr;
Fig: Tfigure;
begin
result := true;
SetLength(pArr,6);
if isPointinLine(ap1,ap2,p,2) then begin
pArr[0] := p ;pArr[1] := ap2;pArr[2] := ap3;
pArr[3] := ap4;pArr[4] := ap1;pArr[5] := p;
end else if isPointinLine(ap2,ap3,p,2) then begin
pArr[0] := p ;pArr[1] := ap3;pArr[2] := ap4;
pArr[3] := ap1;pArr[4] := ap2;pArr[5] := p;
end else if isPointinLine(ap3,ap4,p,2) then begin
pArr[0] := p ;pArr[1] := ap4;pArr[2] := ap1;
pArr[3] := ap2;pArr[4] := ap3;pArr[5] := p;
end else if isPointinLine(ap4,ap1,p,2) then begin
pArr[0] := p ;pArr[1] := ap1;pArr[2] := ap2;
pArr[3] := ap3;pArr[4] := ap4;pArr[5] := p;
end else begin
Result := False;
end;
if result then begin
Fig := TPolyline.create(pArr,width,style,color,brs,brc,0,false,LayerHandle,mydsNormal,owner);
Figures.Add(fig)
end;
SetLength(pArr,0);
end;
function TRectangle.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var p: TDoublePoint;
pCnt: Integer;
begin
result := false;
pCnt := 0;
if GetInterSectionPoint(ap1,ap2,p1,p2,p,False) then begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := p;
end;
if GetInterSectionPoint(ap2,ap3,p1,p2,p,False) then begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := p;
end;
if GetInterSectionPoint(ap3,ap4,p1,p2,p,False) then begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := p;
end;
if GetInterSectionPoint(ap4,ap1,p1,p2,p,False) then begin
pCnt := pCnt+1;
SetLength(pArr,pCnt);
pArr[pCnt-1] := p;
end;
result := (pCnt > 0);
end;
function TRectangle.DuplicateAsBezier: TFigure;
var points: TDoublePointArr;
p1,p2,cp1,cp2: TDoublePoint;
i: Integer;
begin
SetLength(Points,12);
for i := 1 to 4 do begin
p1 := ActualPoints[i];
p2 := ActualPoints[i+1];
cp1 := MPoint(p1,p2);
cp1 := MPoint(p1,cp1);
cp2 := MPoint(p1,p2);
cp2 := MPoint(p2,cp2);
Points[(i-1)*3 +0] := p1;
Points[(i-1)*3 +1] := cp1;
Points[(i-1)*3 +2] := cp2;
if i < 4 then Points[(i-1)*3 +3] := p2;
end;
result := TPolyline.CreateFromBezierPoints(points,width,style,color,
brs,brc,0,true,LayerHandle,mydsNormal,owner);
SetLength(Points,0);
end;
function TRectangle.duplicate:TFigure;
var res : TRectangle;
begin
res := TRectangle.create( originalpoints[1].x,
originalpoints[1].y,
originalpoints[3].x,
originalpoints[3].y,
width,
style,
color,
brs,
brc,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.originalpoints[4] := originalpoints[4];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
result := res;
end;
procedure TRectangle.GetVectorObjects(Objects: Tlist; BaseP: TDoublePoint);
var obj: TvectorObject;
p: array [0..3] of TDoublePoint;
p1: TDoublePoint;
i: Integer;
begin
for i := 1 to 4 do
begin
p1 := ActualPoints[i];
p1 := DoublePoint(p1.x-baseP.x,p1.y-baseP.y);
p[i-1] := p1;
end;
obj := TVectorObject.CreatePolygonObject(4,p);
Objects.Add(obj);
end;
(* ========================================================================== *)
// TBMPObject IMPLEMENTATION //
(* ========================================================================== *)
// Tolik -- 10/03/2016 -- òóò íåìíîæêî ïåðåäåëàíî ñ öåëüþ ïðàâèëüíî çàãðóçèòü ðàçìåðû JPEG
constructor TBMPObject.create(x,y:Double; afName: string; LHandle:LongInt;
aDrawStyle: TDrawStyle;aOwner: TComponent; JPEGBounds: Boolean = false);
var
bmpress: single;
bmpresW, bmpresH: single;
//i: Integer;
i: TPixelFormat;
bmpres:Integer;
picW,picH :Double;
TempPic: TPicture;
gpImage: TgpImage;
gdiGraphics: TGPGraphics;
res1: Extended;
maxv: Extended;
res111: Extended;
res222: Extended;
PictWidth, PictHeight: Integer;
rect: TRect;
BadFormatResult: Boolean; // åñëè íå ïîëó÷èëîñü óñòàíîâèòü PixelFormat êàðòèíêè == true
WidthScale, HeightScale: Double;
FitImageToPage: Boolean;
FitKoef: Double;
CadPicWidth, CadPicHeight: Int64;
TempPicWidth, TempPicHeight: Integer;
encoderClsid: TGuid;
Procedure SetMaxDefaultPictureASttribs; // ïîëó÷èòñÿ BMP-õà ïðèìåðíî íà 120 MB -- íà âñÿêèé...
var CadPW, CadPH: Int64;
begin
Picture.PixelFormat := pf24bit;
CadPW := gpImage.GetWidth;
Picture.Height := Round(40000000/CadPW);
Picture.Width := Round(40000000/Picture.Height);
end;
Procedure Get_PictureFormat(aImage: TGpImage);
var i: Integer;
CanProceed: Boolean;
{TempPicWidth, TempPicHeight}PicWidth, PicHeight: Integer;
//CadPicWidth, CadPicHeight: Int64;
PictSize, PictPixelSize: int64;
deltax, deltay, MaxVal, Caddeltax, Caddeltay: Integer;
Counter: Integer;
HKoef, WKoef, CadHKoef, CadWKoef: Double;
ScaleWKoef, ScaleHKoef, DSize: Extended;
PicFormat: TPixelFormat;
xProc, yProc: integer;
begin
FitKoef := 1;
bmpresW := aImage.GetHorizontalResolution; // dpi ïî øèðèíå
bmpresH := aImage.GetVerticalResolution; // dpi ïî âûñîòå
PicWidth := aImage.GetWidth;
PicHeight := aImage.GetHeight;
// Tolik 24/02/2021
if GLoadImageAsIs then
begin
Picture.Width := PicWidth;
Picture.Height := PicHeight;
exit;
end;
//
if (PicWidth = 0) or (PicHeight = 0) then
exit;
Counter := 0; // resize Counter
BadFormatResult := False;
CanProceed := True;
MaxVal := 180000000;
//â äþéìàõ
CadPicWidth := Round(GCadForm.Pcad.workwidth/25.4); //Round((PicWidth / bmpresW) * 25.4) ;
CadPicHeight := Round(GCadForm.Pcad.workHeight/25.4); //Round((PicHeight / bmpresH) * 25.4) ;
// â òî÷êàõ
CadPicWidth := Round(bmpresW * CadPicWidth);
CadPicHeight := Round(bmpresH * CadPicHeight);
// 95% îò ðàçìåðà êàäà
CadPicWidth := Round(CadPicWidth * 0.95);
CadPicHeight := Round(CadPicHeight * 0.95);
//êîýôôèöèåíòû îòíîøåíèÿ ñòîðîí
ScaleWKoef := CadPicWidth / PicWidth;
ScaleHKoef := CadPicHeight / PicHeight;
//âçÿòü ìåíüøèé
if (CompareValue(ScaleWKoef, ScaleHKoef) = 1) then
ScaleWKoef := ScaleHKoef;
//5% - äëÿ èçìåíåíèÿ êîýôôèöèåíòà ñêåéëà
ScaleHKoef := ScaleWKoef/50;
if not GAutoScaleRasterImages then // âòèñíóòü çàãðóæàåìîå èçîáðàæåíèå íà ëèñò, åñëè îíî ïðåâûøàåò åãî ðàçìåðû
// ìîæåò, êîíå÷íî áûòü ïîëüçîâàòåëüñêèé ôîðìàò ëèñòà ñ ðàçìåðàìè îò ñàìîëåòà,
// òîãäà âñå ðàâíî áóäåì êîöàòü, ïîêà íå ïîëó÷èì ïðèåìëåìëåìîå çíà÷åíèå èëè,
// åñëè íå ïîëó÷èòñÿ, çàäàäèì íà êðàéíèé ñëó÷àé ïàðàìåòðû ïî äåôîëòó
begin
while CanProceed do
begin
inc(Counter);
// íà âñÿêèé, ÷òîá äî àáñóðäà íå äîâîäèòü ...
if Counter = 50 then
begin
//BadFormatResult := True; // íå óäàëîñü ïðèâåñòè ðàçìåð/ôîðìàò
SetMaxDefaultPictureASttribs;
exit;
end;
DSize := (PicWidth * ScaleWKoef);
DSize := (DSize * PicHeight);
DSize := (DSize * ScaleWKoef);
PictSize := Round(DSize);
//pf32
PictPixelSize := PictSize * 4;
if PictPixelSize < MaxVal then
begin
CanProceed := False;
Picture.PixelFormat := pf32bit;
end
else
begin
//pf24
PictPixelSize := PictSize * 3;
if PictPixelSize < MaxVal then
begin
CanProceed := False;
Picture.PixelFormat := pf24bit;
end
else
begin
//pf16
PictPixelSize := PictSize * 2;
if PictPixelSize < MaxVal then
begin
CanProceed := False;
Picture.PixelFormat := pf16bit;
end
else
//PictPixelSize := PictSize;//pf8 -- íåêðàñèâî áóäåò, íå áåðåì
// pf15bit
begin
PictPixelSize := PictSize * 15;
PictPixelSize := PictPixelSize div 8;
if PictPixelSize < MaxVal then
begin
CanProceed := False;
Picture.PixelFormat := pf15bit;
end
end;
end;
end;
if CanProceed then
ScaleWKoef := ScaleWKoef - ScaleHKoef
else
begin
Picture.Width := Round(PicWidth * ScaleWKoef);
Picture.Height := Round(PicHeight * ScaleWKoef);
exit;
end;
end;
end
else
begin
// ïîêàçàòü ôîðìó íàñòðîéêè èçîáðàæåíèÿ --
if not Assigned(F_RasterImageSettings) then
begin
Application.CreateForm(TF_RasterImageSettings, F_RasterImageSettings);
F_RasterImageSettings.CheckBox1.Checked := True;
end;
F_RasterImageSettings.PixelImageX := PicWidth;
F_RasterImageSettings.PixelImageY := PicHeight;
F_RasterImageSettings.CadPicWidth := CadPicWidth;
F_RasterImageSettings.CadPicHeight := CadPicHeight;
//ïðîâåðèòü ÷òî áîëüøå, êàðòèíêà èëè Êàä
if CadPicWidth > PicWidth then
begin
if CadPicHeight > PicHeight then
F_RasterImageSettings.CadIsBiggerThanImage := True
else
F_RasterImageSettings.CadIsBiggerThanImage := False;
end
else
F_RasterImageSettings.CadIsBiggerThanImage := False;
//Ïðèêèíóòü äîïóñòèìûé ðàçìåð êàðòèíêè íà Êàäå
if F_RasterImageSettings.CadIsBiggerThanImage then
begin
F_RasterImageSettings.MaxAllowedTrackVal := 100; // åñëè ÊÀä áîëüøå -- òî, â ïðèíöèïå, êàðòèíêà äîëæíà ïîìåñòèòüñÿ ëþáàÿ...
F_RasterImageSettings.TrackBar1.Position := 100;
end
else // åñëè íåò -- ïðèêèíóòü ðàçìåð
begin
Counter := 0; // resize Counter
// 5 %
deltax := (PicWidth div 50);
deltay := (PicHeight div 50);
PictSize := PicWidth * PicHeight;
TempPicWidth := PicWidth;
TempPicHeight := PicHeight;
while CanProceed do
begin
inc(Counter);
// íà âñÿêèé, ÷òîá äî àáñóðäà íå äîâîäèòü ...
if Counter = 50 then
begin
break;
end;
//pf24
PictPixelSize := PictSize * 3;
//if PictPixelSize < MaxVal then
if PictPixelSize < 50000000 then
CanProceed := False;
if CanProceed then
begin
TempPicWidth := TempPicWidth - deltax;
TempPicHeight := TempPicHeight - deltay;
PictSize := TempPicWidth * TempPicHeight;
end;
end;
xProc := Round((TempPicWidth*100)/PicWidth);
yProc := Round((TempPicHeight*100)/PicHeight);
if xProc > 100 then
xProc := 100;
if yProc > 100 then
yProc := 100;
if xProc > yProc then
xProc := yProc;
F_RasterImageSettings.MaxAllowedTrackVal := xProc;
F_RasterImageSettings.TrackBar1.Position := xProc;
end;
F_RasterImageSettings.TrackBar1Change(F_RasterImageSettings);
if F_RasterImageSettings.ShowModal = mrOk then
begin
FitImageToPage := F_RasterImageSettings.CheckBox1.Checked;
if FitImageToPage then
begin
if F_RasterImageSettings.TrackBar1.Position = 100 then
begin
TempPicWidth := PicWidth;
TempPicHeight := PicHeight;
end
else
begin
TempPicWidth := Round(PicWidth/100);
TempPicHeight := Round(PicHeight/100);
TempPicWidth := TempPicWidth * F_RasterImageSettings.TrackBar1.Position;
TempPicHeight := TempPicHeight * F_RasterImageSettings.TrackBar1.Position;
end;
PictSize := TempPicWidth * TempPicHeight * 3;
if PictSize < 180000000 then
begin
Picture.Width := TempPicWidth;
Picture.Height := TempPicHeight;
Picture.PixelFormat := pf24bit;
end
else
begin
Counter := 0; // resize Counter
// 5 %
deltax := (TempPicWidth div 50);
deltay := (TempPicHeight div 50);
CanProceed := True;
PictSize := TempPicWidth * TempPicHeight;
while CanProceed do
begin
inc(Counter);
// íà âñÿêèé, ÷òîá äî àáñóðäà íå äîâîäèòü ...
if Counter = 50 then
begin
break;
end;
//pf24
PictPixelSize := PictSize * 3;
if PictPixelSize < MaxVal then
begin
CanProceed := False;
Picture.PixelFormat := pf24bit;
end;
if CanProceed then
begin
TempPicWidth := TempPicWidth - deltax;
TempPicHeight := TempPicHeight - deltay;
PictSize := TempPicWidth * TempPicHeight;
end
else
begin
Picture.Width := TempPicWidth;
Picture.Height := TempPicHeight;
end;
end;
end;
ScaleWKoef := CadPicWidth / TempPicWidth;
ScaleHKoef := CadPicHeight / TempPicHeight;
// áåðåì ìåíüøèé
if CompareValue(ScaleWKoef, ScaleHKoef) = 1 then
FitKoef := ScaleHKoef
else
FitKoef := ScaleWKoef;
end
else
begin // åñëè íå ìàñøòàáèðîâàòü íà ëèñò -- ïðîâåðèòü ðàçìåð è ïðèâåñòè ê íîðìàëüíîìó, ÷òîáû íå âûëåòåëî ...
Picture.PixelFormat := pf24bit;
Picture.Width := 0;
MaxVal := 180000000;
if F_RasterImageSettings.TrackBar1.Position <> 100 then
begin
//MaxVal := 1800000 * F_RasterImageSettings.TrackBar1.Position;
TempPicWidth := Round((PicWidth/100) * F_RasterImageSettings.TrackBar1.Position);
TempPicHeight := Round((PicHeight/100)*F_RasterImageSettings.TrackBar1.Position);
end
else
begin
TempPicWidth := PicWidth;
TempPicHeight := PicHeight;
end;
Counter := 0; // resize Counter
// 5 %
deltax := (TempPicWidth div 50);
deltay := (TempPicHeight div 50);
CanProceed := True;
PictSize := TempPicWidth * TempPicHeight;
while CanProceed do
begin
inc(Counter);
// íà âñÿêèé, ÷òîá äî àáñóðäà íå äîâîäèòü ...
if Counter = 50 then
begin
break;
end;
//pf24
PictPixelSize := PictSize * 3;
if PictPixelSize < MaxVal then
begin
CanProceed := False;
end;
if CanProceed then
begin
TempPicWidth := TempPicWidth - deltax;
TempPicHeight := TempPicHeight - deltay;
PictSize := TempPicWidth * TempPicHeight;
end
else
begin
Picture.Width := TempPicWidth;
Picture.Height := TempPicHeight;
end;
end;
end;
end
else
begin
Picture.Width := 0;
end;
end;
end;
// Tolik 04/02/2020 --
function CheckCanGetMemoForPicture(aPictSize: Cardinal): Boolean;
var p: PByte;
Mess: string;
begin
Result := True;
try
p := AllocMem(aPictSize);
except
on E: Exception do
begin
// if E.ClassName = 'EOutOfMeMory' then
{$IF Defined (SCS_PE)}
Mess := 'Attention! Not enough memory to load image! ' + #13#10 + 'It is recommended to close other applications or contact' +
#13#10 + 'to the technical support service.';
{$ELSEIF Defined (SCS_RF)}
Mess := 'Âíèìàíèå! Íåäîñòàòî÷íî ïàìÿòè äëÿ çàãðóçêè èçîáðàæåíèÿ!' + #13#10 +
'Ðåêîìåíäóåòñÿ çàêðûòü äðóãèå ïðèëîæåíèÿ èëè îáðàòèòüñÿ' + #13#10 +
'â ñëóæáó òåõïîääåðæêè.';
{$ELSEIF Defined (SCS_UKR)}
Mess := 'Óâàãà! Íåäîñòàòíüî ïàì' + ''''+'ÿò³ äëÿ çàâàíòàæåííÿ çîáðàæåííÿ!' + #13#10 +
'Ðåêîìåíäóºòüñÿ çàêðèòè ³íø³ ïðîãðàìí³ äîäàòêè àáî çâåðíóòèñÿ' + #13#10 +
'â ñëóæáó òåõï³äòðèìêè.';
{$ELSE}
Mess := 'Âíèìàíèå! Íåäîñòàòî÷íî ïàìÿòè äëÿ çàãðóçêè èçîáðàæåíèÿ!' + #13#10 +
'Ðåêîìåíäóåòñÿ çàêðûòü äðóãèå ïðèëîæåíèÿ èëè îáðàòèòüñÿ' + #13#10 +
'â ñëóæáó òåõïîääåðæêè.';
{$IFEND}
ShowMessage(Mess);
Result := False;
exit;
end;
end;
FreeMem(p);
end;
begin
inherited create(LHandle, aDrawStyle,aOwner);
initialize;
originalpoints[1] := DoublePoint(x,y);
originalpoints[2] := DoublePoint(x,y);
originalpoints[3] := DoublePoint(x,y);
originalpoints[4] := DoublePoint(x,y);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
PictureName := extractFileName(afName);
Picture.Width := 0;
Picture.Height := 0;
FitImageToPage := False;
// Tolik 09/08/2019 --
if fileexists(afName) then
begin
if DrawStyle = mydsNormal then
begin
try
ImageEdited := True; // Tolik 20/04/2018 --
try
maxv := 200000000;
gdiGraphics:= TGPGraphics.Create();
GPImage := nil;
try
GPImage := GPImage.FromFile(afName);
except
AddExceptionToLog('TBMPObject.create FromFile');
if Assigned(gpImage) then
freeandnil(gpImage);
gdiGraphics.free;
exit;
end;
{$IF Not Defined (FINAL_SCS)}
// Tolik -- ýòèì ïîæíî ñïèçäèòü êàðòèíêó, åñëè íàäî ... (íà äåáàãå)
//GetEncoderClsid('image/jpeg', encoderClsid);
//GPimage.Save('c:\1.jpg', encoderClsid, nil);
{$IFEND}
Get_PictureFormat(GpImage);
if (Picture.Width = 0) or (Picture.Height = 0) then
begin
if Assigned(gpImage) then
freeandnil(gpImage);
gdiGraphics.free;
exit;
end;
except
if (Picture.Width = 0) or (Picture.Height = 0) then
begin
//Picture.PixelFormat := pf8bit;
//Picture.Width := PictWidth;
//Picture.Height := PictHeight;
if Assigned(gpImage) then
freeandnil(gpImage);
gdiGraphics.free;
exit;
end;
end;
{begin
TempPic := TPicture.Create;
TempPic.Bitmap := TBitmap.Create;
TempPic.Bitmap.Width := TempPicWidth;
TempPic.Bitmap.Height := TempPicHeight;
gdiGraphics := gdiGraphics.FromHDC(TempPic.Bitmap.Canvas.Handle);
gdiGraphics.DrawImage(GPImage, 0, 0, TempPicWidth, TempPicHeight);
Picture.Width := CadPicWidth;
Picture.Height := CadPicHeight;
rect.Left := 0;
rect.Top := 0;
Rect.Bottom := CadPicHeight;
Rect.Right := CadPicWidth;
Picture.Canvas.StretchDraw(Rect,TempPic.Bitmap);
TempPic.Free;
end
else
begin}
if not CheckCanGetMemoForPicture(Picture.Width*Picture.Width*3) then
begin
if Assigned(gpImage) then
freeandnil(gpImage);
gdiGraphics.free;
Picture.Width := 0;
exit;
end;
gdiGraphics := gdiGraphics.FromHDC(Picture.Canvas.Handle);
//gdigraphics.SetInterpolationMode(3);
gdiGraphics.DrawImage(GPImage, 0, 0, Picture.Width, Picture.Height);
//end;
GPImage.Free;
gdiGraphics.free;
FitImageToPage := (GAutoScaleRasterImages and Assigned(F_RasterImageSettings) and F_RasterImageSettings.CheckBox1.Checked);
if FitImageToPage then
begin
GImageScale := 0;
picW := CadPicWidth / Picture.Width;
picH := CadPicHeight / Picture.Height;
if compareValue(PicW, PicH) = 1 then
GImageScale := PicH
else
GImageScale := PicW;
end;
except
on EInvalidGraphic do
begin
AddExceptionToLog('TBMPObject.create');
picture.width := 10;
picture.height := 10;
end;
end;
if JPEGBounds then
begin
PicW := (Picture.width / 3.78);
PicH := (Picture.Height / 3.78);
end
else
begin
{if bmpres = 0 then bmpres := 180;
PicW := (Picture.width / bmpres) * 25.4 ;
PicH := (Picture.Height / bmpres) * 25.4 ;}
// íà âñÿêèé ..
if bmpresW = 0 then
bmpresW := 96;
if bmpresH = 0 then
bmpresH := 96;
//
PicW := (Picture.width / bmpresW) * 25.4 ;
PicH := (Picture.Height / bmpresH) * 25.4 ;
end;
if vertZero = 1 then PicH := -1* PicH;
if horzZero = 1 then PicW := -1* PicW;
originalpoints[2] := DoublePoint(x+PicW,y);
originalpoints[3] := DoublePoint(x+PicW,y-PicH);
originalpoints[4] := DoublePoint(x,y-PicH);
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
width := 1;
color := clBlack;
//FreeAndNil(TempPic);
end;
end
else
Picture.Width := 0;
end;
(*constructor TBMPObject.create(x,y:Double; afName: string; LHandle:LongInt;
aDrawStyle: TDrawStyle;aOwner: TComponent);
var
bmpres:Integer;
picW,picH :Double;
TempPic: TPicture;
res1: double;
maxv: double;
begin
inherited create(LHandle, aDrawStyle,aOwner);
initialize;
originalpoints[1] := DoublePoint(x,y);
originalpoints[2] := DoublePoint(x,y);
originalpoints[3] := DoublePoint(x,y);
originalpoints[4] := DoublePoint(x,y);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
if DrawStyle = mydsNormal then
begin
TempPic := TPicture.Create;
PictureName := extractFileName(afName);
if fileexists(afName) then begin
try
TempPic.LoadFromFile(afName);
try
maxv := 200000000;
res1 := (TempPic.Graphic.Width) * (TempPic.Graphic.Height) * 32 div 8;
Picture.PixelFormat := pf24bit;
if res1 > maxv then
begin
res1 := (TempPic.Graphic.Width) * (TempPic.Graphic.Height) * 24 div 8;
if res1 > maxv then
begin
res1 := (TempPic.Graphic.Width) * (TempPic.Graphic.Height) * 16 div 8;
if res1 > maxv then
begin
Picture.PixelFormat := pf8bit;
end
else
Picture.PixelFormat := pf16bit;
end
else
Picture.PixelFormat := pf24bit;
end;
Picture.Width := TempPic.Graphic.Width;
Picture.Height := TempPic.Graphic.Height;
except
if (Picture.Width = 0) or (Picture.Height = 0) then
begin
Picture.PixelFormat := pf8bit;
Picture.Width := TempPic.Graphic.Width;
Picture.Height := TempPic.Graphic.Height;
end;
end;
Picture.Canvas.Draw(0,0,TempPic.Graphic);
//Picture.PixelFormat := pf24bit;
bmpres := GetBmpDpi(afName);
except
on EInvalidGraphic do
begin
AddExceptionToLog('TBMPObject.create');
// ShowMessage(emInvalidPicture);
picture.width := 10;
picture.height := 10;
end;
end;
end;
if bmpres = 0 then bmpres := 180;
PicW := (Picture.width / bmpres) * 25.4 ;
if horzZero = 1 then PicW := -1* PicW;
PicH := (Picture.Height / bmpres) * 25.4 ;
if vertZero = 1 then PicH := -1* PicH;
originalpoints[2] := DoublePoint(x+PicW,y);
originalpoints[3] := DoublePoint(x+PicW,y-PicH);
originalpoints[4] := DoublePoint(x,y-PicH);
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
width := 1;
color := clBlack;
FreeAndNil(TempPic);
end;
end;
*)
class function TBmpObject.ShadowType:TShadowType;
begin
result := stRectangle;
end;
class function TBMPObject.CreateShadow(x, y: Double): TFigure;
begin
result := tbmpobject.create(x,y,'',0,dsTrace,nil);
end;
function TBMPObject.ShadowClick(ClickIndex:Integer;x, y: Double): Boolean;
begin
result := true;
end;
procedure TBMPObject.Initialize;
begin
inherited;
pointcount := 4;
ClipFigure := NIl;
ClpRgn := 0;
SelMode := 2;
if DrawStyle = mydsNormal then
begin
Picture := TBitmap.create;
VertFlipped := false;
HorzFlipped := false;
Image := TBitmap.Create;
Image.PixelFormat := pf24bit;
Modified := True;
end;
Tiled := False;
end;
constructor TBMPObject.createEx(x,y: Double; aBitmap: TBitmap;
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
var bmpres: Integer;
picW,picH : Double;
begin
inherited create(LHandle, aDrawStyle,aOwner);
bmpres := 180;
originalpoints[1] := DoublePoint(x,y);
originalpoints[1] := DoublePoint(x,y);
originalpoints[2] := DoublePoint(x,y);
originalpoints[3] := DoublePoint(x,y);
originalpoints[4] := DoublePoint(x,y);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
SelMode := 2;
pointcount := 4;
if DrawStyle = mydsNormal then
begin
PictureName := '';
Picture := TBitmap.create;
Picture.Assign(aBitmap);
Picture.PixelFormat := pf24bit;
PicW := (Picture.width / bmpres) * 25.4 ;
if horzZero = 1 then PicW := -1* PicW;
PicH := (Picture.Height / bmpres) * 25.4 ;
if vertZero = 1 then PicH := -1* PicH;
originalpoints[2] := DoublePoint(x+PicW,y);
originalpoints[3] := DoublePoint(x+PicW,y-PicH);
originalpoints[4] := DoublePoint(x,y-PicH);
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
width := 1;
color := clBlack;
VertFlipped := false;
HorzFlipped := false;
Image := TBitmap.Create;
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
end;
end;
function TBMPObject.Edit: Boolean;
begin
result := false;
end;
function TBMPObject.CreateModification: TFigure;
var res: TFigure;
r: TDoubleRect;
figMaxX, figMaxY, figMinX,figMinY: Double;
begin
if (assigned(ClipFigure)) and (Selmode <> 0) then
begin
res := TBMPObject.create(0,0,'',0,dsTrace,nil);
r := GetBoundRect;
res.actualpoints[1] := DoublePoint(r.left,r.top);
res.actualpoints[2] := DoublePoint(r.right,r.top);
res.actualpoints[3] := DoublePoint(r.right,r.bottom);
res.actualpoints[4] := DoublePoint(r.left,r.bottom);
end
else
begin
Res := inherited CreateModification;
end;
res.RotPoint := RotPoint;
CreateModification := res;
end;
function TBMPObject.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y:Double;Shift: TShiftState): boolean;
var a: integer;
p1: TDoublePoint;
distx,disty: Double;
GRect: TDoubleRect;
begin
if (assigned (clipfigure)) and (selmode <> 0) then
begin
GRect := mp.Figure.GetBoundRect;
distx := 0; distY := 0;
If mp.SeqNbr in [3,4,5] then
begin
distX := x - GRect.Right;
p1.x := GRect.Left;
end
else if mp.SeqNbr in [1,8,7] then
begin
distX := GRect.Left-x;
p1.x := GRect.Right;
end;
If mp.SeqNbr in [1,2,3] then
begin
distY := y - GRect.Top;
p1.y := GRect.Bottom;
end
else if mp.SeqNbr in [5,6,7] then
begin
distY := GRect.Bottom - y;
p1.y := GRect.Top;
end;
if (distX <> 0) and (distY <> 0) then
scale( 1+distx/(GRect.Right-Grect.Left),
1+disty/(GRect.Top-Grect.Bottom),p1)
else if distX = 0 then
scale( 1,1+disty/(GRect.Top-Grect.Bottom),p1)
else if distY = 0 then
scale( 1+distx/(GRect.Right-Grect.Left),1,p1);
end
else
begin
inherited EndModification(CadControl,mp,TraceFigure,x,y,Shift);
end;
ResetRegion;
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
if assigned(onModified) then OnModified(Self);
end;
class function TBMPObject.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
OPD : TOpenPictureDialog;
x,y: Double;
ext: string;
begin
result := nil;
cad := TPCDrawing(aOwner);
x := shadow.ap1.x;
y := shadow.ap1.y;
OPD := TOpenPictureDialog.Create(nil);
if Cad.DefaultPictureFolder <> '' then
Opd.InitialDir := Cad.DefaultPictureFolder;
OPD.Filter := GraphicFilter(TGraphic);
if OPD.Execute then
begin
ext := UpperCase(extractfileext(OPD.FileName));
if (ext = '.WMF') or (ext = '.EMF') then
result := TWMFObject.create(x,y,OPD.fileName,Lhandle,mydsNormal,aOwner)
else
result := TBMPObject.create(x,y,OPD.fileName,LHandle,mydsNormal,aOwner);
result.DiagonalScale := true;
end;
//ImageEdited := True; // Tolik 20/04/2018 --
end;
function TBMPObject.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure: TFigure;
x,y: Double;Shift: TShiftState): boolean;
begin
if assigned(ClipFigure) and (selmode <> 0) then
begin
result := TraceModificationClipped(CadControl,mp,TraceFigure,x,y,shift);
exit;
end else begin
result := inherited TraceModification(CadControl,mp,TraceFigure,
x,y,Shift);
end;
end;
function TBmpObject.TraceModificationClipped(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x,y: Double;Shift: TShiftState): boolean;
var GRect: TDoubleRect;
begin
GRect := GetBoundRect;
If MP.SeqNbr in [3,4,5] then
begin
TraceFigure.ActualPoints[2] := DoublePoint(x,TraceFigure.ActualPoints[2].y);
TraceFigure.ActualPoints[3] := DoublePoint(x,TraceFigure.ActualPoints[3].y);
end
else if MP.SeqNbr in [1,8,7] then
begin
TraceFigure.ActualPoints[1] := DoublePoint(x,TraceFigure.ActualPoints[1].y);
TraceFigure.ActualPoints[4] := DoublePoint(x,TraceFigure.ActualPoints[4].y);
end;
If mp.SeqNbr in [1,2,3] then
begin
TraceFigure.ActualPoints[1] := DoublePoint(TraceFigure.ActualPoints[1].x,y);
TraceFigure.ActualPoints[2] := DoublePoint(TraceFigure.ActualPoints[2].x,y);
end
else if mp.SeqNbr in [5,6,7] then
begin
TraceFigure.ActualPoints[3] := DoublePoint(TraceFigure.ActualPoints[3].x,y);
TraceFigure.ActualPoints[4] := DoublePoint(TraceFigure.ActualPoints[4].x,y);
end;
end;
procedure TBMPObject.WriteToStream(Stream: TStream);
var
xByte,xCode,xZero: Byte;
xInt,xSize: Integer;
xStr: String;
xStream: TMemoryStream;
Jpeg: TJPEGImage;
(*
function TPCDrawing.PrepareBitmap(aPdfSave: Boolean = False): TBitmap;
var
Form: TForm;
res1: double;
maxv: double;
BadSize: boolean;
PictW, PictH, PictureSize, PicturePixelSize: Int64;
LoopDelta: Double;
i: Integer;
begin
prDpm := DotsPerMilOrig;
Form := GetForm;
if Form <> nil then
prDpm := Form.PixelsPerInch / 25.4;
if GExportUSeScale then
begin
prDpm := prDpm * self.ZoomScale / 100;
end;
OFFMMX := 0;
OFFMMY := 0;
TileX := 0;
TileY := 0;
Result := TBitmap.Create;
try
maxv := 200000000;
PictW := Round((WorkWidth) * prDpm);
PictH := Round((WorkHeight) * prDpm);
// Tolik 14/08/2019 -- òóò âûñòàâëÿåì ôîðìàò êàðòèíêè 24 áèòà æåëåçíî, ò.ê., íàïðèìåð ÏÄÔ ïîääåðæèâàåò ÒÎËÜÊÎ 24 áèòà!!!
// ÷òîáû íå ñëó÷èëîñü áÿêè, áóäåì ïîäãîíÿòü ðàçìåð èçîáðàæåíèÿ, åñëè ïîòðåáóåòñÿ
if aPdfSave then // åñëè PDF
begin
Result.PixelFormat := pf24bit;
PictureSize := PictW * PictH;
//PictureSize := PictureSize * 24;
PicturePixelSize := PictureSize * 3; // 24 áèò - 3 áàéòà
BadSize := True;
if PicturePixelSize < maxv then
BadSize := False;
if BadSize then
begin
i := 0;
LoopDelta := SimpleRoundTo(prDpm/10);
end;
while BadSize do
begin
inc(i);
prDpm := prDpm - LoopDelta;
PictW := Round((WorkWidth) * prDpm);
PictH := Round((WorkHeight) * prDpm);
PictureSize := PictW * PictH;
PicturePixelSize := PictureSize * 3;
if PicturePixelSize < maxv then
break;
if i = 9 then
LoopDelta := SimpleRoundTo(LoopDelta/10);
if i = 18 then // åñëè íå ñìîæåì ïîëó÷èòü ïðèåìëåìîå çíà÷åíèå -- ïðèâåäåì êàðòèíêó ïðèìåðíî ê 120 ÌÁ (íà âñÿêèé, ìîæíî áû è áîëüøå, íî õç...)
begin
PictW := Round(40000000/WorkHeight);
PIctH := Round(40000000/PictW);
break;
end;
end;
end
else
begin
Result.PixelFormat := pf32bit;
PictureSize := PictW * PictH;
PicturePixelSize := PictureSize * 4; // 32 - bit
if PicturePixelSize > maxv then
begin
PicturePixelSize := PictureSize * 3; //24 div 8;
if PicturePixelSize > maxv then
begin
PicturePixelSize := PictureSize * 2; //16 div 8;
if PicturePixelSize > maxv then
begin
Result.PixelFormat := pf8bit;
end
else
Result.PixelFormat := pf16bit;
end
else
Result.PixelFormat := pf24bit;
end;
end;
Result.Width := PictW;
Result.Height := PictH;
SetEngine(Result.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
except
if (Result.Width = 0) or (Result.Height = 0) then
begin
try
Result.PixelFormat := pf8bit;
Result.Width := Round((WorkWidth) * prDpm);
Result.Height := round((WorkHeight) * prDpm);
SetEngine(Result.canvas,prConvertXY,prDeConvertXY,prConvertDim,prDeConvertDim,false,nil);
except
end;
end;
end;
end;
*)
begin
inherited;
xZero := 0;
xStr := PictureName;WriteStrField(180,Stream,xStr);
xByte := 1;
if VertFlipped then
WriteField(90,Stream,xByte,1)
else
WriteField(90,Stream,xZero,1);
if HorzFlipped then
WriteField(91,Stream,xByte,1)
else WriteField(91,Stream,xZero,1);
if Transparent then
WriteField(92,Stream,xByte,1)
else WriteField(92,Stream,xZero,1);
if Skewed then
WriteField(93,Stream,xByte,1)
else
WriteField(93,Stream,xZero,1);
if Tiled then
WriteField(94,Stream,xByte,1)
else
WriteField(94,Stream,xZero,1);
xStream := TMemoryStream.Create;
Jpeg := TJPEGImage.Create;
Jpeg.Assign(Picture);
Jpeg.SaveToStream(xStream);
FreeAndNil(Jpeg);
xSize := xStream.Size;
WriteStreamField(150,Stream,xStream);
xStream.Free;
if assigned(ClipFigure) then
begin
xStream := TMemoryStream.Create;
ClipFigure.WriteToStream(xStream);
xSize := xStream.Size;
xStream.Seek(0,soFromBeginning);
xCode := 151;Stream.Write(xCode,1);
Stream.Write(xSize,4);
StreamToStream(xStream,Stream,xSize);
xStream.Free;
end;
end;
Procedure TBmpObject.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var
mstr:TMemoryStream;
TempPic: TJpegImage;
//TempPic: TBitmap;
res1: double;
maxv: double;
begin
Case xcode of
90: VertFlipped := (pByte(data)^ = 1);
91: HorzFlipped := (pByte(data)^ = 1);
92: Transparent := (pByte(data)^ = 1);
93: Skewed := (pByte(data)^ = 1);
94: Tiled := (pByte(data)^ = 1);
150: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
TempPic := TJpegImage.create;
//TempPic := TBitmap.Create;
try
tempPic.LoadFromStream(mStr);
try
maxv := 200000000;
res1 := (TempPic.Width) * (TempPic.Height) * 32 div 8;
Picture.PixelFormat := pf24bit;
if res1 > maxv then
begin
res1 := (TempPic.Width) * (TempPic.Height) * 24 div 8;
if res1 > maxv then
begin
res1 := (TempPic.Width) * (TempPic.Height) * 16 div 8;
if res1 > maxv then
begin
Picture.PixelFormat := pf8bit;
end
else
Picture.PixelFormat := pf16bit;
end
else
Picture.PixelFormat := pf24bit;
end;
Picture.Width := TempPic.Width;
Picture.Height := TempPic.Height;
except
if (Picture.Width = 0) or (Picture.Height = 0) then
begin
Picture.PixelFormat := pf8bit;
Picture.Width := TempPic.Width;
Picture.Height := TempPic.Height;
end;
end;
Picture.Canvas.Draw(0, 0, TempPic);
//Picture.PixelFormat := pf24bit;
except
mStr.Position := 0;
try
Picture.LoadFromStream(mStr);
except
on E: Exception do AddExceptionToLogExt(ClassName, 'SetPropertyFromStream', E.Message);
end;
end;
FreeAndNil(TempPic);
FreeAndNil(mStr);
end;
151: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
ClipFigure := TFigure.CreateFromStream(mStr,LayerHandle,DrawStyle,Owner);
mStr.Free;
end;
180: Picturename := String(pchar(data));
end;
end;
Procedure TBMPObject.FlipHorz;
Begin
with Picture do
begin
Picture.Transparent := False;
Canvas.StretchDraw (Rect(Width-1,0,-1,Height),Picture);
HorzFlipped := not HorzFlipped;
end;
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
End;
Procedure TBMPObject.FlipVert;
Begin
with Picture do
begin
Picture.Transparent := False;
Canvas.StretchDraw (Rect(0,Height-1,Width,-1),Picture);
VertFlipped := not VertFlipped;
end;
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
End;
Procedure TBMPObject.mirror(Point1,Point2: TDoublePoint);
var Teta: Double;
BufP : TDoublePoint;
Begin
inherited mirror(Point1,Point2);
try
Teta := arctan(abs(point1.y - point2.y)/abs(point1.x-point2.x));
except
Teta := pi/2;
end;
if Teta > pi/4 then
begin
FlipHorz;
BufP := actualPoints[2];
actualPoints[2] := actualPoints[1];
actualPoints[1] := bufP;
BufP := originalPoints[2];
originalPoints[2] := originalPoints[1];
originalPoints[1] := bufP;
BufP := actualPoints[3];
actualPoints[3] := actualPoints[4];
actualPoints[4] := bufP;
BufP := originalPoints[3];
originalPoints[3] := originalPoints[4];
originalPoints[4] := bufP;
end
else FlipVert;
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
End;
procedure TBMPObject.setTrans(value: Boolean);
begin
fTrans := value;
modified := true;
ImageEdited := True; // Tolik 20/04/2018 --
end;
procedure TBMPObject.Select;
begin
inherited select;
if assigned(ClipFigure) then Clipfigure.Select;
end;
procedure TBMPObject.DeSelect;
begin
inherited deselect;
if assigned(ClipFigure) then Clipfigure.deSelect;
end;
procedure TBMPObject.drawselectionpoints(DEngine: TPCDrawEngine;
isGrayed: Boolean);
begin
if selmode = 0 then
inherited
else if selmode = 1 then
begin
if assigned(ClipFigure) then
begin
ClipFigure.drawselectionpoints(DEngine,isGrayed);
end
else begin
inherited;
end;
end else begin
inherited;
end;
end;
procedure TBMPObject.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
Layer: TLayer;
acolor : Tcolor;
points : Array [0..3] of Tpoint;
aDpm :Double;
s: integer;
aStyle: integer;
begin
aColor := color;
if (aColor = -255) and (LayerHandle <> 0) then
begin
aColor := TLayer(LayerHandle).PenColor;
end;
//Tolik 20/10/2021 --
{
if (isGrayed) then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if (isGrayed) or (drawStyle = dsTrace) then
begin
s := 0;
if (drawStyle = dsTrace) then
begin
acolor := clLime;
s := 1;
end;
DEngine.DrawLine(ap1.x,ap1.y,ap2.x,ap2.y,acolor,1,s,0);
DEngine.DrawLine(ap2.x,ap2.y,ap3.x,ap3.y,acolor,1,s,0);
DEngine.DrawLine(ap3.x,ap3.y,ap4.x,ap4.y,acolor,1,s,0);
DEngine.DrawLine(ap4.x,ap4.y,ap1.x,ap1.y,acolor,1,s,0);
if drawSTyle = mydsNormal then
begin
DEngine.DrawLine(ap1.x,ap1.y,ap3.x,ap3.y,acolor,1,s,0);
DEngine.DrawLine(ap2.x,ap2.y,ap4.x,ap4.y,acolor,1,s,0);
end;
end
else
}
begin
adpm := 1;
Dengine.ConvertLen(aDpm);
if aDpm <> dpm then
begin
modified := true;
dpm := aDpm;
end;
if assigned(ClipFigure) then
begin
ClipFigure.brs := ord(bsSolid);
Clipfigure.ResetRegion;
ClipFigure.color := aColor;
ClipFigure.Width := width;
ClipFigure.Style := style;
ClipFigure.brc := brc;
ClipFigure.draw(DEngine,isGrayed);
clprgn := ClipFigure.RegHandle;
Dengine.Clip(clpRgn);
end;
if assigned(clipFigure) then
aStyle := ord(psClear)
else
aStyle := Style;
// Tolik -- 20/04/2018 --
{DEngine.DrawPicture(ap1,ap2,ap3,ap4,acolor,width,astyle,
Transparent,Modified,picture,Image,true,Skewed,RegHandle,Tiled ); }
//Tolik 20/10/2021 --
{DEngine.DrawPicture(ap1, ap2, ap3, ap4, acolor, width, astyle,
Transparent, Modified, picture, Image, ImageEdited, true, Skewed, RegHandle, Tiled);}
isGrayed := TLayer(LayerHandle).visible = grayed;
if isGrayed then
begin
ImageEdited := True;
DEngine.DrawPicture(ap1, ap2, ap3, ap4, acolor, width, astyle,
Transparent, Modified, picture, Image, ImageEdited, true, Skewed, RegHandle, Tiled, TPowerCad(owner).FGrayedColor)
end
else
DEngine.DrawPicture(ap1, ap2, ap3, ap4, acolor, width, astyle,
Transparent, Modified, picture, Image, ImageEdited, true, Skewed, RegHandle, Tiled);
//
if assigned(ClipFigure) then
begin
Dengine.Clip(0);
end;
end;
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TBMPObject.getModPoints(ModList: TMyList);
var
Layer: TLayer;
MT,MR,MB,ML : TDoublePoint;
CControl: TPCDrawing;
figMaxX,figMaxY,figMinX,figMinY: Double;
acolor: integer;
p1,p2,p3,p4: TDoublePoint;
isPolyline: Boolean;
begin
CControl := TPCDrawing(Owner);
if assigned(ClipFigure) and (SelMode = 2) then
begin
ClipFigure.getbounds(figMaxX,figMaxY,figMinX,figMinY);
p1 := DoublePoint(figMinX,figMinY);
p2 := DoublePoint(figMaxX,figMinY);
p3 := DoublePoint(figMaxX,figMaxY);
p4 := DoublePoint(figMinX,figMaxY);
end else
begin
p1 := ap1;p2:= ap2;p3 := ap3;p4 := ap4;
end;
isPolyline := Skewed;
if assigned(ClipFigure) and (SelMode <> 0) then isPolyline := False;
if not isPolyline then begin
MT := MPoint(p1,p2);
MR := MPoint(p2,p3);
MB := MPoint(p3,p4);
ML := MPoint(p4,p1);
if SelMode = 2 then acolor := clRed else acolor := clBlue;
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,p1.x,p1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,MT.x,MT.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,p2.x,p2.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,MR.x,MR.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,p3.x,p3.y,5));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,MB.x,MB.y,6));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,p4.x,p4.y,7));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,aColor,PointDim,ML.x,ML.y,8));
end else begin
acolor := clBlue;
ModList.Add(CControl.RegisterModPoint(self,ptPolyPoint,ptCircle,aColor,PointDim,p1.x,p1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptPolyPoint,ptCircle,aColor,PointDim,p2.x,p2.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptPolyPoint,ptCircle,aColor,PointDim,p3.x,p3.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptPolyPoint,ptCircle,aColor,PointDim,p4.x,p4.y,4));
end;
end;
procedure TBMPObject.getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);
var a : integer;
begin
if assigned(clipfigure) and (selmode <> 0) then begin
ClipFigure.GetBounds(figMaxX,figMaxY,figMinX,figMinY);
exit;
end;
figMaxX := ap1.x;
figMinX := ap1.x;
figMaxY := ap1.y;
figMinY := ap1.y;
For a := 1 to 4 do
begin
if actualpoints[a].x > figMaxX then figMaxX := actualpoints[a].x;
if actualpoints[a].x < figMinX then figMinX := actualpoints[a].x;
if actualpoints[a].y > figMaxY then figMaxY := actualpoints[a].y;
if actualpoints[a].y < figMinY then figMinY := actualpoints[a].y;
end;
end;
function TBMPObject.isPointIn(x,y:Double): boolean;
begin
result := false;
result := inherited isPointIn(x,y);
if (not result) and (assigned(ClipFigure)) and (selmode <> 0) then
begin
ClipFigure.RegHandle := clpRgn;
result := ClipFigure.isPointIn(x,y)
end
else if (not result) then
begin
result := IsPointInRegion(x,y);
//Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
end;
function TBMPObject.duplicate:TFigure;
var res : TBMPObject;
begin
res := TBMPObject.create( originalpoints[1].x,
originalpoints[1].y,
PictureName,
LayerHandle,DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.originalpoints[1] := originalpoints[1];
res.actualpoints[2] := actualpoints[2];
res.originalpoints[2] := originalpoints[2];
res.actualpoints[3] := actualpoints[3];
res.originalpoints[3] := originalpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[4] := originalpoints[4];
res.Picture.Assign(Picture);
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.HorzFlipped := HorzFlipped;
res.VertFlipped := VertFlipped;
res.transparent := transparent;
if assigned(ClipFigure) then begin
res.ClipFigure := ClipFigure.duplicate;
end;
res.AngleToPoint := AngleToPoint;
result := res;
end;
Procedure TBMPObject.rotate(aAngle:Double; cPoint: TDoublePoint);
begin
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
if not assigned(clipfigure) then begin
inherited;
exit;
end;
if selmode = 0 then inherited
else if selmode = 1 then ClipFigure.rotate(aAngle,cPoint)
else begin
inherited;
ClipFigure.rotate(aAngle,cPoint);
end;
end;
procedure TBMPObject.SkewShape;
begin
Skewed := True;
Modified := true;
end;
procedure TBMPObject.scale(percentx,percenty: double; rPoint: TDoublepoint);
begin
Modified := True;
if not assigned(clipfigure) then begin
inherited;
exit;
end;
if selmode = 0 then inherited
else if selmode = 1 then ClipFigure.scale(percentx,percenty,rPoint)
else begin
inherited;
ClipFigure.scale(percentx,percenty,rPoint);
end;
end;
Procedure TBMPObject.move(deltax,deltay:Double);
begin
if not assigned(clipfigure) then begin
inherited;
exit;
end;
if selmode = 0 then inherited
else if selmode = 1 then ClipFigure.Move(deltax,deltay)
else begin
inherited;
ClipFigure.Move(deltax,deltay)
end;
end;
destructor TBMPObject.Destroy;
begin
Picture.Dormant;
Picture.FreeImage;
Picture.Free;
Image.FreeImage;
image.free;
if Assigned(ClipFigure) then
FreeAndNil(ClipFigure);
inherited;
end;
procedure TBmpObject.MenuClicked(commandID:integer);
var mnIdx: integer;
begin
mnIdx := commandId-MenuIndex;
case mnIdx of
0: Transparent := not Transparent;
1: FlipVert;
2: FlipHorz;
3: SkewShape;
4: SelMode := 0;
5: SelMode := 1;
6: SelMode := 2;
else begin
if assigned(ClipFigure) then ClipFigure.MenuClicked(commandId);
end;
end;
end;
procedure TBMPObject.UpdateMenu(var PopMenu: TPopUpMenu; var sIndex: Integer);
var mnItem,mnSub: TMenuItem;
pre : Boolean;
begin
menuIndex := sIndex;
pre:= false;
if (not assigned(ClipFigure)) or (SelMode = 0) then
begin
pre := true;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmTransparent;
if (Transparent) then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+1;
mnItem.Caption := fmFlipVert;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+2;
mnItem.Caption := fmFlipHorz;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+3;
mnItem.Caption := fmSkewBitmap;
PopMenu.Items.Add(mnItem);
end;
if assigned(ClipFigure) then
begin
if pre then begin
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := -1;
mnItem.Caption := '-';
PopMenu.Items.Add(mnItem);
end;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+4;
mnItem.Caption := fmSelectBitmap;
if (selmode = 0) then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+5;
mnItem.Caption := fmSelectClipfigure;
if (selmode = 1) then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmSelectGroup;
mnItem.Tag := sIndex+6;
if (selmode = 2) then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
if selmode = 1 then begin
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := -1;
mnItem.Caption := '-';
PopMenu.Items.Add(mnItem);
ClipFigure.UpdateMenu(PopMenu,sIndex);
end;
sIndex := SIndex+7;
end else
sIndex := SIndex+4;
end;
(* ========================================================================== *)
// TText IMPLEMENTATION //
(* ========================================================================== *)
constructor TText.create( aX1,aY1,h,w: double;atext: string; FontName:String;
FontCharset: Byte; aColor:Integer;
LHandle:LongInt; aDrawStyle: TDrawStyle;aOwner: TComponent);
var
p1 : TDoublePoint;
TM : TTextMetric;
FCanvas: TCanvas;
FontRecord : TLogFont;
xHeight,xWidth: Double;
vl,hl:DOuble;
xlen: Double;
r: real;
//TextHeight: Double;
mCanvas: TMetafileCanvas;
ww,hh: Double;
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
BoxWidth := -1; // Tolik 18/10/2019 --
Color := aColor;
Text := aText;
Font.Charset := FontCharset;
Font.Name := FontName;
Font.Color := aColor;
Height := h;
CWidth := w;
Modified := true;
originalpoints[1] := DoublePoint(ax1,ay1);
actualpoints[1]:= DoublePoint(ax1,ay1);
if owner <> nil then
begin
TPCDrawing(Owner).DEngine.GetTextLens(TextLength,TextHeight,Text,Font,Height,CWidth,CSpace);
(*
Fcanvas := TPCDrawing(Owner).DEngine.canvas;
xHeight := Height*4;
FCanvas.Font.Height := Round(xHeight);
if CWidth <> 0 then begin
xWidth := CWidth*4;
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
FontRecord.lfWidth := Round(xWidth);
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
end;
TextLength := Fcanvas.TextWidth(text);
TextHeight := Fcanvas.TextHeight(text);
TextLength := (TextLength/4);
TextHeight := (TextHeight/4);
*)
if HorzZero = 1 then
hl := -1
else
hl := 1;
if VertZero = 1 then
vl := -1
else
vl := 1;
end;
originalpoints[2] := Doublepoint( originalpoints[1].x + hl*TextLength, originalpoints[1].y);
actualpoints[2] := Doublepoint( originalpoints[1].x + hl*TextLength, originalpoints[1].y);
originalpoints[3] := Doublepoint( originalpoints[1].x + hl*TextLength , originalpoints[1].y - vl*TextHeight);
actualpoints[3] := Doublepoint( originalpoints[1].x + hl*TextLength , originalpoints[1].y - vl*TextHeight);
originalpoints[4] := Doublepoint( originalpoints[1].x , originalpoints[1].y - vl*TextHeight);
actualpoints[4] := Doublepoint( originalpoints[1].x , originalpoints[1].y - vl*TextHeight);
end;
class function TText.ShadowType:TShadowType;
begin
result := stRectangle;
end;
class function TText.CreateShadow(x, y: Double): TFigure;
begin
result := TText.Create(x,y,1,1,'','',0,0,0,dsTrace,nil);
end;
Function TText.ShadowClick(ClickIndex:Integer;x,y: Double):Boolean;
begin
result := true;
end;
procedure TText.Initialize;
begin
inherited;
Font := TFont.Create;
pointcount := 4;
Angle := 0;
CSpace := 0;
fKeepA := false;
OutLined := False;
end;
function TText.Edit: Boolean;
var
EnterStr: string;
begin
Result := False;
EnterStr := Text;
// if InputQuery(csTextTool, msEnterNewText, EnterStr) then
if InputQuery(cDrawObjects_Mes6, cDrawObjects_Mes5, EnterStr) then
begin
Text := EnterStr;
Modified := True;
result := true;
end;
end;
class function TText.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var
EnterStr: string;
cad: TPCDrawing;
begin
cad := TPCDrawing (aOwner);
// if InputQuery(csTextTool, msEnterNewText, EnterStr) then
if InputQuery(cDrawObjects_Mes6, cDrawObjects_Mes5, EnterStr) then
begin
result := TText.Create(shadow.ap1.x, shadow.ap1.y,
cad.DefaultTextHeight, 0,
enterstr, cad.Font.name,
cad.font.charset, Cad.Font.Color, LHandle, mydsNormal, aOwner);
TText(result).Font.Style := Cad.Font.Style;
end
else
result := nil;
end;
procedure TText.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
xStr := Text;
WriteStrField(180,Stream,xStr);
xStr := Font.Name;WriteStrField(181,Stream,xStr);
xInt := Color;
WriteField(21,Stream,xInt,4);
xInt := brc;
WriteField(22,Stream,xInt,4);
xDbl := Height; WriteField(221,Stream,xDbl,8);
xDbl := CSpace; WriteField(222,Stream,xDbl,8);
xDbl := Cwidth; WriteField(223,Stream,xDbl,8);
xDbl := Angle; WriteField(224,Stream,xDbl,8);
xByte := 1;
if fsBold in Font.Style then
WriteField(90,Stream,xByte,1);
if fsItalic in Font.Style then
WriteField(91,Stream,xByte,1);
if fsStrikeout in Font.Style then
WriteField(92,Stream,xByte,1);
if fsUnderLine in Font.Style then
WriteField(93,Stream,xByte,1);
if Outlined then
WriteField(94,Stream,xByte,1);
// Tolik 22/11/2019 --
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := brs;
//
WriteField(95,Stream,xByte,1);
end;
Procedure TText.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var Ratio: Double;
begin
Case xcode of
20: Height := pInt(data)^/10;
21: Color := pInt(data)^;
22: brc := pInt(data)^;
90: font.Style := font.Style + [fsBold];
91: font.Style := font.Style + [fsItalic];
92: font.Style := font.Style + [fsStrikeout];
93: font.Style := font.Style + [fsUnderLine];
94: Outlined := True;
// Tolik 22/11/2019 --
//95: brs := pByte(data)^;
95:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
//
//Tolik 26/03/2019 --
//180: Text := string(pAnsiChar(data));
//181: font.name := string(AnsiChar(data));
180: Text := string(pchar(data));
181: font.name := string(pchar(data));
//
220: begin
Ratio := pDouble(data)^;
if ratio < 0 then CWidth := -ratio else CWidth := Height*Ratio;
end;
221: Height := pDouble(data)^;
222: CSpace := pDouble(data)^;
223: CWidth := pDouble(data)^;
224: Angle := pDouble(data)^;
end;
end;
procedure TText.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
Layer: TLayer;
acolor : TColor;
a : integer;
TestX,TestY1,TestY2,z: Double;
TopY : boolean;
lMult: integer;
points: TDoublePointArr;
xlen: Double;
nLen,nH: Integer;
p: TDoublePointArr;
fCanvas: TMetafileCanvas;
ol:Boolean;
begin
ol := outlined and not Incombined;
aColor := color;
if (aColor = -255) and (LayerHandle <> 0) then
begin
aColor := TLayer(LayerHandle).TextColor;
end;
if (isGrayed) then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
font.Color := acolor;
DEngine.canvas.Pen.color := clBlack;
//if screen.Fonts.IndexOf(Font.Name) = -1 then Font.Name := 'Arial';
TestX := 0;
TestY1:= 100;
TestY2 := 200;
z := 0;
DEngine.ConvertPoint(TestX,TestY1,Z);
DEngine.ConvertPoint(TestX,TestY2,Z);
if TestY2 > TestY1 then
topY := true
else
topY := false;
nh := 0;
nlen := 0;
if TopY then
lMult := 1
else
lMult := -1;
if DrawStyle = dsTrace then
begin
DEngine.Canvas.Pen.Mode := pmXor;
GetPointArray(points);
DEngine.drawpolygon(points,clLime,1,1,0,0,RegHandle);
end
else
begin
DEngine.Canvas.Pen.Mode := pmCopy;
if ol then
BeginPath(DEngine.Canvas.Handle);
if fKeepA then
begin
DEngine.drawtext(ap1,ap2,ap3,ap4,lMult*angle,text,font,height,0,cSpace,nH,nLen);
fKeepA := False;
end
else
DEngine.drawtext(ap1,ap2,ap3,ap4,lMult*angle,text,font,height,CWidth,cSpace,nH,nLen);
TextHeight := nH;
TextLength := nLen;
if ol then
begin
EndPath(DEngine.Canvas.Handle);
DEngine.Canvas.Pen.Color := color;
DEngine.Canvas.Pen.Width := Width;
DEngine.Canvas.Pen.Style := TPenStyle(style);
DEngine.Canvas.Brush.Color := brc;
DEngine.Canvas.Brush.Style := TBrushStyle(brs);
StrokeANDFillPath(DEngine.Canvas.Handle);
end;
end;
if DrawStyle = mydsNormal then
begin
if Modified then
begin
SetRegionPoints;
if (nh <> 0) and (nLen <> 0) then
Modified := False;
end;
ResetRegion;
if Reghandle = 0 then
begin
SetLength(p,4);
p[0] := ap1;p[1] := ap2;p[2] := ap3;p[3] := ap4;
RegHandle := DEngine.PolygonRegion(p);
end;
end;
//Tolik 24/05/2019 --
SetLength(Points, 0);
SetLength(P, 0);
//
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TText.getModPoints(ModList: TMyList);
var MR : TDoublePoint;
CControl: TPCDrawing;
pt: TmodPoint;
begin
inherited;
CControl := TPCDrawing(Owner);
if Modlist.Count = 4 then begin
MR := MPoint(ap2,ap3);
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRow,clRed,PointDim,MR.x,MR.y,4));
end else begin
pt := ModList[5];
pt.DType := ptRow;
pt.Color := clRed;
end;
end;
function TText.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
var wNew,wOld,wDist: Double;
hNew,hOld,hDist: Double;
cnt: Integer;
wChar: Double;
cad: TPCDrawing;
begin
wOld := GetLineLenght(ap1,ap2);
hOld := GetLineLenght(ap2,ap3);
result := inherited endModification(CadControl,mp,TraceFigure,x,y,Shift);
cad := TPCDrawing(CadControl);
if mp.SeqNbr = 4 then begin
wNew := GetLineLenght(ap1,ap2);
wDist := wNew-wOld;
cnt := length(Text);
if Cnt < 2 then CSpace := 0 else
CSpace := CSpace+(wDist / (cnt-1));
Modified := true;
end else begin
Cad.Dengine.TextToRect(ap1,ap2,ap3,ap4,Text,Font,CSpace,CWidth,Height);
Modified := True;
end;
end;
function TText.isPointIn(x,y:Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := IsPointInRegion(x,y);
//Tolik
Result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TText.setRegionPoints;
var
figMaxX,figMaxY,figMinX,figMinY: Double;
a: integer;
hl,vl: integer;
FCanvas: TCanvas;
r,xLen: Double;
canvas: TMetaFileCanvas;
MetaFile: TMetaFile;
// Tolik 18/10/2019 --
HKoef: double;
TxtH: Double;
//
begin
if assigned(owner) then
begin
font.Size := Round(height/2 + 1);
{MetaFile:= TMetaFile.Create;
Metafile.Enhanced := True;
canvas := TMetafileCanvas.Create(Metafile, 0);
canvas.Font := font;
canvas.Font.Height := Round(height);
a := canvas.TextWidth(text);
canvas.Free;}
Fcanvas := TPCDrawing(Owner).DEngine.canvas;
if HorzZero = 1 then
hl := -1
else
hl := 1;
if VertZero = 1 then
vl := -1
else
vl := 1;
if (TextLength = 0) or (TextHeight = 0) then
begin
//if Height < 1 then
//begin
// TextHeight := Height;
// TextLength := Length(Text) * Height * 0.8;
//end
//else
//begin
TextHeight := Height;
if Height < 1 then
begin
TextLength := Length(Text) * Height * 0.8;
font.Size := Round(height/2 + 1);
end
else
begin
MetaFile:= TMetaFile.Create;
Metafile.Enhanced := True;
canvas := TMetafileCanvas.Create(Metafile, 0);
//TxtH := Height/2;
//HKoef := 0;
{if TxtH < 1 then
begin
HKoef := 100;
TxtH := TxtH*100;
end;}
canvas.Font := font;
//canvas.Font.Height := Round(TxtH + 1);
canvas.Font.Height := Round(height);
TextLength := canvas.TextWidth(text);
{if HKoef <> 0 then
TextLength := (TextLength / HKoef) * 1.4;}
canvas.Free;
Metafile.free;
end;
end
else
if assigned(TPCDrawing(Owner).DEngine.ConvertLen) then
begin
xlen := 100;
TPCDrawing(Owner).DEngine.ConvertLen(xLen);
r := xlen / 100;
TextLength := (TextLength / r);
TextHeight := (TextHeight / r)
end;
figMaxX := ap1.x + hl*TextLength;
figMaxY := ap1.y;
figMinX := ap1.x;
figMinY := ap1.y - vl*TextHeight ;
actualpoints[1] := Doublepoint(FigMinX,FigMaxY);
actualpoints[2] := RotatePoint(ap1,DoublePoint(FigMaxX,FigMaxY),Angle);
actualpoints[3] := RotatePoint(ap1,DoublePoint(FigMaxX,FigMinY),Angle);
actualpoints[4] := RotatePoint(ap1,DoublePoint(FigMinX,FigMinY),Angle);
for a := 1 to 4 do
originalpoints[a] := actualpoints[a];
RotPoint := (DoublePoint(-1000,-1000));
end;
end;
procedure TText.getbounds(var figMaxX,figMaxY,figMinX,figMinY: Double);
var a : integer;
begin
figMaxX := actualpoints[1].x ;
figMaxY := actualpoints[1].y ;
figMinX := actualpoints[1].x ;
figMinY := actualpoints[1].y ;
for a := 1 to 4 do
begin
if actualpoints[a].x > FigMaxX then FigMaxX := actualpoints[a].x;
if actualpoints[a].x < FigMinX then FigMinX := actualpoints[a].x;
if actualpoints[a].y > FigMaxY then FigMaxy := actualpoints[a].y;
if actualpoints[a].y < FigMiny then FigMinY := actualpoints[a].y;
end;
end;
function TText.duplicate:TFigure;
var res : TText;
begin
res := TText.create( originalpoints[1].x,
originalpoints[1].y,
height,
CWidth,
text,
Font.Name,
Font.Charset,
Font.Color,
LayerHandle,
DrawStyle,Owner);
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.originalpoints[2] := originalpoints[2];
res.actualpoints[3] := actualpoints[3];
res.originalpoints[3] := originalpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[4] := originalpoints[4];
res.angle := angle;
res.Height := Height;
res.CSpace := CSpace;
res.Font.Style := Font.Style;
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.Color := Color;
res.AngleToPoint := AngleToPoint;
result := res;
end;
Procedure TText.rotate(aAngle: Double; cPoint: TDoublePoint);
begin
inherited rotate(aAngle,cPoint);
CalculateAngle;
end;
Procedure TText.calculateAngle;
begin
Angle := GetRadOfLine(ap1,ap2);
end;
procedure TText.scale(percentx,percenty: Double; rPoint: TDoublepoint);
var wNew: Double;
hNew: Double;
wChar: Double;
cnt: Integer;
Cad: TPCDrawing;
Scalex: double;
begin
{if BoxWidth <> -1 then
begin
BoxWidth := BoxWidth * percentx;
percentx := BoxWidth/TextLength;
BoxWidth := -1;
end;}
inherited scale(percentx,percenty,rPoint);
if assigned(owner) then begin
Cad := TPCDrawing(Owner);
Cad.Dengine.TextToRect(ap1,ap2,ap3,ap4,Text,Font,CSpace,CWidth,Height);
// Tolik 01/11/2017 --
// ýòî îñòàâëÿòü íåëüçÿ, ïîòîìó ÷òî íà îòðèñîâêå ïî ýòîìó ôëàæêó
// èçìåíÿòñÿ ãðàíèöû òåêñòà â ðàçìåð ñàìîãî òåêñòà (ïîñêîëüêó ðàçìåð øðèôòà íå ìîæåò áûòü äðîáíûì ÷èñëîì,
// ïðè ñêåéëèíãå òåêñò ìîæåò áûòü ìåíüøå ãðàíèö -- íå âïðèòûê)
// ïîòîì òåðÿåòñÿ âîçìîæíîñòü îòñêåéëèòü â îáðàòíóþ ñòîðîíó, ò.ê. ðåàëüíûå ãðàíèöû òåêñòà áóäóò óòåðÿíû !!!
//Modified := True;
//
end;
end;
Function TText.ModifyTextAndFont(mm: TModifyMode; valueI:Double;
valueS: string; valueSt: TFontStyles;ValueB:Boolean):Boolean;
var TM : TTextMetric;
Layer: TLayer;
begin
result := true;
if mm = mmText then
begin
Text := valueS;
modified := true;
end
else if mm = mmFontName then
begin
Font.Name := valueS;
modified := true;
end
else if mm = mmFontCs then
begin
Font.Charset := Round(valueI);
modified := true;
end
else if mm = mmFontSize then
begin
Height := valueI;
modified := true;
end
else if mm = mmFontColor then
begin
Font.Color := Round(valueI);
Color := Round(valueI);
end
else if mm = mmFontStyle then
begin
Font.Style := valueSt;
modified := true;
end
else if mm = mmFontBold then
begin
if ValueB then Font.Style := Font.Style + [fsBold] else
Font.Style := Font.Style - [fsBold];
modified := true;
end
else if mm = mmFontItalic then
begin
if ValueB then Font.Style := Font.Style + [fsItalic] else
Font.Style := Font.Style - [fsItalic];
modified := true;
end
else if mm = mmFontUnderline then
begin
if ValueB then Font.Style := Font.Style + [fsUnderline] else
Font.Style := Font.Style - [fsUnderline];
modified := true;
end
else if mm = mmFontStrike then
begin
if ValueB then Font.Style := Font.Style + [fsStrikeOut] else
Font.Style := Font.Style - [fsStrikeOut];
modified := true;
end;
end;
procedure TText.ValidatePoints;
var cad: TPCDrawing;
begin
if assigned(owner) then begin
Cad := TPCDrawing(Owner);
end;
end;
Procedure TText.mirror(Point1,Point2: TDoublePoint);
var cad: TPCDrawing;
begin
//inherited mirror(Point1,Point2);
//if angle <> 0 then CalculateAngle;
//ValidatePoints;
//if assigned(owner) then begin
// Cad := TPCDrawing(Owner);
// Cad.Dengine.TextToRect(ap1,ap2,ap3,ap4,Text,Font,CSpace,CWidth,Height);
// Modified := True;
//end;
end;
Destructor TText.destroy;
begin
//deleteobject(font.handle);
Font.Free;
inherited;
end;
procedure TText.MenuClicked(CommandId: integer);
var idx: integer;
begin
idx := commandID-menuIndex;
case idx of
0: begin CWidth := 0; fKeepA := True; end;
1: CSpace := 0;
2: Outlined := not outlined;
end;
Modified := True;
end;
procedure TText.UpdateMenu(var popMenu: TPopUpMenu; var sIndex: Integer);
var mnItem,mnSub: TMenuItem;
begin
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmAspectRatio;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Tag := sIndex+1;
mnItem.Caption := fmDefaultSpacing;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Tag := sIndex+2;
mnItem.Caption :=fmOutlined;
mnItem.Checked := Outlined;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+3;
end;
///////////////////////////////////////////////////////////////////////////////
procedure TPlSegment.CopyFrom(frSeg: TPLSegment);
begin
Index := frSeg.Index;
Stype := frSeg.Stype;
CPoint1 := frSeg.CPoint1;
CPoint2 := frSeg.CPoint2;
TangentKnot := frSeg.TangentKnot;
Inverted:= frSeg.Inverted;
tp1 := frSeg.tp1;
tp2 := frSeg.tp2;
end;
{ TFigureGrp }
procedure TFigureGrp.AddFigure(fig: TFigure; AResetReg: Boolean=true);
begin
AddToGrp(fig); //28.04.2011 InFigures.Add(fig);
BoundCalc := False;
if AResetReg then //02.04.2012
ResetRegion;
// Tolik -- 27/06/2017 --
if Self.ClassName = TFigureGrpMod.ClassName then
HasAutocreatedFigures := CheckHasAutocreatedFigures(TFigure(Self));
//
end;
// Tolik 22/08/2017 --
procedure TFigureGrp.InsertFigure(fig: TFigure; AResetReg: Boolean=true);
begin
InsertFig(fig); //28.04.2011 InFigures.Add(fig);
BoundCalc := False;
if AResetReg then //02.04.2012
ResetRegion;
end;
//
procedure TFigureGrp.ClearFigureList;
begin
InFigures.Clear;
// Tolik -- 27/06/2017 --
HasAutocreatedFigures := False;
BoundCalc := False;
//
ResetRegion;
end;
constructor TFigureGrp.create(LHandle: LongInt;aOwner: TComponent);
begin
inherited create(LHandle,mydsNormal,aOwner);
initialize;
end;
procedure TFigureGrp.Initialize;
begin
inherited;
DimLocked := False;
pointcount := 4;
inFigures := TList.Create;
Changed := False;
bDeltaX := 0;
bDeltaY := 0;
FCombined := false;
Reloading := false;
LoadIdx := 0;
Ungrouped := False;
Style := ord(psSolid);
Width := 1;
Color := clBlack;
brc := clWhite;
brs := ord(bsSolid);
AlwaysTogether := False;
FMetaFile := nil;
UseMetafile := False;
BoundCalc := False;
DrawRatio := 1;
//Tolik
HasAutocreatedFigures := False;
//
end;
Procedure TFigureGrp.DestroyInFigures;
var
a: Integer;
Figure: TFigure;
begin
try
Figure := nil;
//Tolik
if Assigned(inFigures) then
if inFigures.Count > 0 then
begin
for a := 0 to inFigures.Count - 1 do begin
Figure := TFigure(inFigures[a]);
if Figure is tFigureGrp then
TFigureGrp(Figure).DestroyInFigures;
FreeAndNil(Figure);
end;
InFigures.Clear;
end;
except
//on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigureGrp.DestroyInFigures' + E.Message);
end;
// Tolik -- 27/06/2017 --
HasAutocreatedFigures := False;
BoundCalc := False;
//
end;
Destructor TFigureGrp.Destroy;
begin
DestroyInFigures;
if assigned(FMetaFile) then FMetafile.Free;
InFigures.Free;
ID := -1;
inherited;
end;
function TFigureGrp.CreateModification: TFigure;
var r: TDoubleRect;
res: TRectangle;
begin
res := TRectangle.create(0,0,0,0,1,1,clLime,0,0,0,dsTrace,nil);
r := GetBoundRect;
res.actualpoints[1] := DoublePoint(r.left,r.top);
res.actualpoints[2] := DoublePoint(r.right,r.top);
res.actualpoints[3] := DoublePoint(r.right,r.bottom);
res.actualpoints[4] := DoublePoint(r.left,r.bottom);
Res.DiagonalScale := DiagonalScale;
res.RotPoint := RotPoint;
result := res;
end;
function TFigureGrp.EndModification(CadControl: Pointer;mp: TModPoint; TraceFigure: TFigure; x,
y: double;Shift: TShiftState): boolean;
var
distx,disty: double;
GRect: TDoubleRect;
ap: TDoublepoint;
begin
ap := DoublePoint(mp.coordx,mp.coordy);
GRect := mp.Figure.GetBoundRect;
distx := 0;
distY := 0;
If mp.SeqNbr in [3,4,5] then
begin
x := TraceFigure.ap2.x;
distX := x - GRect.Right;
ap.x := GRect.Left;
end
else
if mp.SeqNbr in [1,8,7] then
begin
x := TraceFigure.ap1.x;
distX := GRect.Left-x;
ap.x := GRect.Right;
end;
If mp.SeqNbr in [1,2,3] then
begin
y := TraceFigure.ap1.y;
distY := y - GRect.Top;
ap.y := GRect.Bottom;
end
else
if mp.SeqNbr in [5,6,7] then
begin
y := TraceFigure.ap3.y;
distY := GRect.Bottom - y;
ap.y := GRect.Top;
end;
if (distX <> 0) and (distY <> 0) then
scale(1 + distx / (GRect.Right - Grect.Left),
1 + disty / (GRect.Top - Grect.Bottom), ap)
else
if distX = 0 then
scale(1, 1 + disty / (GRect.Top - Grect.Bottom), ap)
else
if distY = 0 then
scale(1 + distx / (GRect.Right - Grect.Left), 1, ap);
ResetRegion;
end;
function TFigureGrp.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x,y: double;Shift: TShiftState): boolean;
var GRect: TDoubleRect;
begin
TraceFigure.TraceModification(CadControl,mp,TraceFigure,x,y,Shift);
exit;
GRect := GetBoundRect;
If MP.SeqNbr in [3,4,5] then
begin
TraceFigure.ActualPoints[2] := DoublePoint(x,TraceFigure.ActualPoints[2].y);
TraceFigure.ActualPoints[3] := DoublePoint(x,TraceFigure.ActualPoints[3].y);
end
else if MP.SeqNbr in [1,8,7] then
begin
TraceFigure.ActualPoints[1] := DoublePoint(x,TraceFigure.ActualPoints[1].y);
TraceFigure.ActualPoints[4] := DoublePoint(x,TraceFigure.ActualPoints[4].y);
end;
If mp.SeqNbr in [1,2,3] then
begin
TraceFigure.ActualPoints[1] := DoublePoint(TraceFigure.ActualPoints[1].x,y);
TraceFigure.ActualPoints[2] := DoublePoint(TraceFigure.ActualPoints[2].x,y);
end
else if mp.SeqNbr in [5,6,7] then
begin
TraceFigure.ActualPoints[3] := DoublePoint(TraceFigure.ActualPoints[3].x,y);
TraceFigure.ActualPoints[4] := DoublePoint(TraceFigure.ActualPoints[4].x,y);
end;
end;
procedure TFigureGrp.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
a: integer;
Figure: TFigure;
Layer: Tlayer;
isDraw:Boolean;
f: Tfigure;
dx,dy,dz: DOuble;
var figMaxX, figMaxY, figMinX,figMinY,cx,cy: double;
xbrs: Integer;
xRgn: HRGN;
begin
//31.10.2011 GetBounds(figMaxX, figMaxY, figMinX, figMinY);
if DrawRatio <> 1 then
begin
GetBounds(figMaxX, figMaxY, figMinX, figMinY); //31.10.2011
cx := (figMaxX + figMinX) / 2;
cy := (figMaxY + figMinY) / 2;
cx := cx / 2;
cy := cy / 2;
Dengine.ConvertDim(cx);
Dengine.ConvertDim(cy);
ConvertRatio := DrawRatio;
ConvertDx := cx;
ConvertDy := cy;
end;
if mirrored then
begin
dx := (ap1.x + ap2.x) / 2;
dy := ap1.y;
dz := 0;
Dengine.ConvertCoord(dx,dy,dz);
FlipCanvas(Dengine.Canvas.Handle,fmHorz,2*dx);
end;
SetOwnerProps;
if Combined and (RegHandle = 0) then
begin
DrawInFigures(Dengine,isGrayed);
Beginpath(Dengine.Canvas.Handle);
DrawInFigures(Dengine,isGrayed);
EndPath(Dengine.Canvas.Handle);
RegHandle := PathToRegion(Dengine.Canvas.Handle);
end;
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
if combined then
Beginpath(Dengine.Canvas.Handle);
DrawInFigures(Dengine,isGrayed);
if combined then
EndPath(Dengine.Canvas.Handle);
if combined then
begin
DEngine.Canvas.Pen.Style := TPenStyle(Style);
DEngine.Canvas.Pen.Color := (Color);
DEngine.Canvas.Pen.Width := (Width);
DEngine.Canvas.Brush.Style := TbrushStyle(Brs);
DEngine.Canvas.Brush.Color := (Brc);
SetPolyfillMode(Dengine.Canvas.Handle,ALTERNATE);
//if brs = ord(bsSolid) then
//StrokeAndFillPath(Dengine.Canvas.Handle)
//else
StrokePath(Dengine.Canvas.Handle);
end;
if mirrored then
begin
ResetCanvas(Dengine.Canvas.Handle);
end;
ConvertRatio := 1;
ConvertDx := 0;
ConvertDy := 0;
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TFigureGrp.duplicate:TFigure;
var res: TFigureGrp;
a : integer;
begin
res := TFigureGrp.create(LayerHandle,Owner);
for a := 0 to inFigures.Count - 1 do begin
res.AddFigure(TFigure(InFigures[a]).duplicate);
end;
res.changed := changed;
res.AngleToPoint := AngleToPoint;
res.bDeltaX := bDeltaX;
res.bDeltaY := bDeltaY;
res.Combined := combined;
res.CreateMetaFile;
result := res;
end;
function TFigureGrp.DuplicateAsBezier: TFigure;
var res: TFigureGrp;
a : integer;
begin
res := TFigureGrp.create(LayerHandle,Owner);
for a := 0 to inFigures.Count - 1 do begin
res.AddFigure(TFigure(InFigures[a]).duplicateAsBezier);
end;
res.changed := changed;
res.AngleToPoint := AngleToPoint;
res.bDeltaX := bDeltaX;
res.bDeltaY := bDeltaY;
res.Combined := combined;
res.CreateMetaFile;
result := res;
end;
procedure TFigureGrp.getbounds(var figMaxX, figMaxY, figMinX,
figMinY: double);
var
mx,my,ax,ay: Double;
a: integer;
rect: TDoubleRect;
xp: TDoublePoint;
p1,p2: TDoublePoint;
ap: TDoublePoint;
begin
if (not DimLocked) and ((not BoundCalc) or (Infigures.Count < 5)) then
begin
getInbounds(figMaxX,figMaxY,figMinX,figMinY);
rect := DoubleRect(figMinX,figMinY,figMaxX,FigMaxY);
pointcount := 4;
ActualPoints[1] := DoublePoint(rect.Left,rect.Top);
ActualPoints[2] := DoublePoint(rect.Right,rect.Top);
ActualPoints[3] := DoublePoint(rect.Right,rect.Bottom);
ActualPoints[4] := DoublePoint(rect.Left,rect.Bottom);
BoundCalc := True;
end
else
begin
figMaxX := ap1.x;
figMinX := ap1.x;
figMaxY := ap1.y;
figMinY := ap1.y;
For a := 1 to 4 do
begin
{//31.10.2011
if actualpoints[a].x > figMaxX then
figMaxX := actualpoints[a].x;
if actualpoints[a].x < figMinX then
figMinX := actualpoints[a].x;
if actualpoints[a].y > figMaxY then
figMaxY := actualpoints[a].y;
if actualpoints[a].y < figMinY then
figMinY := actualpoints[a].y;}
ap := actualpoints[a];
if ap.x > figMaxX then
figMaxX := ap.x;
if ap.x < figMinX then
figMinX := ap.x;
if ap.y > figMaxY then
figMaxY := ap.y;
if ap.y < figMinY then
figMinY := ap.y;
end;
end;
if drawRatio <> 1 then
begin
xp.x := (figMaxX+figMinX)/2;
xp.y := (figMaxY+figMinY)/2;
p1 := DoublePoint(figMinx,figMinY);
p2 := DoublePoint(figMaxX,figMaxY);
p1 := ScalePoint(xp,p1,DrawRatio,DrawRatio);
p2 := ScalePoint(xp,p2,DrawRatio,DrawRatio);
figMinX := p1.x;
figMinY := p1.y;
figMaxX := p2.x;
figMaxY := p2.y;
end;
end;
// Tolik 29/06/2017 --
procedure TFigureGrp.GetINBoundsWithoutAutoCreatedFigures(var figMaxX,figMaxY,figMinX,figMinY: double);
var
mx,my,ax,ay: Double;
a,i: integer;
isFirst: boolean;
c_name: string;
begin
c_name := Self.ClassName;
c_name := LowerCase(c_name);
if (c_name = 'tfiguregrpmod') or (c_name = 'tfiguregrpnotmod') or (c_name = 'tfiguregrp') then
begin
if self is TFigureGrpMod then
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
isFirst := True;
for a := 0 to inFigures.Count - 1 do
begin
//Tolik -- 08/06/2017 --
if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
if not (TFigure(InFigures[a]) is TArcDimLine) then
begin
if isFirst then
begin
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY);
isFirst := False;
// Tolik -- 08/11/2016-- èíà÷å ðèñêóåì ïîòåðÿòü ìèíèìàëüíûå ãðàíèöû !!!!!
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
//
end
else
begin
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
TFigure(InFigures[a]).getBounds(mx,my,ax,ay);
end;
if a > 0 then
begin
if mx > figMaxX then
figMaxX := mx;
if ax < figMinX then
figMinX := ax;
if my > figMaxY then
figMaxY := my;
if ay < figMinY then
figMinY := ay;
end;
end
else
begin
if isFirst then
begin
// Tolik 09/11/2016-- -- åñëè îáúåêò áóäåò ñîñòîÿòü òîëüêî èç îáúåêòîâ òèïà ÀÐÊÀ,
// òî îïÿòü ïîòåðÿåì áàéíäû íàõ....òî åñòü, íóæíî òàê:
figMaxX := TFigure(InFigures[a]).ActualPoints[1].x;
figMaxY := TFigure(InFigures[a]).ActualPoints[1].y;
figMinX := TFigure(InFigures[a]).ActualPoints[1].x;
figMinY := TFigure(InFigures[a]).ActualPoints[1].y;
end;
figMinY := figMinY;
end;
end;
end;
end
else
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
i := 0;
for a := 0 to inFigures.Count - 1 do
begin
// Tolik -- 08/06/2017 --
if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
{if a = 0 then
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY)}
if i = 0 then
begin
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY);
inc(i);
end
else
begin
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
TFigure(InFigures[a]).getBounds(mx,my,ax,ay);
end;
if a > 0 then
begin
if mx > figMaxX then
figMaxX := mx;
if ax < figMinX then
figMinX := ax;
if my > figMaxY then
figMaxY := my;
if ay < figMinY then
figMinY := ay;
end;
end;
end;
end;
end
else
getInbounds(figMaxX,figMaxY,figMinX,figMinY);
end;
procedure TFigureGrp.GetBoundsWithAutoCreatedFigures(var figMaxX,figMaxY,figMinX,figMinY: double);
var
mx,my,ax,ay: Double;
a,i: integer;
isFirst: boolean;
c_name: string;
begin
c_name := Self.ClassName;
c_name := LowerCase(c_name);
if (c_name = 'tfiguregrpmod') or (c_name = 'tfiguregrpnotmod') or (c_name = 'tfiguregrp') then
begin
if self is TFigureGrpMod then
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
isFirst := True;
for a := 0 to inFigures.Count - 1 do
begin
//Tolik -- 08/06/2017 --
//if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
if not (TFigure(InFigures[a]) is TArcDimLine) then
begin
if isFirst then
begin
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY);
isFirst := False;
// Tolik -- 08/11/2016-- èíà÷å ðèñêóåì ïîòåðÿòü ìèíèìàëüíûå ãðàíèöû !!!!!
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
//
end
else
begin
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
TFigure(InFigures[a]).getBounds(mx,my,ax,ay);
end;
if a > 0 then
begin
if mx > figMaxX then
figMaxX := mx;
if ax < figMinX then
figMinX := ax;
if my > figMaxY then
figMaxY := my;
if ay < figMinY then
figMinY := ay;
end;
end
else
begin
if isFirst then
begin
// Tolik 09/11/2016-- -- åñëè îáúåêò áóäåò ñîñòîÿòü òîëüêî èç îáúåêòîâ òèïà ÀÐÊÀ,
// òî îïÿòü ïîòåðÿåì áàéíäû íàõ....òî åñòü, íóæíî òàê:
figMaxX := TFigure(InFigures[a]).ActualPoints[1].x;
figMaxY := TFigure(InFigures[a]).ActualPoints[1].y;
figMinX := TFigure(InFigures[a]).ActualPoints[1].x;
figMinY := TFigure(InFigures[a]).ActualPoints[1].y;
end;
figMinY := figMinY;
end;
end;
end;
end
else
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
i := 0;
for a := 0 to inFigures.Count - 1 do
begin
// Tolik -- 08/06/2017 --
//if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
{if a = 0 then
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY)}
if i = 0 then
begin
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY);
inc(i);
end
else
begin
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
TFigure(InFigures[a]).getBounds(mx,my,ax,ay);
end;
if a > 0 then
begin
if mx > figMaxX then
figMaxX := mx;
if ax < figMinX then
figMinX := ax;
if my > figMaxY then
figMaxY := my;
if ay < figMinY then
figMinY := ay;
end;
end;
end;
end;
end
else
getbounds(figMaxX,figMaxY,figMinX,figMinY);
end;
procedure TFigureGrp.GetBoundsWithoutAutoCreatedFigures(var figMaxX,figMaxY,figMinX,figMinY: double);
var
mx,my,ax,ay: Double;
a: integer;
rect: TDoubleRect;
xp: TDoublePoint;
p1,p2: TDoublePoint;
ap: TDoublePoint;
c_name: string;
begin
c_name := Self.ClassName;
c_name := LowerCase(c_name);
if (c_name = 'tfiguregrpmod') or (c_name = 'tfiguregrpnotmod') or (c_name = 'tfiguregrp') then
begin
if (not DimLocked) and ((not BoundCalc) or (Infigures.Count < 5)) then
begin
GetINBoundsWithoutAutoCreatedFigures(figMaxX,figMaxY,figMinX,figMinY);
rect := DoubleRect(figMinX,figMinY,figMaxX,FigMaxY);
pointcount := 4;
ActualPoints[1] := DoublePoint(rect.Left,rect.Top);
ActualPoints[2] := DoublePoint(rect.Right,rect.Top);
ActualPoints[3] := DoublePoint(rect.Right,rect.Bottom);
ActualPoints[4] := DoublePoint(rect.Left,rect.Bottom);
BoundCalc := True;
end
else
begin
figMaxX := ap1.x;
figMinX := ap1.x;
figMaxY := ap1.y;
figMinY := ap1.y;
For a := 1 to 4 do
begin
{//31.10.2011
if actualpoints[a].x > figMaxX then
figMaxX := actualpoints[a].x;
if actualpoints[a].x < figMinX then
figMinX := actualpoints[a].x;
if actualpoints[a].y > figMaxY then
figMaxY := actualpoints[a].y;
if actualpoints[a].y < figMinY then
figMinY := actualpoints[a].y;}
ap := actualpoints[a];
if ap.x > figMaxX then
figMaxX := ap.x;
if ap.x < figMinX then
figMinX := ap.x;
if ap.y > figMaxY then
figMaxY := ap.y;
if ap.y < figMinY then
figMinY := ap.y;
end;
end;
if drawRatio <> 1 then
begin
xp.x := (figMaxX+figMinX)/2;
xp.y := (figMaxY+figMinY)/2;
p1 := DoublePoint(figMinx,figMinY);
p2 := DoublePoint(figMaxX,figMaxY);
p1 := ScalePoint(xp,p1,DrawRatio,DrawRatio);
p2 := ScalePoint(xp,p2,DrawRatio,DrawRatio);
figMinX := p1.x;
figMinY := p1.y;
figMaxX := p2.x;
figMaxY := p2.y;
end;
end
else
getbounds(figMaxX,figMaxY,figMinX,figMinY);
end;
procedure TFigureGrp.getModPoints(ModList: TMyList);
var figMaxX, figMaxY, figMinX,figMinY: double;
CControl:TPCDrawing;
p1,p2,p3,p4,MT,MR,MB,ML : TDoublePoint;
begin
CControl := TPCdrawing(Owner);
getbounds(figMaxX,figMaxY,figMinX,figMinY);
p1 := DoublePoint(figMinX,figMinY);
p2 := DoublePoint(figMaxX,figMinY);
p3 := DoublePoint(figMaxX,figMaxY);
p4 := DoublePoint(figMinX,figMaxY);
MT := Mpoint(p1,p2);
MR := Mpoint(p2,p3);
MB := Mpoint(p3,p4);
ML := Mpoint(p4,p1);
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,p1.x,p1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,MT.x,MT.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,p2.x,p2.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,MR.x,MR.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,p3.x,p3.y,5));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,MB.x,MB.y,6));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,p4.x,p4.y,7));
ModList.Add(CControl.RegisterModPoint(self,ptGroupPoint,ptRect,clRed,PointDim,ML.x,ML.y,8));
ActualPoints[1] := p1;
ActualPoints[2] := p2;
ActualPoints[3] := p3;
ActualPoints[4] := p4;
end;
procedure TFigureGrp.WriteToStream(Stream: TStream);
var
a,xSize,xInt: integer;
xCode,xByte: Byte;
figure: TFigure;
xStream : TMemoryStream;
begin
inherited;
xInt:= inFigures.Count;
xCode := 20;
WriteField(xCode, Stream, xInt, 4);
if combined then
begin
xByte := 1;
xCode := 90;
WriteField(xCode,Stream,xByte,1);
end;
// Tolik 13/10/2017 -- çàïèñàòü ôëàã íàëè÷èÿ àâòîñîçäàííûõ ôèãóð
xByte := byte(HasAutocreatedFigures);
xCode := 91;
WriteField(xCode,Stream,xByte,1);
//
for a := 0 to inFigures.Count - 1 do
begin
xStream := TMemoryStream.Create;
Figure := TFigure(InFigures[a]);
Figure.WriteToStream(xStream);
xSize := xStream.Size;
xStream.Position := 0;
xCode := 150;
Stream.Write(xCode,1);
Stream.Write(xSize,4);
StreamToStream(xStream,Stream,xSize);
xStream.Free;
end;
end;
procedure TFigureGrp.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
var
mstr:TMemoryStream;
Figure: Tfigure;
begin
Case xcode of
90: Combined := (pByte(data)^ = 1);
150: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
if reloading then
begin
Figure := TFigure(InFigures[LoadIdx]);
ReadStringFromStream(mStr);
Figure.SetPropertiesFromStream(mStr);
LoadIdx := LoadIdx + 1;
Figure.InCombined := Combined;
end
else
begin
Figure := TFigure.CreateFromStream(mStr, LayerHandle, DrawStyle, Owner);
AddToGrp(Figure); //28.04.2011 InFigures.Add(Figure);
Figure.InCombined := Combined;
end;
mStr.Free;
end;
// Tolik 13/10/2017 -- çàïèñàòü ôëàã íàëè÷èÿ àâòîñîçäàííûõ ôèãóð
91: HasAutocreatedFigures := Boolean(pByte(data)^);
//
end;
end;
function TFigureGrp.isPointIn(x, y: double): boolean;
var a: integer;
begin
result := false;
result := inherited isPointIn(x,y);
if result then
exit;
if combined then
begin
result := IsPointInRegion(x,y);
//Tolik
result := IsPointInRegionByRegObj(x,y);
//
end
else
begin
for a := 0 to inFigures.Count - 1 do
begin
// Tolik -- 08/06/2017
if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
//
result := TFigure(InFigures[a]).ispointin(x,y);
if result then
exit;
end;
end;
end;
end;
procedure TFigureGrp.mirror(Point1, Point2: TDoublePoint);
var a: integer;
begin
inherited;
for a := 0 to inFigures.Count - 1 do
begin
TFigure(InFigures[a]).mirror(Point1, Point2);
end;
Changed := True;
CreateMetafile;
ResetRegion;
end;
procedure TFigureGrp.ModifySelection(mm: TModifyMode; value: Integer);
var a: integer;
begin
inherited;
for a := 0 to inFigures.Count - 1 do begin
TFigure(InFigures[a]).ModifySelection(mm,value);
end;
Changed := True;
ResetRegion;
end;
Function TFigureGrp.ModifyTextAndFont(mm: TModifyMode; valueI: Double;
valueS: string; valueSt: TFontStyles;valueB:Boolean):Boolean;
var a: integer;
begin
result := false;
for a := 0 to inFigures.Count - 1 do begin
if TFigure(InFigures[a]).ModifyTextAndFont(mm,valueI,valueS,ValueSt,ValueB)
then result := True;
end;
Changed := True;
ResetRegion;
end;
procedure TFigureGrp.move(deltax, deltay:Double);
var
a: integer;
begin
inherited;
for a := 0 to inFigures.Count - 1 do
begin
TFigure(InFigures[a]).move(deltax, deltay);
end;
BDeltax := BDeltax + deltax;
BDeltay := BDeltay + deltay;
ResetRegion;
end;
procedure TFigureGrp.rotate(aAngle: Double; cPoint: TDoublePoint);
var a: integer;
fig: TFigure;
Cad: TPCDrawing;
Arc: TElpArc;
pd1: TDoublePoint;
ElpArc: TElpArc;
ElpPoly: TPolyline;
begin
inherited;
AngletoPoint := AngleToPoint + aAngle;
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(inFigures[a]);
if (fig is TElpArc) then
begin
Cad := TPCdrawing(owner);
Cad.ClearUndoList;
Arc := TElpArc(fig);
ElpPoly := TPolyline(Arc.DuplicateAsBezier);
InFigures[a] := ElpPoly;
Arc.Destroy;
TFigure(InFigures[a]).rotate(aAngle,cPoint);
end
else
begin
TFigure(InFigures[a]).rotate(aAngle,cPoint);
end;
end;
Changed := True;
CreateMetafile;
ResetRegion;
end;
procedure TFigureGrp.scale(percentx, percenty: double; rPoint: TDoublepoint);
var
a: integer;
fig: TFigure;
Cad: TPCDrawing;
elp: TEllipse;
ElpArc: TElpArc;
Arc: TArc;
begin
//27.05.2011 - Before scale events
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if Assigned(fig.FBeforeAllScale) then
fig.FBeforeAllScale(fig);
end;
// Tolik 02/05/2019 - -
{ for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if FloatToStr(fig.Ap1.z) = 'NAN' then
ShowMessage(fig.CName + ' is Broken Here!!! ');
end; }
//
inherited;
try
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if (fig is TCircle) and (percentx <> percenty) and assigned(owner) then
begin
Cad := TPCdrawing(owner);
Cad.ClearUndoList;
elp := TEllipse.create(fig.ap1.x, fig.ap1.y, fig.radius, fig.radius, 0,
fig.Width, fig.Style, fig.Color, fig.brs, fig.brc, fig.LayerHandle, mydsNormal, fig.Owner);
elp.Scale(percentx, percenty, rPoint);
InFigures[a] := elp;
fig.Destroy;
end
else
if (fig is TArc) and (not (fig is TArcDimLine)) and (percentx <> percenty) and assigned(owner) then
begin
// ElpPoly := TPolyline(Arc.DuplicateAsBezier);
// InFigures[a] := ElpPoly;
// Arc.Destroy;
// TFigure(InFigures[a]).rotate(aAngle,cPoint);
Cad := TPCdrawing(owner);
Cad.ClearUndoList;
Arc := TArc(fig);
ElpArc := TElpArc.create(arc.ap1.x, arc.ap1.y, arc.Radius, arc.Radius, arc.SAngle, arc.FAngle, arc.Angle,
fig.Width, fig.Style, fig.Color, fig.brs, fig.brc, ord(asOpen), fig.LayerHandle, mydsNormal, fig.Owner);
ElpArc.draw(GCadForm.PCad.DEngine, False);
ElpArc.Scale(percentx, percenty, rPoint);
InFigures[a] := ElpArc;
fig.Destroy;
end
else
TFigure(InFigures[a]).scale(percentx, percenty, rPoint);
end;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigureGrp.scale' + E.Message);
on E:Exception do
ShowMessage('a = ' + inttostr(a));
end;
Changed := True;
// Tolik 02/05/2019 - -
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if FloatToStr(fig.Ap1.z) = 'NAN' then
ShowMessage(fig.CName + ' is Broken Here!!! ');
end;
//
//23.09.2011 - After Scaling And Before Other Events FAfterScalingBeforeEvents
//for a := 0 to inFigures.Count - 1 do
//begin
// fig := TFigure(InFigures[a]);
// if Assigned(fig.FAfterScalingBeforeEvents) then
// fig.FAfterScalingBeforeEvents(fig);
//end;
//27.05.2011 - Sale events
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if Assigned(fig.FScaleAllEvent) then
fig.FScaleAllEvent(fig);
end;
// Tolik 02/05/2019 - -
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if FloatToStr(fig.Ap1.z) = 'NAN' then
ShowMessage(fig.CName + ' is Broken Here!!! ');
end;
//
//27.05.2011 - After scale events
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if Assigned(fig.FAfterAllScale) then
fig.FAfterAllScale(fig);
end;
// Tolik 02/05/2019 - -
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if FloatToStr(fig.Ap1.z) = 'NAN' then
ShowMessage(fig.CName + ' is Broken Here!!! ');
end;
//
CreateMetafile;
// Tolik 02/05/2019 - -
for a := 0 to inFigures.Count - 1 do
begin
fig := TFigure(InFigures[a]);
if FloatToStr(fig.Ap1.z) = 'NAN' then
ShowMessage(fig.CName + ' is Broken Here!!! ');
end;
//
ResetRegion;
end;
// Tolik -- 27/06/2017 --
function TFigureGrp.CheckHasAutocreatedFigures(aFigure: TFigure): Boolean;
var i: integer;
c_name: string;
begin
result := False;
c_name := Self.ClassName;
c_name := LowerCase(c_name);
//if (c_name = 'tfiguregrpmod') or (c_name = 'tfiguregrpnotmod') or (c_name = 'tfiguregrp') then
if (c_name = 'tfiguregrpmod') then
begin
if assigned(self.owner) and assigned(TPowerCad(self.owner).OnObjectInserted) then
begin
for i := 0 to TFigureGrp(aFigure).InFigures.Count - 1 do
begin
// if TFigure(TFigureGrp(aFigure).InFigures[i]) is TFigureGrp then
if TFigure(TFigureGrp(aFigure).InFigures[i]).ClassName = TFigureGrpMod.ClassName then
Result := CheckHasAutocreatedFigures(TFigure(TFigureGrp(aFigure).InFigures[i]))
else
Result := (TFigure(TFigureGrp(aFigure).InFigures[i]).isAutoCreatedFigure = biTrue);
end;
if result then
exit;
end
else
begin
result := HasAutocreatedFigures;
end;
end;
end;
function TFigureGrp.InsertFig(aFigure: TFigure): Integer;
begin
Result := 0;
InFigures.Insert(0, AFigure);
AFigure.Parent := Self;
// Tolik 27/06/2017
if Self.ClassName = TFigureGrpMod.ClassName then
HasAutocreatedFigures := CheckHasAutocreatedFigures(TFigure(Self));
//
end;
//
function TFigureGrp.AddToGrp(AFigure: TFigure): Integer;
begin
Result := InFigures.Add(AFigure);
AFigure.Parent := Self;
// Tolik 27/06/2017
if Self.ClassName = 'TFigureGrpMod' then
HasAutocreatedFigures := CheckHasAutocreatedFigures(TFigure(Self));
//
end;
function TFigureGrp.GetBoundRectWithoutAutoCreatedFigures: TDoubleRect;
var
figMaxX,figMaxY,figMinX,figMinY: Double;
c_name: string;
begin
c_name := Self.ClassName;
c_name := LowerCase(c_name);
if (c_name = 'tfiguregrpmod') or (c_name = 'tfiguregrpnotmod') or (c_name = 'tfiguregrp') then
begin
GetBoundsWithoutAutoCreatedFigures(figMaxX,figMaxY,figMinX,figMinY);
//result := Rect(figMinX,figMaxY,figMaxX,FigMinY);
result := DoubleRect(figMinX,figMinY,figMaxX,FigMaxY);
end
else
result := GetBoundRect;
end;
function TFigureGrp.RemoveFromGrp(AFigure: TFigure): Integer;
begin
while InFigures.IndexOf(AFigure) <> -1 do
begin
AFigure.Parent := nil;
Result := InFigures.Remove(AFigure);
end;
// Tolik 27/06/2017 --
if Self.ClassName = TFigureGrpMod.ClassName then
HasAutocreatedFigures := CheckHasAutocreatedFigures(TFigure(Self));
BoundCalc := False;
//
end;
procedure TFigureGrp.UnGroup;
var
a: integer;
CControl: TPCDrawing;
fig: TFigure;
begin
if AlwaysTogether then
exit;
Combined := False;
Deselect;
CControl := TPCdrawing(Owner);
try
for a := 0 to inFigures.Count - 1 do
begin
//30.05.2011 TFigure(InFigures[a]).select;
//30.05.2011 CControl.Figures.add(TFigure(InFigures[a]));
fig := TFigure(InFigures[a]);
fig.select;
fig.Parent := nil; //30.05.2011
CControl.Figures.add(fig);
end;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigureGrp.UnGroup' + E.Message);
end;
UnGrouped := true;
// Tolik -- 27/06/2017 --
if Self.ClassName = TFigureGrpMod.ClassName then
HasAutocreatedFigures := CheckHasAutocreatedFigures(TFigure(Self));
//
ResetRegion;
end;
Procedure TFigureGrp.SetReload(Value:Boolean);
var f: TFigure;
i: Integer;
begin
Freload := Value;
LoadIdx := 0;
For i := 0 to Infigures.Count -1 do
begin
f := Tfigure(Infigures[i]);
if f is TFigureGrp then TFigureGrp(f).Reloading := Value;
end;
end;
function TFigureGrp.Rename: string;
var a: integer;
begin
inherited Rename;
if assigned(inFigures) then begin
for a := 0 to inFigures.Count - 1 do begin
TFigure(InFigures[a]).Rename;
end;
end;
end;
function TFigureGrp.CountBlock(BlockName: String): integer;
var f:TFigure;
fg: TfigureGrp;
a,cnt,i: integer;
begin
cnt := 0;
for a := 0 to InFigures.Count-1 do
begin
f := TFigure(InFigures[a]);
if f is TBlock then
begin
if TBlock(f).BlockName = BlockName then cnt := cnt +1;
end
else
if f is TFigureGrp then begin
fg := TFigureGrp(f);
cnt := cnt + fg.CountBlock(BlockName);
end;
end;
result := cnt;
end;
procedure TFigureGrp.MenuClicked(CommandId: integer);
var idx: integer;
CadControl: TPCDrawing;
begin
idx := commandID-menuIndex;
case idx of
0: Combined := not Combined;
1: begin
if assigned(owner) then begin
CadControl := TPCDrawing(Owner);
CadControl.Figures.Remove(Self);
end;
Ungroup;
end;
2: DiagonalScale := not DiagonalScale;
end;
end;
procedure TFigureGrp.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var mnItem: TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmCombined;
mnItem.Tag := sIndex;
if Combined then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+1;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmUnGroup;
mnItem.Tag := sIndex;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+1;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDiagonal;
mnItem.Tag := sIndex;
mnItem.Checked := DiagonalScale;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+2;
end;
procedure TFigureGrp.ResetRegion;
var f: Tfigure;
a: integer;
begin
inherited;
for a := 0 to InFigures.Count-1 do
begin
f := TFigure(InFigures[a]);
f.ResetRegion;
end;
end;
procedure TFigureGrp.GetVectorObjects(Objects: Tlist; BaseP: TDoublePoint);
var i: Integer;
f: Tfigure;
begin
for i := 0 to Infigures.Count-1 do
begin
f := TFigure(Infigures[i]);
f.GetVectorObjects(Objects,BaseP);
end;
end;
Procedure TFigureGrp.VerifyZeroPoints(orgV,orgH:Byte);
var i: Integer;
begin
for i := 0 to InFigures.Count -1 do
begin
TFigure(Infigures[i]).VerifyZeroPoints(orgV,orgH);
end;
end;
procedure TFigureGrp.DrawFigureGuides(DEngine: TPCDrawEngine);
var a: Integer;
Figure: Tfigure;
isDraw: Boolean;
Layer: Tlayer;
begin
inherited;
for a := 0 to inFigures.Count - 1 do begin
Figure := TFigure(inFigures[a]);
isDraw := true;
if Figure.LayerHandle > 0 then begin
Layer := TLayer(Figure.LayerHandle);
isDraw := (Layer.visible <> lost);
end;
if isDraw and (not combined) then TFigure(InFigures[a]).drawFigureGuides(DEngine);
end;
end;
procedure TFigureGrp.GetFigures(xList: TList);
var a: Integer;
Figure: Tfigure;
begin
if combined then xList.Add(Self)
else
for a := 0 to inFigures.Count - 1 do begin
Figure := TFigure(inFigures[a]);
if Figure is TFigureGrp then
TFigureGrp(Figure).GetFigures(xList)
else
xList.Add(Figure);
end;
end;
procedure TFigureGrp.SetCombined(const Value: Boolean);
var a:Integer;
begin
FCombined := Value;
if assigned(inFigures) then begin
for a := 0 to inFigures.Count - 1 do begin
TFigure(InFigures[a]).InCombined := Combined;
end;
end;
end;
procedure TFigureGrp.SetInCombined(const Value: Boolean);
var a: Integer;
begin
inherited;
if (Combined and Value) then Fcombined := False;
if assigned(inFigures) then begin
for a := 0 to inFigures.Count - 1 do begin
TFigure(InFigures[a]).InCombined := Value;
end;
end;
end;
function TFigureGrp.GetClassName: String;
begin
result := 'FigureGrp';
end;
procedure TFigureGrp.DrawDimlines(DEngine: TPCDrawEngine;
isGrayed: Boolean);
var i: Integer;
begin
for i := 0 to InFigures.Count-1 do
Tfigure(InFigures[i]).DrawDimlines(Dengine,isGrayed);
end;
procedure TFigureGrp.CreateMetaFile;
var rect:TDoubleRect;
figMaxX,figMaxY,figMinX,figMinY: Double;
begin
getInbounds(figMaxX,figMaxY,figMinX,figMinY);
rect := DoubleRect(figMinX,figMinY,figMaxX,FigMaxY);
pointcount := 4;
ActualPoints[1] := DoublePoint(rect.Left,rect.Top);
ActualPoints[2] := DoublePoint(rect.Right,rect.Top);
ActualPoints[3] := DoublePoint(rect.Right,rect.Bottom);
ActualPoints[4] := DoublePoint(rect.Left,rect.Bottom);
//if assigned(FMetaFile) then FMetafile.Free;
//FMEtaFile := TPCDrawing(Owner).FigureAsWmf(Self.Handle,False);
end;
procedure TFigureGrp.SetSpecialPropertiesFromStream(Stream: TStream);
begin
inherited;
CreateMetaFile;
end;
Destructor TFigureGrp.DestroyGrp;
begin
if assigned(FMetaFile) then FMetafile.Free;
InFigures.Destroy;
inherited;
end;
procedure TFigureGrp.getInbounds(var figMaxX, figMaxY, figMinX,
figMinY: double);
var
mx,my,ax,ay: Double;
a,i: integer;
isFirst: boolean;
begin
if self is TFigureGrpMod then
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
isFirst := True;
for a := 0 to inFigures.Count - 1 do
begin
//Tolik -- 08/06/2017 --
if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
if not (TFigure(InFigures[a]) is TArcDimLine) then
begin
if isFirst then
begin
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY);
isFirst := False;
// Tolik -- 08/11/2016-- èíà÷å ðèñêóåì ïîòåðÿòü ìèíèìàëüíûå ãðàíèöû !!!!!
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
//
end
else
begin
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
TFigure(InFigures[a]).getBounds(mx,my,ax,ay);
end;
if a > 0 then
begin
if mx > figMaxX then
figMaxX := mx;
if ax < figMinX then
figMinX := ax;
if my > figMaxY then
figMaxY := my;
if ay < figMinY then
figMinY := ay;
end;
end
else
begin
if isFirst then
begin
// Tolik 09/11/2016-- -- åñëè îáúåêò áóäåò ñîñòîÿòü òîëüêî èç îáúåêòîâ òèïà ÀÐÊÀ,
// òî îïÿòü ïîòåðÿåì áàéíäû íàõ....òî åñòü, íóæíî òàê:
figMaxX := TFigure(InFigures[a]).ActualPoints[1].x;
figMaxY := TFigure(InFigures[a]).ActualPoints[1].y;
figMinX := TFigure(InFigures[a]).ActualPoints[1].x;
figMinY := TFigure(InFigures[a]).ActualPoints[1].y;
end;
figMinY := figMinY;
end;
end;
end;
end
else
begin
figMaxX := 0;
figMaxY := 0;
figMinX := 0;
figMinY := 0;
//
i := 0;
for a := 0 to inFigures.Count - 1 do
begin
// Tolik -- 08/06/2017 --
if TFigure(InFigures[a]).isAutoCreatedFigure = biFalse then
begin
{if a = 0 then
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY)}
if i = 0 then
begin
TFigure(InFigures[a]).getBounds(figMaxX, figMaxY, figMinX, figMinY);
inc(i);
end
else
begin
mx := figMaxX;
my := figMaxY;
ax := figMinX;
ay := figMinY;
TFigure(InFigures[a]).getBounds(mx,my,ax,ay);
end;
if a > 0 then
begin
if mx > figMaxX then
figMaxX := mx;
if ax < figMinX then
figMinX := ax;
if my > figMaxY then
figMaxY := my;
if ay < figMinY then
figMinY := ay;
end;
end;
end;
end;
end;
procedure TFigureGrp.SetFieldText(FName, FValue: String);
var fig: TFigure;
i: Integer;
begin
for i := 0 to InFigures.Count-1 do
begin
fig := Tfigure(InFigures[i]);
if (fig is TText) then TText(fig).SetField(Fname,Fvalue)
else if (fig is TTextPanel) then TTextPanel(fig).SetField(Fname,Fvalue)
else if (fig is TFigureGrp) then TFigureGrp(fig).SetFieldText(FName, FValue);
end;
end;
procedure TFigureGrp.LockDimensions(w, h: Double);
begin
actualpoints[2] := DoublePOint(ap1.x+w,ap1.y);
actualpoints[3] := DoublePOint(ap1.x+w,ap1.y+h);
actualpoints[4] := DoublePOint(ap1.x,ap1.y+h);
DimLocked := True;
end;
procedure TFigureGrp.RemoveInFigure(FName: String);
var
fig: TFigure;
i: Integer;
begin
try
for i := 0 to InFigures.Count - 1 do
begin
fig := Tfigure(InFigures[i]);
if fig.Name = FName then
begin
RemoveFromGrp(fig); //28.04.2011 InFigures.Remove(fig);
Modified := true;
BoundCalc := False; // 30/06/2017 -- Tolik
ResetRegion;
exit;
end;
end;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigureGrp.RemoveInFigure' + E.Message);
end;
// Tolik -- 27/06/2017 --
if Self.ClassName = TFigureGrpMod.ClassName then
HasAutocreatedFigures := CheckHasAutocreatedFigures(TFigure(Self));
//
end;
procedure TFigureGrp.ReplaceTextWithWMF(FName: String; mf: TMEtafile);
var fig: TFigure;
i: Integer;
txPanel: TTextPanel;
xRect,wRect: TDoubleRect;
ow,oh,w,h,sw,sh,s,dx,dy: Double;
Cad: TPCDrawing;
wmf: TWMFObject;
begin
for i := 0 to InFigures.Count-1 do
begin
fig := Tfigure(InFigures[i]);
if (fig is TTextPanel) and (TTextPanel(fig).Text = FName) then begin
txPanel := TTextPanel(fig);
xRect := txPanel.GetBoundRect;
wmf := TWMFObject.createEx(xRect.Left,xRect.top,mf,LayerHandle,mydsNormal,Owner);
wRect := wmf.GetBoundRect;
ow := wRect.Right-wRect.left;
w := xRect.Right-xRect.Left;
oh := wRect.Bottom-wRect.Top;
h := xRect.Bottom-xRect.Top;
sw := w/ow;
sh := h/oh;
s := sw;
if sh < s then s := sh;
wmf.Scale(s,s,DoublePoint(xRect.Left,xRect.top));
wRect := wmf.GetBoundRect;
dx := (w-(wRect.Right-wRect.left))/2;
dy := (h-(wRect.Bottom-wRect.Top))/2;
wmf.Move(dx,dy);
TPCDrawing(Owner).Figures.Add(wmf);
txPanel.Text := '';
end else if (fig is TFigureGrp) then TFigureGrp(fig).ReplaceTextWithWMF(FName, mf);
end;
end;
function TFigureGrp.Edit: Boolean;
begin
Self.RotateSelect;
Result := True;
end;
procedure TFigureGrp.SetModified;
var f: Tfigure;
a: integer;
begin
inherited;
for a := 0 to InFigures.Count-1 do
begin
f := TFigure(InFigures[a]);
f.SetModified;
end;
end;
procedure TFigureGrp.Unfilled;
var i: Integer;
begin
inherited;
for i := 0 to inFigures.Count-1 do
TFigure(Infigures[i]).Unfilled;
end;
procedure TFigureGrp.DrawInFigures(DEngine: TPCDrawEngine;
isGrayed: Boolean);
var
a:Integer;
Layer: TLayer;
Figure: TFigure;
isDraw: Boolean;
xBrs: Integer;
begin
for a := 0 to inFigures.Count - 1 do
begin
Figure := TFigure(inFigures[a]);
isDraw := true; isGrayed := false;
if Figure.LayerHandle > 0 then
begin
Layer := TLayer(Figure.LayerHandle);
isDraw := (Layer.visible <> lost);
isGrayed := (Layer.visible = Grayed);
end;
{//31.10.2011
if isDraw and TFigure(InFigures[a]).Visible then
begin
xBrs := TFigure(InFigures[a]).Brs;
if Combined then
Figure.Brs := TFigure(InFigures[a]).Brs := ord(bsClear);
TFigure(InFigures[a]).draw(DEngine,isGrayed);
if Combined then
TFigure(InFigures[a]).Brs := xBrs;
end;}
if isDraw and Figure.Visible then
begin
if Combined then
begin
xBrs := Figure.Brs;
Figure.Brs := ord(bsClear);
end;
Figure.draw(DEngine,isGrayed);
if Combined then
Figure.Brs := xBrs;
//Tolik
if Figure.RegHandle <> 0 then
begin
Figure.GetRegObject;
if TBrushStyle(Figure.brs) <> bsClear then
Figure.RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
end;
end;
procedure TFigureGrp.SetOwnerProps;
var
Figure:TFigure;
begin
if Infigures.Count = 0 then
exit;
Figure := TFigure(inFigures[0]);
Self.Style := Figure.Style;
Self.width := Figure.Width;
Self.color := Figure.Color;
Self.Brs := Figure.Brs;
Self.Brc := Figure.Brc;
end;
procedure TFigureGrp.SetGradient(GStyle: TGradStyle; ForeColor,
BackColor: TColor);
var i: Integer;
begin
inherited;
for i := 0 to Infigures.Count-1 do TFigure(Infigures[i]).SetGradient(GStyle,ForeColor,BackColor);
end;
procedure TFigureGrp.SetHatch(HStyle: THatchStyle; ForeColor,
BackColor: TColor; StepSize: Double);
var i: Integer;
begin
inherited;
for i := 0 to Infigures.Count-1 do TFigure(Infigures[i]).SetHatch(HStyle,ForeColor,BackColor,StepSize);
end;
procedure TFigureGrp.SetTexture(TStyle: TTextureStyle; TexSize: Integer);
var i: Integer;
begin
inherited;
for i := 0 to Infigures.Count-1 do TFigure(Infigures[i]).SetTexture(TStyle,TexSize);
end;
{ TBlock }
function TBlock.Rename: string;
var
a: integer;
begin
Name := BlockName + inttostr(Handle);
CName := Copy(ClassName,1,length(classname));
if assigned(inFigures) then
begin
for a := 0 to inFigures.Count - 1 do
begin
TFigure(InFigures[a]).Rename;
end;
end;
end;
(*
procedure TBlock.CreateProperties;
var fPPage: TObjectInspector;
a: integer;
le: real;
p1,p2: TPoint;
CustomList: TList;
begin
if owner <> nil then begin
if assigned(props[1]) then props[1].free;
if assigned(props[2]) then props[2].free;
if assigned(props[3]) then props[3].free;
props[1] := TStringProperty.create('Name',false,name);
props[2] := TIntegerProperty.create('Handle',true,Handle);
props[3] := TBoolProperty.create('Combined',true,Combined);
CCount := 0;
CustomList := TPCDrawing(owner).GetCustomPropList(BlockName);
if assigned(CustomList) then begin
for a := 0 to CustomList.Count-1 do
begin
if assigned(props[4+a]) then props[4+a].free;
props[4+a] := TProperty(Customlist[a]).Duplicate;
end;
CCOunt := CustomList.Count;
end;
end;
end;
*)
procedure TBlock.WriteToStream(Stream: TStream);
var
xStr: String;
a :integer;
//pr: TProperty;
xByte:Byte;
xInt:Integer;
xDbl: Double;
begin
inherited;
xStr := BlockName;
WriteStrField(180,Stream,xStr);
xByte := VertZero;
WriteField(95,Stream,xByte,1);
xByte := HorzZero;
WriteField(96,Stream,xByte,1);
xInt := Round(MapScale);
WriteField(25,Stream,xInt,4);
xDbl := MapScale;
WriteField(239, Stream, xDbl, sizeof(xDbl));
(*
for a := 1 to CCOunt do begin
pr := props[3+a];
xStr := pr.DataAsString;WriteStrField(180+a,Stream,xStr);
end;
*)
end;
procedure TBlock.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
var
strval: string;
//pr: TProperty;
begin
inherited;
if xCode = 95 then
begin
OrgVZ := pByte(data)^;
end
else
if xCode = 96 then
begin
OrgHZ := pByte(data)^;
end
else
if xCode = 25 then
begin
MapScale := pInt(data)^;
end
else
if xCode = 180 then
begin
BlockName := String(pChar(Data));
//CreateProperties;
end
else
if (xCode > 180) and (xCode < 220) then
begin
strval := String(pAnsiChar(Data));
//pr := TProperty(props[3+xCode-180]);
//pr.SetData(strVal);
end
else
if xCode = 239 then
begin
MapScale := pDouble(data)^;
end;
end;
constructor TBlock.Create(LHandle: Integer;aOwner: TComponent);
begin
inherited create(LHandle,aOwner);
MapScale := TPCDrawing(Owner).MapScale;
end;
procedure TBlock.Initialize;
begin
inherited;
MapScale := 1;
if assigned(Owner) then
MapScale := TPCDrawing(Owner).MapScale;
end;
function TBlock.duplicate: TFigure;
var res: TBlock;
a : integer;
begin
res := TBlock.create(LayerHandle,Owner);
for a := 0 to inFigures.Count - 1 do begin
res.AddFigure(TFigure(InFigures[a]).duplicate);
end;
res.changed := changed;
res.AngleToPoint := AngleToPoint;
res.Info := Info;
res.OrgVz := orgvz;
res.OrgHz := orghz;
res.Blockname := Blockname;
res.MapScale := MapScale;
result := res;
end;
function TBlock.GetClassName: String;
begin
result := 'Block';
end;
procedure TBlock.SaveToFile(const AFileName: String); //27.08.2010 //#From Oleg#
var
fStream: TFileStream;
begin
fStream := TFileStream.Create(AFileName,fmCreate);
Self.WriteToStream(fStream);
fStream.free;
end;
{ TRotate }
constructor TRotate.create(cX, cY:Double; p1, p2: TDoublepoint);
begin
inherited create(0,dsTrace,nil);
pointcount := 3;
actualpoints[1] := DoublePoint(cx,cy);
actualpoints[2] := DoublePoint(p1.x,p1.y);
actualpoints[3] := DoublePoint(p2.x,p2.y);
end;
class function TRotate.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TRotate.create(x,y,DoublePoint(x,y),DoublePoint(x,y));
end;
procedure TRotate.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
begin
DEngine.Canvas.pen.mode := pmXor;
DEngine.drawline(ap1.x,ap1.y,ap2.x,ap2.y,clLime,1,1,0);
DEngine.drawline(ap1.x,ap1.y,ap3.x,ap3.y,clLime,1,1,0);
end;
function TRotate.ShadowClick(ClickIndex:Integer; x, y: Double): Boolean;
begin
result := false;
if clickindex = 2 then begin
actualpoints[2] := DoublePoint(x,y);
result := false;
end else if clickindex = 3 then begin
actualpoints[3] := DoublePoint(x,y);
result := true;
end;
end;
class function TRotate.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
a: Double;
begin
cad := TPCDrawing(aOwner);
a := TRotate(Shadow).GetAngle;
cad.RotateSelection(a,Shadow.ap1);
result := nil;
end;
function TRotate.ShadowTrace(ClickIndex:Integer; x, y:Double): Boolean;
begin
if clickindex = 1 then begin
actualpoints[2] := DoublePoint(x,y);
end else if clickindex = 2 then begin
actualpoints[3] := DoublePoint(x,y);
end;
end;
function TRotate.GetAngle: Double;
var a1,a2,a: Double;
sgn: Integer;
begin
a1 := GetRadOfLine(ap1,ap2);
if a1 > pi then a1 := a1 - 2*pi;
a2 := GetRadOfLine(ap1,ap3);
if a2 > pi then a2 := a2 - 2*pi;
result := a2-a1;
end;
{ TMove }
constructor TMove.create(p1, p2: TDoublepoint);
begin
inherited create(0,dsTrace,nil);
Initialize; // Tolik 29/07/2021 --
pointcount := 2;
actualpoints[1] := Doublepoint(p1.x,p1.y);
actualpoints[2] := Doublepoint(p2.x,p2.y);
end;
class function TMove.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TMove.create(Doublepoint(x,y),Doublepoint(x,y));
end;
procedure TMove.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
begin
DEngine.Canvas.pen.mode := pmXor;
DEngine.drawline(ap1.x,ap1.y,ap2.x,ap2.y,clLime,1,1,0);
end;
function TMove.ShadowClick(ClickIndex:Integer; x, y:Double): Boolean;
begin
result := false;
if clickindex = 2 then begin
actualpoints[2] := DoublePoint(x,y);
result := true;
end;
end;
class function TMove.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
cad.MoveSelection(Shadow.ap2.x-Shadow.ap1.x,Shadow.ap2.y-Shadow.ap1.y);
result := nil;
end;
function TMove.ShadowTrace(ClickIndex:Integer; x, y:Double): Boolean;
begin
if clickindex = 1 then actualpoints[2] := DoublePoint(x,y);
end;
{ TDuplicate }
class function TDuplicate.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TDuplicate.create(DoublePoint(x,y),DoublePoint(x,y));
end;
class function TDuplicate.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
cad.DuplicateSelection(Shadow.ap2.x-Shadow.ap1.x,Shadow.ap2.y-Shadow.ap1.y);
result := nil;
end;
{ TMirror }
class function TMirror.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TMirror.create(DoublePoint(x,y),DoublePoint(x,y));
end;
class function TMirror.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
cad.MirrorSelection(Shadow.ap1,Shadow.ap2,(ssShift in Cad.CurrentShift) and MirrorDupl);
result := nil;
end;
procedure TMirror.Initialize;
begin
inherited;
Straight := False;
end;
function TMirror.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
var dx,dy: Double;
begin
result := false;
if Straight then begin
if clickindex = 2 then begin
dx := abs(ap1.x - x);
dy := abs(ap1.y - y);
if dx > dy then y := ap1.y else x := ap1.x;
actualpoints[2] := DoublePoint(x,y);
result := true;
end;
end else begin
result := inherited ShadowClick(ClickIndex,x, y);
end;
end;
function TMirror.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean;
var dx,dy: Double;
begin
if Straight then begin
if clickindex = 1 then begin
dx := abs(ap1.x - x);
dy := abs(ap1.y - y);
if dx > dy then y := ap1.y else x := ap1.x;
actualpoints[2] := DoublePoint(x,y);
end;
end else begin
inherited ShadowTrace(ClickIndex,x, y);;
end;
end;
{ TArrayPol }
class function TArrayPol.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TArrayPol.create(x,y,DoublePoint(x,y),DoublePoint(x,y));
end;
class function TArrayPol.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
a: Double;
begin
cad := TPCDrawing(aOwner);
a := TArrayPol(Shadow).GetAngle;
cad.ArrayPolarSelection(Shadow.ap1,a);
result := nil;
end;
function TArrayPol.GetAngle: Double;
var a1,a2,a: Double;
sgn: Integer;
begin
a1 := GetRadOfLine(ap1,ap2);
if a1 > pi then a1 := a1 - 2*pi;
a2 := GetRadOfLine(ap1,ap3);
if a2 > pi then a2 := a2 - 2*pi;
result := a2-a1;
end;
{ TArrayRect }
constructor TArrayRect.create(p1, p2, p3, p4,p5: TDoublepoint);
begin
inherited create(0,dsTrace,nil);
initialize; // Tolik 29/07/2021 --
pointcount := 5;
actualpoints[1] := DoublePoint(p1.x,p1.y);
actualpoints[2] := DoublePoint(p2.x,p2.y);
actualpoints[3] := DoublePoint(p3.x,p3.y);
actualpoints[4] := DoublePoint(p4.x,p4.y);
actualpoints[5] := DoublePoint(p5.x,p5.y);
end;
class function TArrayRect.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TArrayRect.Create(DoublePoint(x,y),DoublePoint(x,y),
DoublePoint(x,y),DoublePoint(x,y),DoublePoint(x,y));
end;
procedure TArrayRect.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var dx,dy: Double;
tcount,a: integer;
ap5: TDoublePoint;
begin
ap5 := ActualPoints[5];
DEngine.Canvas.pen.mode := pmXor;
DEngine.drawline(ap1.x,ap1.y,ap4.x,ap1.y,clLime,1,0,0);
DEngine.drawline(ap1.x,ap1.y,ap1.x,ap5.y,clLime,1,0,0);
dx := ap2.x-ap1.x;
if dx <> 0 then begin
tcount := round(abs(ap4.x-ap1.x) / abs(dx));
for a := 1 to tcount do begin
DEngine.drawline(ap1.x+(dx*a),ap1.y-3,ap1.x+(dx*a),ap1.y+3,clLime,1,0,0);
end;
end;
dy := ap3.y-ap1.y;
if dy <> 0 then begin
tcount := Round(abs(ap5.y-ap1.y) / abs(dy));
for a := 1 to tcount do begin
DEngine.drawline(ap1.x-3,ap1.y+(dy*a),ap1.x+3,ap1.y+(dy*a),clLime,1,0,0);
end;
end;
end;
function TArrayRect.ShadowClick(ClickIndex:Integer; x,y: Double): Boolean;
begin
result := false;
if clickindex = 2 then begin
actualpoints[2] := DoublePoint(x,y);
actualpoints[4] := DoublePoint(x,y);
end else if clickindex = 3 then begin
actualpoints[3] := DoublePoint(x,y);
actualpoints[5] := DoublePoint(x,y);
end else if clickindex = 4 then begin
actualpoints[4] := DoublePoint(x,y);
end else if clickindex = 5 then begin
actualpoints[5] := DoublePoint(x,y);
result := true;
end;
end;
class function TArrayRect.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
a1,a2,r: Double;
p1,p2,p3,p4,p5: TDoublePoint;
dx,dy: Double;
col,row: integer;
begin
col := 0;row:= 0;
cad := TPCDrawing(aOwner);
p1 := shadow.actualpoints[1];
p2 := shadow.actualpoints[2];
p3 := shadow.actualpoints[3];
p4 := shadow.actualpoints[4];
p5 := shadow.actualpoints[5];
dx := p2.x-p1.x;
if dx <> 0 then col := Round(abs(p4.x-p1.x) / abs(dx));
dy := p3.y-p1.y;
if dy <> 0 then row := Round(abs(p5.y-p1.y) / abs(dy));
cad.ArrayRectSelection(dx,dy,col+1,row+1);
result := nil;
end;
function TArrayRect.ShadowTrace(ClickIndex:Integer; x, y: Double): Boolean;
begin
if clickindex = 1 then begin
actualpoints[2] := DoublePoint(x,y);
actualpoints[4] := DoublePoint(x,y);
end else if clickindex = 2 then begin
actualpoints[3] := DoublePoint(x,y);
actualpoints[5] := DoublePoint(x,y);
end else if clickindex = 3 then begin
actualpoints[4] := DoublePoint(x,y);
end else if clickindex = 4 then begin
actualpoints[5] := DoublePoint(x,y);
end;
end;
{ TRichText }
constructor TRichText.create(aX1, aY1, aX2, aY2:Double; w, s, c, abrs, abrc,
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent; AText: Boolean=true);
begin
inherited create(aX1, aY1, aX2, aY2, w, s, c, abrs, abrc, LHandle, aDrawStyle, aOwner);
if AText then //11.10.2011
re.Lines.Add(cDrawObjects_Mes7);
// Initialize;
// Tolik 24/03/2017 --
{ Self.Lines := nil;
Self.frm := nil;}
//
end;
class function TRichText.ShadowType: TShadowType;
begin
result := stRectangle;
end;
procedure TRichText.Initialize;
var
fCanvas: TMetaFileCanvas;
xLines: TStringList;
begin
inherited;
pointcount := 4;
frm := nil;
ShowGuide := True;
TagParse := False;
if owner <> nil then
begin
//GProcCnt := GProcCnt + 1;
if owner is TPowerCad then
begin
TPowerCad(owner).DisableAlign;
end;
try
re := TRichEdit98.Create(owner);
re.IncludeOLE := True;
re.visible := false;
re.Font.Size := 8;
{//02.11.2011}
if assigned(TPCDrawing(owner).parent) then
begin
if (owner <> nil) and (owner.ClassName = 'TPowerCad') then
re.Parent := TPowerCad(owner)
else
if (owner <> nil) and (owner.ClassName = 'TPCDrawing') then
re.Parent := TPCDrawing(owner);
end
else
begin
frm := TFrmInput.Create(application);
re.Parent := frm;
end;
re.Perform(WM_PAINT,0,0);
ttMetaFile:= TMetaFile.Create;
ttMetafile.Enhanced := True;
fCanvas := TMetafileCanvas.Create(ttMetafile, 0);
TPCDrawing(Owner).DEngine.DrawRTFToCanvas(re, 1, 1,ttMetafile.Width - 3, ttMetafile.Height - 3, fCanvas, false);
fCanvas.Free;
//Tolik 13/01/2017 - -
ttMetaFile.Free;
ttMetaFile := nil;
//FreeAndNil(fCanvas);
//MetaFile.Free;
Lines := Tstringlist.Create;
FontName := 'Arial';
FontSize := 12;
FontStyle := [];
finally
if owner is TPowerCad then
begin
//TPowerCad(owner).EnableAlign;
if owner.Owner is TForm then
begin
TForm(owner.Owner).DisableAlign;
TPowerCad(owner).EnableAlign;
TForm(owner.Owner).ControlState := TForm(owner.Owner).ControlState - [csAlignmentNeeded];
TForm(owner.Owner).EnableAlign;
end
else
TPowerCad(owner).EnableAlign;
end;
end;
end;
end;
Function TRichText.Edit: Boolean;
var
cad: TPCDrawing;
EditForm: TfrmRichEdit;
xStream: TMemorystream;
xStream2: TMemorystream;
SelChange: TNotifyEvent; // Tolik 05/10/2021 --
begin
result := false;
if assigned(re) and assigned (owner) then
begin
EditForm := TFrmRichEdit.Create(owner);
EditForm.Caption := cDrawObjects_Mes8;
xStream := TmemoryStream.Create;
// Tolik 24/02/2020 --
GetRTFSelection(TRichEdit(re), xStream);
//re.Lines.SaveToStream(xStream);
//
xStream.Position := 0;
//Tolik
SelChange := EditForm.RichEdit1.OnSelectionChange;
EditForm.RichEdit1.OnSelectionChange := nil;
//
//EditForm.RichEdit1.Lines.LoadFromStream(xStream);
//Tolik 05/10/2021 --
//EditForm.RichEdit1.Lines.LoadFromStream(xStream, nil );
//
EditForm.fStream := xStream;
EditForm.RichEdit1.Font.Name := re.Font.Name;
if EditForm.RichEdit1.Font.Name = 'GOST' then
EditForm.RichEdit1.Font.Charset := 204;
//
EditForm.RichEdit1.OnSelectionChange := SelChange; // Tolik 05/10/2021 --
//xStream.Free;
EditForm.RichEdit1.OnChange := EditForm.onTextChange; // Tolik 10/03/2020 --
if EditForm.ShowModal = mrOk then
begin
xStream2 := TmemoryStream.Create;
//EditForm.RichEdit1.Lines.SavetoStream(xStream);
GetRTFSelection(TRichEdit(EditForm.RichEdit1) ,xStream2);
xStream2.Position := 0;
re.Lines.LoadFromStream(xStream2);
xStream2.Free;
if Editform.TextChangesCount > 0 then // Tolik -- 10/03/2020 --
SetProjectChanged(true);
end;
xStream.Free;
Editform.free;
result := true;
end;
end;
procedure TRichText.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor,bcolor : Tcolor;
points: TDoublePointArr;
cad: TPCDrawing;
dx,dy: double;
w,h: extended;
wi,hi: Integer;
fCanvas:TMetaFileCanvas;
a,cnt,i,pCnt: integer;
tw,th:Integer;
twd,thd:Double;
xLines: TStringList;
tp1: TPoint;
mLine: Boolean;
region: HRGN;
np: Boolean;
oldcolor: TColor; // Tolik 01/11/2021 --
xstream: TMemoryStream;
re_Change, re_SelChange: TNotifyEvent;
se_Change: TNotifyEvent;
begin
region := 1;
//Tolik 01/11/2021 --
//acolor := color;
acolor := re.SelAttributes.color;
//
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then
begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then
begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.Canvas.Pen.Mode := pmXor
else
DEngine.Canvas.Pen.Mode := pmCopy;
SetLength(points,4);
points[0] := ap1;
points[1] := ap2;
points[2] := ap3;
points[3] := ap4;
if DrawStyle = dsTrace then
begin
DEngine.drawpolygon(points,acolor,width,style,bcolor,ord(bsClear),RegHandle);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
exit;
end;
cad := TPCdrawing(Owner);
tp1 := Point(0,0);
// Tolik -- 13/01/2017 --
ttMetaFile:= TMetaFile.Create;
ttMetafile.Enhanced := True;
//
if (TagParse) and (assigned(owner)) and (assigned(ttmetafile)) then
begin
w := GetLineLenght(ap1,ap2);
h := GetLineLenght(ap1,ap4);
hi := round(h * 4)+1;
wi := round(w * 4)+1;
ttMetafile.Height := hi;
ttMetafile.Width := wi;
fCanvas := TMetafileCanvas.Create(ttMetafile, 0);
ttMetafile.Height := hi;
ttMetafile.Width := wi;
//çäåñü Region = 1òàê ÷òî íîâûé îáúåêò íå ñîçäàåòñÿ, ïðîñòî íàðèñóåòñÿ (Tolik)
//Tolik 01/11/2021 --
// DEngine.DrawMTextToCanvas(tp1, Lines, FontName, FontStyle, Color{clBlack}, FontSize, 0, 0, 0, 0, Region, tw, th, fCanvas);
DEngine.DrawMTextToCanvas(tp1, Lines, FontName, FontStyle, aColor{clBlack}, FontSize, 0, 0, 0, 0, Region, tw, th, fCanvas);
//
twd := tw / 4;
thd := th / 4;
actualpoints[2] := DoublePoint(ap1.x + twd, ap1.y);
actualpoints[3] := DoublePoint(ap4.x + twd, ap4.y);
mLine := False;
if th > hi then begin
thd := 0;
mLine := True;
xLines := TstringList.Create;
cnt := Lines.Count;
pCnt := Trunc(hi / (th/cnt))-1;
tp1 := Point(0,0);
for i := 0 to cnt-1 do
begin
xLines.Add(Lines[i]);
np := Pos('<NP>',lines[i]) >0;
if (xLines.Count = pCnt) or (i = cnt-1) or np then begin
DEngine.DrawMTextToCanvas(tp1,xLines,FontName,FontStyle,Color{clBlack},FontSize,0,0,0,0,Region,tw,th,fCanvas);
tp1.x := tp1.x+tw+6;
xLines.Clear;
end;
end;
tw := tp1.x;
twd := tw/4;
thd := thd/4;
actualpoints[2] := DoublePoint(ap1.x+twd,ap1.y);
actualpoints[3] := DoublePoint(ap4.x+twd,ap4.y);
end else begin
actualpoints[3] := DoublePoint(ap3.x,ap2.y+thd);
actualpoints[4] := DoublePoint(ap4.x,ap1.y+thd);
end;
fCanvas.free;
w := GetLineLenght(ap1,ap2);
h := GetLineLenght(ap1,ap4);
hi := round(h * 4)+1;
wi := round(w * 4)+1;
ttMetafile.Height := hi;
ttMetafile.Width := wi;
fCanvas := TMetafileCanvas.Create(ttMetafile, 0);
ttMetafile.Height := hi;
ttMetafile.Width := wi;
if mLine then begin
tp1 := Point(0,0);
thd := 0;
for i := 0 to cnt-1 do
begin
xLines.Add(Lines[i]);
np := Pos('<NP>',lines[i]) >0;
if (xLines.Count = pCnt) or (i = cnt-1) or np then begin
DEngine.DrawMTextToCanvas(tp1,xLines,FontName,FontStyle,Color{clBlack},FontSize,0,0,0,0,Region,tw,th,fCanvas);
tp1.x := tp1.x+tw+6;
if th > thd then thd := th;
xLines.Clear;
end;
end;
xLines.Free;
thd := thd/4;
//actualpoints[3] := DoublePoint(ap3.x,ap2.y+thd);
//actualpoints[4] := DoublePoint(ap4.x,ap1.y+thd);
end
else
begin
DEngine.DrawMTextToCanvas(tp1,Lines,FontName,FontStyle,Color{clBlack},FontSize,0,0,0,0,Region,tw,th,fCanvas);
end;
fCanvas.free;
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then
DEngine.DrawMetafile(ap1,ap2,ap3,ap4,clWhite,0,ord(psClear),ttMetafile,true,RegHandle)
else
DEngine.DrawTransparentMetafile(ap1,ap2,ap3,ap4,clWhite,0,ord(psClear),ttMetafile,RegHandle);
if Dengine.isPrinting then
begin
try
ttMetafile.SaveToFile('c:\baca.wmf');
except
end;
end;
end
else
begin
if ttMetafile = nil then
begin
ttMetaFile:= TMetaFile.Create;
ttMetafile.Enhanced := True;
end;
if assigned(re) and assigned(owner) and assigned(ttmetafile) then
begin
w := GetLineLenght(ap1, ap2);
h := GetLineLenght(ap1, ap4);
ttMetafile.Height := round(h * 4) + 1;
ttMetafile.Width := round(w * 4) + 1;
fCanvas := TMetafileCanvas.Create(ttMetafile, 0);
ttMetafile.Height := round(h * 4) + 1;
ttMetafile.Width := round(w * 4) + 1;
//Tolik 02/11/2021 -- åñëè îòòåíêè ñåðîãî
if isGrayed then
begin
xstream := tMemoryStream.Create;
re_Change := re.OnChange;
re.OnChange := nil;
re_SelChange := re.OnSelectionChange;
re.OnSelectionChange := nil;
GetRTFSelection(TRichEdit(re), xStream);
re.SelectAll;
//re.Font.Color := GCadForm.PCad.FGrayedColor;
re.SelAttributes.Color := GCadForm.PCad.FGrayedColor;
end;
//
DEngine.DrawRTFToCanvas(re, 1, 1, ttMetafile.Width-3, ttMetafile.Height-3, fCanvas, false);
//
fCanvas.Free;
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then
DEngine.DrawMetafile(ap1, ap2, ap3, ap4, clWhite, 0, ord(psClear), ttMetafile, true, RegHandle)
//DEngine.DrawMetafile(ap1, ap2, ap3, ap4, aColor, 0, ord(psClear), ttMetafile, true, RegHandle)
else
DEngine.DrawTransparentMetafile(ap1, ap2, ap3, ap4, clWhite, 0, ord(psClear), ttMetafile, RegHandle);
//Tolik 02/11/2021 --
if isGrayed then
begin
xStream.Position := 0;
re.Lines.LoadFromStream(xStream);
re.OnChange := re_Change;
re.OnSelectionChange := re_SelChange;
xStream.Free;
end;
//
end;
end;
// Tolik 24/05/2019 --
SetLength(points, 0);
//
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
ttMetaFile.Free;
ttMetafile := nil;
//
end;
class function TRichText.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
x1,y1,x2,y2: Double;
p1,p2,p3,p4: TDoublePoint;
begin
cad := TPCDrawing(aOwner);
x1 := Shadow.ap1.x;
x2 := Shadow.ap3.x;
y1 := Shadow.ap1.y;
y2 := Shadow.ap3.y;
result := TRichText.create( x1,y1,x2,y2,
cad.DefaultPenWidth,
ord(Cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(Cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
end;
function TRichText.isPointIn(x,y:Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then
exit;
result := IsPointInRegion(x,y);
//Tolik
Result := IsPointInRegionByRegObj(x,y);
//
end;
Procedure TRichText.Rotate(aAngle: Double; cPoint: TDoublePoint);
begin
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then
inherited;
end;
Procedure TRichText.Mirror(Point1,Point2: TDoublePoint);
begin
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then
inherited;
end;
Destructor TRichText.Destroy;
begin
if (owner <> nil) and (owner is TPowerCad) then
TPowerCad(owner).DisableAlign;
try
if assigned(re) then
begin
FreeAndNil(re);
end;
{ if assigned(metafile) then
// metafile.free;
FreeAndNil(MetaFile); }
{ if assigned(frm) then
//frm.free;
FreeAndNil(frm);
// Tolik
if self.Lines <> nil then
Self.Lines.Free;}
//
finally
if (owner <> nil) and (owner is TPowerCad) then
begin
if owner.Owner is TForm then
begin
TForm(owner.Owner).DisableAlign;
TPowerCad(owner).EnableAlign;
TForm(owner.Owner).ControlState := TForm(owner.Owner).ControlState - [csAlignmentNeeded];
TForm(owner.Owner).EnableAlign;
end
else
TPowerCad(owner).EnableAlign;
end;
end;
// Tolik 24/05/2019 --
FreeAndNil(Lines);
//
inherited destroy;
end;
// Tolik 23/05/2019 -- ñòàðàÿ çàêîììåí÷åíà - ñì. íèæå
procedure TRichText.WriteToStream(Stream: TStream);
var xStream : TMemoryStream;
xSize: integer;
xCode: Byte;
begin
inherited;
xStream := TMemoryStream.Create;
//re.SelectAll;
GetRTFSelection(TRichEdit(re), xStream);
xSize := xStream.Size;
xStream.Position := 0;
xCode := 150;
Stream.Write(xCode,1);
Stream.Write(xSize,4);
StreamToStream(xStream,Stream,xSize);
xStream.Free;
WriteField(91, Stream, ShowGuide, 1);
end;
{
procedure TRichText.WriteToStream(Stream: TStream);
var xStream : TMemoryStream;
xSize: integer;
xCode: Byte;
begin
inherited;
xStream := TMemoryStream.Create;
// try
re.Lines.SaveToStream(xStream);
//except
//on E: Exception do
// ShowMessage('Error Writting TRichTextMod to Stream!' + ' re.Text = ' + re.Lines.Text);
//end;
//re.WideLines.SaveToStream(xStream);
xSize := xStream.Size;
xStream.Position := 0;
xCode := 150;
Stream.Write(xCode,1);
Stream.Write(xSize,4);
StreamToStream(xStream,Stream,xSize);
xStream.Free;
WriteField(91, Stream, ShowGuide, 1);
// WriteField(34, Stream, re.Font.color, 4);
end;
}
{
procedure TRichText.WriteToStream(Stream: TStream);
var xStream : TMemoryStream;
xSize: integer;
xCode: Byte;
begin
inherited;
xStream := TMemoryStream.Create;
re.Lines.SaveToStream(xStream);
//re.WideLines.SaveToStream(xStream);
xSize := xStream.Size;
xStream.Position := 0;
xCode := 150;
Stream.Write(xCode,1);
Stream.Write(xSize,4);
StreamToStream(xStream,Stream,xSize);
xStream.Free;
WriteField(91, Stream, ShowGuide, 1);
// WriteField(34, Stream, re.Font.color, 4);
end;
}
// Tolik 24/05/2019 - - ñòàðàÿ çàêîììåí÷åíà - - ñì íèæå
procedure TRichText.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var mstr:TMemoryStream;
//Tolik 01/04/2019
i: Integer;
aList: TStringList;
ss: AnsiString;
ttColor: TColor;
//
begin
Case xcode of
150: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
PutRTFSelection(TRichEdit(re), mStr);
mStr.Free;
end;
91 : ShowGuide := (pByte(data)^ = 1);
// 34 : re.Font.color := pInt(data)^;
end;
end;
(*
procedure TRichText.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
var mstr:TMemoryStream;
//Tolik 01/04/2019
i: Integer;
aList: TStringList;
ss: AnsiString;
ttColor: TColor;
//
begin
Case xcode of
150: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
re.Lines.LoadFromStream(mStr);
//re.WideLines.LoadFromStream(mStr);
mStr.Free;
// Tolik 01/04/2019 -- correction
// Çäåñü áûëà ïîïûòêà èñïðàâèòü ñòðî÷êè, ò.ê. â lines ïðèõîäèë ìóñîð èç-çà òîãî, ÷òî
// ÷èòàåòñÿ WideLines è íåïðàâèëüíî êîíâåðòèðîâàëîñü â ñòðîêè
// â function TRichEditStrings98.Get(Index: Integer): string;
// begin
// Result:= WideToChar(TWideRichEditStrings98(RichEdit.WideLines).Get(Index), RichEdit.FCP);
// WideToChar âîçâðàùàë string à íóæíî AnsiString
{
for i := 0 to re.WideLines.Count - 1 do
begin
if re.Lines.Count < (i + 1) then
re.Lines.Add(AnsiString(aList.Strings[i]))
else
re.Lines[i] := AnsiString(re.WideLines[i]);
end;
i := re.WideLines.Count;
while re.Lines.Count > re.WideLines.Count do
re.Lines.Delete(i - 1);
}
//
end;
91 : ShowGuide := (pByte(data)^ = 1);
// 34 : re.Font.color := pInt(data)^;
end;
end;
*)
function TRichText.duplicate: TFigure;
var Res: TRichText;
xStream: TmemoryStream;
begin
res := TRichText.create( originalpoints[1].x,
originalpoints[1].y,
originalpoints[3].x,
originalpoints[3].y,
width,
style,
color,
brs,
brc,
LayerHandle,
DrawStyle,Owner);
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.originalpoints[4] := originalpoints[4];
xStream := TMemoryStream.Create;
// Tolik 24/02/2020 --
//re.Lines.SaveToStream(xStream);
GetRTFSelection(TRichEdit(re), xStream);
xStream.Position := 0;
//
xStream.Position := 0;
res.re.Lines.LoadFromStream(xStream);
xStream.Free;
res.AngleToPoint := AngleToPoint;
res.RotPoint := RotPoint;
result := res;
end;
procedure TRichText.DrawFigureGuides(DEngine: TPCDrawEngine);
var points: TDoublePointArr;
begin
inherited;
if DrawStyle = dsTrace then
Exit;
if not ShowGuide then
exit;
SetLength(points,4);
points[0] := ap1;
points[1] := ap2;
points[2] := ap3;
points[3] := ap4;
DEngine.canvas.pen.mode := pmCopy;
// DEngine.drawpolygon(points,clRed,1,1,0,ord(bsClear),RegHandle);
// Tolik 24/05/2019- -
SetLength(points, 0);
//
end;
function TRichText.GetClassName: String;
begin
result := 'RichText';
end;
constructor TRichText.createEx(aX1, aY1, aX2, aY2: Double; w, s, c, abrs,
abrc: integer; Lines, FontName: String; FontSize, LHandle: Integer;
aDrawStyle: TDrawStyle; aOwner: TComponent);
var fCanvas:TMetaFileCanvas;
xList: TStringList;
xStr:TMemoryStream;
begin
inherited create(aX1, aY1, aX2, aY2, w, s, c, abrs, abrc, LHandle, aDrawStyle, aOwner);
if owner <> nil then
begin
re.Font.Size := FontSize;
re.Font.Name := FontName;
re.Perform(WM_PAINT,0,0);
xList := TStringList.Create;
xList.Text := Lines;
xStr := TMemoryStream.Create;
xList.SaveToStream(xStr);
xStr.Position := 0;
re.Lines.LoadFromStream(xStr);
xStr.Free;
xList.Free;
// Tolik -- 13/01/2017 --
ttMetaFile:= TMetaFile.Create;
ttMetafile.Enhanced := True;
//
fCanvas := TMetafileCanvas.Create(ttMetafile, 0);
TPCDrawing(Owner).DEngine.DrawRTFToCanvas(re, 1, 1, ttMetafile.Width - 3, ttMetafile.Height - 3, fCanvas, false);
fCanvas.Free;
// Tolik -- 13/01/2017 --
ttMetaFile.Free;
ttMetafile := Nil;
//
end;
// Tolik 24/03/2017 --
{ Self.Lines := nil;
Self.Frm := nil;}
//
end;
procedure TRichText.CheckAndChangeFont;
var
size: integer;
i, j, k: Integer;
NotesList: TStringList;
LHandle: Integer;
TM: TTextMetric;
xCanvas: TMetafileCanvas;
h, w: double;
TextX, TextY: double;
begin
// size := re.Font.Size;
TextX := abs(ap1.x - ap2.x);
TextY := abs(ap1.y - ap3.y);
// for k := size downto 1 do
// begin
// re.Font.Size := k;
// ïîëó÷èòü ñâîéñòâà
// Tolik -- 13/01/2017 --
ttMetaFile:= TMetaFile.Create;
ttMetafile.Enhanced := True;
//
xCanvas := TMetafileCanvas.Create(ttMetafile, 0);
// xCanvas.Font.Name := re.Font.Name;
// xCanvas.Font.Size := re.Font.Size;
GetTextMetrics(xCanvas.Handle, TM);
h := TM.tmHeight / 4 * re.Lines.Count + 1;
w := 0;
for i := 0 to re.Lines.Count - 1 do
begin
if w < xCanvas.TextWidth(Re.Lines[i]) then
w := xCanvas.TextWidth(Re.Lines[i]);
end;
w := (w + 3) / 4 ;
FreeAndNil(xCanvas);
// Tolik -- 13/01/2017
ttMetaFile.Free;
ttMetafile := Nil;
//
if (k = 1) or (w < TextX) and (h < TextY) then
begin
// Break;
end;
// end;
end;
{ TOLEObject }
constructor TOleObject.create(aX1, aY1, aX2, aY2:Double;w, s, c, abrs, abrc,
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
inherited create(ax1,ay1,ax2,ay2,w,s,c,abrs,abrc,LHandle,aDrawStyle,aOwner);
//initialize; it is already called from trectangle.create
end;
class function TOleObject.ShadowType:TShadowType;
begin
result := stRectangle;
end;
procedure TOLEObject.Initialize;
begin
inherited;
pointcount := 4;
if owner <> nil then begin
ole := TMFSOle.Create(owner);
ole.name := self.Name;
ole.visible := false;
ole.Parent := TPCDrawing(owner);
MetaFile:= TMetaFile.Create;
Metafile.Enhanced := True;
end;
end;
Function TOleObject.Edit: Boolean;
var
a: integer;
v: string;
idx: integer;
begin
result := false;
if assigned(ole) and assigned (owner) then begin
if ole.OleObjectInterface = nil then
begin
try
if ole.InsertObjectDialog then begin
idx := -1;
for a := 0 to ole.objectVerbs.Count -1 do begin
v := ole.objectVerbs[a];
if v = 'Open' then idx := a;
end;
if idx > -1 then ole.DoVerb(idx) else ole.DoVerb(0);
result := true;
ole.Refresh;
end;
except result := false; end;
end
else begin
try
idx := -1;
for a := 0 to ole.objectVerbs.Count -1 do begin
v := ole.objectVerbs[a];
if v = 'Open' then idx := a;
end;
if idx > -1 then ole.DoVerb(idx) else ole.DoVerb(0);
result := true;
ole.Refresh;
except result := false;end;
end;
end;
end;
procedure TOleObject.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor,bcolor : Tcolor;
points:Array of TPoint;
dx,dy: Double;
w,h: extended;
fCanvas:TMetaFileCanvas;
begin
if DrawStyle = dsTrace then begin
inherited;
exit;
end;
if assigned(ole) and assigned(owner) and assigned(metafile) then begin
w := GetLineLenght(ap1,ap2);
h := GetLineLenght(ap1,ap4);
Metafile.Height := round(h * 4)+1;
Metafile.Width := round(w * 4)+1;
fCanvas := TMetafileCanvas.Create(Metafile, 0);
DEngine.DrawOleToCanvas(ole,1,1,Metafile.Width-3,Metafile.Height-3,fCanvas,false);
fCanvas.Free;
DEngine.DrawMetafile(ap1,ap2,ap3,ap4,clWhite,0,ord(psClear),Metafile,true,RegHandle);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
end;
class function TOleObject.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TOleObject.create(shadow.ap1.x,shadow.ap1.y,
shadow.ap3.x,shadow.ap3.y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
end;
function TOleObject.isPointIn(x,y:Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := IsPointInRegion(x,y);
//Tolik
Result := IsPointInRegionByRegObj(x,y);
//
end;
Procedure TOleObject.Rotate(aAngle: Double; cPoint: TDoublePoint);
begin
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then inherited;
end;
Procedure TOleObject.Mirror(Point1,Point2: TDoublePoint);
begin
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then inherited;
end;
Destructor TOleObject.Destroy;
begin
if assigned(ole) then ole.Free;
if assigned(metafile) then metafile.free;
inherited destroy;
end;
procedure TOLEObject.WriteToStream(Stream: TStream);
var xStream : TMemoryStream;
xSize: integer;
xCode: Byte;
begin
inherited;
if (ole.State <> osEmpty) then
begin
xStream := TMemoryStream.Create;
ole.SaveToStream(xStream);
xSize := xStream.Size;
xStream.Position := 0;
WriteStreamField(150,Stream,xStream);
xStream.Free;
end;
end;
procedure TOLEObject.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
var mStr:TMemoryStream;
begin
Case xcode of
150: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
ole.LoadFromStream(mStr);
mStr.Free;
end;
end;
end;
function TOleObject.duplicate: TFigure;
var Res: TOleObject;
xStream: TmemoryStream;
begin
res := TOleObject.create( originalpoints[1].x,
originalpoints[1].y,
originalpoints[3].x,
originalpoints[3].y,
width,
style,
color,
brs,
brc,
LayerHandle,
DrawStyle,Owner);
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.originalpoints[4] := originalpoints[4];
xStream := TMemoryStream.Create;
ole.SaveToStream(xStream);
xStream.Position := 0;
res.ole.LoadFromStream(xStream);
xStream.Free;
res.AngleToPoint := AngleToPoint;
res.RotPoint := RotPoint;
result := res;
end;
procedure TOleObject.DrawFigureGuides(DEngine: TPCDrawEngine);
var points: TDoublePointArr;
begin
inherited;
if DrawStyle = dsTrace then Exit;
SetLength(points,4);
points[0] := ap1;
points[1] := ap2;
points[2] := ap3;
points[3] := ap4;
DEngine.canvas.pen.mode := pmCopy;
DEngine.drawpolygon(points,clRed,1,1,0,ord(bsClear),RegHandle);
// Tolik 24/05/2019--
SetLength(Points, 0);
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TOLEObject.GetClassName: String;
begin
result := 'OLEObject';
end;
{ TMathGraph }
constructor TMathGraph.create(aX1, aY1, aX2, aY2:Double; w, s, c, abrs, abrc,
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
inherited;
originalpoints[5] := MPoint(ap1,ap3);
actualpoints[5] := originalpoints[5];
end;
class function TMathGraph.ShadowType:TShadowType;
begin
result := stRectangle;
end;
Procedure TMathGraph.SetOriginToCenter;
begin
originalpoints[5] := MPoint(ap1,ap3);
actualpoints[5] := MPoint(ap1,ap3);
orgCenter := true;
end;
procedure TMathGraph.Initialize;
begin
inherited;
pointcount := 5;
source := '';
Source := 'Sin(x)';
UnitSize := 8;
BorderColor := Color;
BorderStyle := Style;
BorderWidth := Width;
AxisColor := Color;
AxisStyle := Style;
AxisWidth := Width;
OrgCenter := True;
ScaleStyle := gsBoth;
PolarScale := False;
ScaleColor := Color;
NumStep := 1;
end;
function TMathGraph.CreateModification: TFigure;
var res: TMathGraph;
begin
res := TMathGraph.create(ap1.x,ap1.y,
ap3.x,ap3.y,
1,1,clLime,1,clWhite,0,dsTrace,nil);
res.actualpoints[1] := ap1;
res.actualpoints[2] := ap2;
res.actualpoints[3] := ap3;
res.actualpoints[4] := ap4;
res.actualpoints[5] := actualpoints[5];
res.RotPoint := RotPoint;
CreateModification := res;
end;
destructor TMathGraph.Destroy;
begin
inherited;
end;
procedure TMathGraph.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var points: TDoublePointArr;
aColor,bColor: integer;
dNum,dTick: Boolean;
ap5: TDoublePoint;
begin
if DrawStyle = dsTrace then DEngine.Canvas.Pen.Mode := pmXor
else DEngine.Canvas.Pen.Mode := pmCopy;
ap5 := actualpoints[5];
acolor := BorderColor;
bColor := brc;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
GetPointArray(points,4);
DEngine.drawpolygon(points,acolor,BorderWidth,BorderStyle,bcolor,brs,RegHandle);
acolor := AxisColor;
if (isGrayed) then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
DEngine.drawline(ap1.x,ap5.y,ap2.x,ap5.y,acolor,AxisWidth,AxisStyle,0);
DEngine.drawline(ap5.x,ap1.y,ap5.x,ap3.y,acolor,AxisWidth,AxisStyle,0);
if (drawStyle = mydsNormal) and (source <> '') then begin
acolor := color;
if (isGrayed) then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
dNum := False; dTick := False;
if ScaleStyle = gsNumbers then dNum := True
else if ScaleStyle = gsTick then dTick := True
else if ScaleStyle = gsBoth then
begin
dNum := True;
dTick := True;
end;
Dengine.DrawMathGraph(DoubleRect(ap1.x,ap1.y,ap3.x,ap3.y),ap5.x,ap5.y,acolor,
width,style,ScaleColor,UnitSize,Source,dTick,dNum,PolarScale,NumStep);
end;
//Tolik 24/05/2019 --
SetLength(Points, 0);
//
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TMathGraph.DrawFigureGuides(DEngine: TPCDrawEngine);
begin
inherited;
end;
function TMathGraph.duplicate: TFigure;
begin
end;
function TMathGraph.edit: Boolean;
var enterstr: string;
begin
Result := False;
EnterStr := Source;
// if InputQuery(capMathGraphSource, msEnterFunction , EnterStr) then
if InputQuery(cDrawObjects_Mes9, cDrawObjects_Mes10, EnterStr) then
begin
Source := EnterStr;
result := true;
end;
end;
function TMathGraph.isPointIn(x, y: Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := isPointInRegion(x,y);
//Tolik
Result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TMathGraph.mirror(Point1, Point2: TDoublePoint);
begin
// No mirror
end;
procedure TMathGraph.rotate(aAngle: Double; cPoint: TDoublePoint);
begin
//No Rotate
end;
class function TMathGraph.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TMathGraph.create(shadow.ap1.x,shadow.ap1.y,
shadow.ap3.x,shadow.ap3.y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
end;
procedure TMathGraph.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
// Tolik 22/11/2019 --
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(90,Stream,xByte,1);
// Tolik 22/11/2019 --
if AxisStyle = -1 then
xByte := 255
else
xByte := LoByte(LoWord(AxisStyle));
//xByte := AxisStyle;
//
WriteField(91,Stream,xByte,1);
if BorderStyle = -1 then
xByte := 255
else
xByte := LoByte(LoWord(BorderStyle));
//
WriteField(92,Stream,xByte,1);
xByte := ord(ScaleStyle);
WriteField(93,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xInt := AxisColor;
WriteField(21,Stream,xInt,4);
xInt := BorderColor;
WriteField(22,Stream,xInt,4);
xInt := AxisWidth;
WriteField(23,Stream,xInt,4);
xInt := BorderWidth;
WriteField(24,Stream,xInt,4);
xDbl := UnitSize;
WriteField(220,Stream,xDbl,8);
xInt := ScaleColor;
WriteField(26,Stream,xInt,4);
xInt := NumStep;
WriteField(27,Stream,xInt,4);
xStr := Source;
WriteStrField(180,Stream,xStr);
end;
procedure TMathGraph.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
Case xcode of
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
91:
begin
if pByte(data)^ = 255 then
AxisStyle := -1
else
AxisStyle := pByte(data)^;
end;
92:
begin
if pByte(data)^ = 255 then
BorderStyle := -1
else
BorderStyle := pByte(data)^;
end;
93: ScaleStyle := TMGScaleStyle(pByte(data)^);
20: brc := pInt(data)^;
21: AxisColor := pInt(data)^;
22: BorderColor := pInt(data)^;
23: AxisWidth := pInt(data)^;
24: BorderWidth := pInt(data)^;
25: UnitSize := pInt(data)^/10;
26: ScaleColor := pInt(data)^;
27: NumStep := pInt(data)^;
180: Source := String(pchar(data));
220: UnitSize := pDouble(data)^;
end;
end;
procedure TMathGraph.GetModPoints(ModList: TMyList);
var
CControl: TPCDrawing;
ap5,MT,MR,MB,ML : TDoublePoint;
begin
CControl := TPCDrawing(Owner);
ap5 := actualpoints[5];
MT := MPoint(ap1,ap2);
MR := MPoint(ap2,ap3);
MB := MPoint(ap3,ap4);
ML := MPoint(ap4,ap1);
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MT.x,MT.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap2.x,ap2.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MR.x,MR.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap3.x,ap3.y,5));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,MB.x,MB.y,6));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ap4.x,ap4.y,7));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptRect,clBlue,PointDim,ML.x,ML.y,8));
ModList.Add(CControl.RegisterModPoint(self,ptRectPoint,ptCircle,clRed,PointDim-1,ap5.x,ap5.y,9));
end;
function TMathGraph.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x,y: Double;Shift: TShiftState): boolean;
begin
inherited TraceModification(CadControl,mp,TraceFigure,x,y,shift);
if mp.SeqNbr = 9 then
begin
TraceFigure.ActualPoints[5] := DoublePoint(x,y);
OrgCenter := False;
end;
if OrgCenter then TmathGraph(TraceFigure).SetOriginToCenter;
end;
procedure TMathGraph.UpdateMenu(var popMenu: TPopUpMenu; var sIndex: Integer);
var mnItem:TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmSetOrigin;
mnItem.Tag := sIndex;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := csZoomIn;
mnItem.Tag := sIndex+1;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := csZoomOut;
mnItem.Tag := sIndex+2;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+3;
end;
procedure TMathGraph.MenuClicked(CommandId: integer);
var mnIdx: integer;
begin
mnIdx := CommandId-MenuIndex;
case mnIdx of
0: SetOriginToCenter;
1: ZoomIn;
2: ZoomOut;
end;
end;
Procedure TMathGraph.ZoomIn;
begin
UnitSize := UnitSize+30;
end;
Procedure TMathGraph.ZoomOut;
begin
UnitSize := UnitSize-30;
if UnitSize < 10 then UnitSize := 10;
end;
(*
procedure TMathGraph.RegisterToPropertyPage;
var fPPage: TObjectInspector;
a: integer;
strs: TStringList;
begin
if owner <> nil then begin
fPPage := TPCDrawing(Owner).fPPage;
fPpObject := fPPage.registerObject(name,'MathGraph',self);
fPpObject.ChangeEvent := FigurePropertyChanged;
props[1] := TStringProperty.create('Name',false,name);
props[2] := TIntegerProperty.create('Handle',true,Handle);
props[3] := TStringProperty.create('Source',false,source);
props[4] := TExtendedProperty.create('UnitSize',false,UnitSize);
props[5] := TLineStyleProperty.create('GraphStyle',false,style);
props[6] := TLineWidthProperty.create('GraphWidth',false,width);
props[7] := TColorProperty.create('GraphColor',false,Color);
props[8] := TLineStyleProperty.create('BorderStyle',false,style);
props[9] := TLineWidthProperty.create('BorderWidth',false,width);
props[10] := TColorProperty.create('BorderColor',false,Color);
props[11] := TLineStyleProperty.create('AxisStyle',false,style);
props[12] := TLineWidthProperty.create('AxisWidth',false,width);
props[13] := TColorProperty.create('AxisColor',false,Color);
props[14] := TBrushStyleProperty.create('FillStyle',false,brs);
props[15] := TColorProperty.create('FillColor',false,brc);
props[16] := TColorProperty.create('ScaleColor',false,Color);
props[17] := TIntegerProperty.create('NumberStep',false,NumStep);
strs := TStringList.create;
strs.add ( 'None');
strs.add ( 'Ticks');
strs.add ( 'Numbers');
strs.add ( 'Both');
props[18] := TEnumProperty.create('ScaleStyle',false,strs,ord(ScaleStyle));
props[19] := TBoolProperty.create('PolarScale',false,PolarScale);
for a := 1 to 19 do fPpObject.AddProperty(props[a]);
Strs.Free;
end;
end;
*)
function TMathGraph.GetClassName: String;
begin
result := 'MathGraph';
end;
{ TWMFObject }
constructor TWMFObject.create(X, Y:Double;fName:string;
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
var
Picw,PicH: Double;
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
originalpoints[1] := DoublePoint(x,y);
originalpoints[2] := DoublePoint(x,y);
originalpoints[3] := DoublePoint(x,y);
originalpoints[4] := DoublePoint(x,y);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
if DrawStyle = mydsNormal then
begin
PictureName := extractFileName(fName);
Metafile.loadfromfile(fName);
PicW := Metafile.mmwidth/100;
if horzZero = 1 then PicW := -PicW;
PicH := Metafile.mmHeight/100;
if vertZero = 1 then PicH := -PicH;
originalpoints[2] := DoublePoint(x+PicW,y);
originalpoints[3] := DoublePoint(x+PicW,y-PicH);
originalpoints[4] := DoublePoint(x,y-PicH);
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
end;
end;
destructor TWMFObject.Destroy;
begin
if assigned(metafile) then metafile.free;
inherited destroy;
end;
procedure TWMFObject.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor,bcolor : Tcolor;
points: TDoublePointArr;
cad: TPCDrawing;
dx,dy: Double;
w,h: extended;
fModes: TFlipModes;
begin
acolor := color;
bColor := brc;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then DEngine.Canvas.Pen.Mode := pmXor
else DEngine.Canvas.Pen.Mode := pmCopy;
if assigned(metafile) then begin
GetPointArray(Points);
if (style <> ord(psClear)) or (brs <> ord(bsClear)) then
DEngine.drawpolygon(points,acolor,width,style,bcolor,brs,Reghandle);
DEngine.DrawMetafile(ap1,ap2,ap3,ap4,clWhite,0,ord(psClear),Metafile,true,Reghandle);
end;
//Tolik 24/05/2019 --
SetLength(Points, 0);
//
//Tolik
if RegHandle <> 0 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TWMFObject.duplicate: TFigure;
var
res: TWMFObject;
i: integer;
TempFig: TFigure;
TempPath: string;
//Buffer: array[0..1023] of Char;
Buffer: array[0..MAX_PATH] of Char;
begin
// Tolik 17/05/2019 - -
// SetString(TempPath, Buffer, GetTempPath(Sizeof(Buffer) - 1, Buffer));
SetString(TempPath, Buffer, GetTempPath(MAX_PATH, @Buffer)); // äåëàòü îòàê, à òî åáàíåò îáúåêò â ïàìÿòè...èëè ÷åãî-íèáóäü äðóãîå...íóæíîå
//
MetaFile.SaveToFile(TempPath + 'tempWMF.bmp');
PictureName := TempPath + 'tempWMF.bmp';
res := TWMFObject.create(originalpoints[1].x, originalpoints[1].y,
PictureName, LayerHandle, DrawStyle, Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.originalpoints[1] := originalpoints[1];
res.actualpoints[2] := actualpoints[2];
res.originalpoints[2] := originalpoints[2];
res.actualpoints[3] := actualpoints[3];
res.originalpoints[3] := originalpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[4] := originalpoints[4];
res.Metafile.Assign(Metafile);
res.rotPoint := rotPoint;
res.AngleToPoint := AngleToPoint;
result := res;
end;
procedure TWMFObject.Initialize;
begin
inherited;
pointcount := 4;
//if owner <> nil then begin
MetaFile:= TMetaFile.Create;
Metafile.Enhanced := True;
//end;
DiagonalScale := True;
width := 1;
color := clBlack;
brc := clSilver;
brs := 1;
Style := 5;
end;
function TWMFObject.isPointIn(x, y: double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := IsPointInRegion(x,y);
//Tolik
Result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TWMFObject.mirror(Point1, Point2: TDoublePoint);
begin
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then inherited;
end;
procedure TWMFObject.Rotate(aAngle: Double; cPoint: TDoublePoint);
begin
if OSVersion.dwPlatformId = VER_PLATFORM_WIN32_NT then inherited;
end;
procedure TWMFObject.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
var mstr:TMemoryStream;
begin
Case xcode of
20: brc := pInt(data)^;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
150: begin
mStr := TMemoryStream.Create;
mStr.Write(pByte(data)^,size);
mStr.Position := 0;
Metafile.LoadFromStream(mStr);
mStr.Free;
end;
180: Picturename := String(pchar(data));
end;
end;
class function TWMFObject.ShadowType: TShadowType;
begin
result := stRectangle;
end;
procedure TWMFObject.WriteToStream(Stream: TStream);
var xByte,xCode,xZero: Byte;
xInt,xSize: Integer;
xStr: String;
xStream: TMemoryStream;
begin
inherited;
xZero := 0;
xStr := PictureName;
WriteStrField(180,Stream,xStr);
//
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//
WriteField(90,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xStream := TMemoryStream.Create;
Metafile.SaveToStream(xStream);
xSize := xStream.Size;
WriteStreamField(150,Stream,xStream);
xStream.Free;
end;
class function TWMFObject.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var OPD : TOpenPictureDialog;
x,y: double;
begin
result := nil;
OPD := TOpenPictureDialog.Create(nil);
OPD.Filter := 'Windows Metafiles (*.emf;*.wmf)|*.emf;*.wmf';
x := shadow.ap1.x;
y := shadow.ap1.y;
if OPD.Execute then
begin
result := TWMFObject.create(x,y,OPD.fileName,Lhandle,mydsNormal,aOwner);
end;
end;
class function TWmfObject.IsOneClick: Boolean;
begin
// normally a rectangle shape is formed with two clicks,
// so we should define that this figure will be created after the first click
result := true;
end;
constructor TWMFObject.createEx(x, y: Double; mf: Tmetafile;
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
var
Picw,PicH: Double;
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
originalpoints[1] := DoublePoint(x,y);
originalpoints[2] := DoublePoint(x,y);
originalpoints[3] := DoublePoint(x,y);
originalpoints[4] := DoublePoint(x,y);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
if DrawStyle = mydsNormal then
begin
PictureName := '';
Metafile.Assign(mf);
PicW := Metafile.mmwidth/100;
if horzZero = 1 then PicW := -PicW;
PicH := Metafile.mmHeight/100;
if vertZero = 1 then PicH := -PicH;
originalpoints[2] := DoublePoint(x+PicW,y);
originalpoints[3] := DoublePoint(x+PicW,y-PicH);
originalpoints[4] := DoublePoint(x,y-PicH);
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
end;
end;
procedure TWMFObject.UpdateMenu(var PopMenu: TPopUpMenu;
var sIndex: integer);
var mnItem,mnSub: TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmCloneAsEdit;
PopMenu.Items.Add(mnItem);
sIndex := SIndex+1;
end;
procedure TWMFObject.MenuClicked(CommandId: integer);
var mnIdx: integer;
begin
mnIdx := commandId-MenuIndex;
case mnIdx of
0: CloneAsEditObjects;
end;
end;
procedure TWMFObject.CloneAsEditObjects;
var Cad:TPCDrawing;
begin
if assigned(Owner) then begin
Cad := TPCDrawing(Owner);
Cad.ImportMetafile(Cad.ActiveLayer,-1,-1,Metafile,True);
end;
end;
function TWMFObject.GetClassName: String;
begin
result := 'WMFObject';
end;
{ TDimLine }
constructor TDimLine.Create(LHandle: Integer; aDrawStyle: TDrawStyle;
aOwner: TComponent);
begin
inherited Create(LHandle,aDrawStyle,aOwner);
initialize;
end;
class function TDimLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
end;
class function TDimLine.CreateShadow(x, y: Double): TFigure;
begin
result := TDimLine.Create(0,dsTrace,nil);
result.ActualPoints[1] := DoublePoint(x,y);
end;
function TDimLine.Duplicate: TFigure;
begin
end;
Function TDimLine.Edit:Boolean;
var
EnterStr: string;
dist, distx, disty: double;
begin
distx := (abs(ap1.x - ap2.x) * MapScale) / 1000;
distx := round(distx * 100) / 100;
disty := (abs(ap1.y - ap2.y) * MapScale) / 1000;
disty := round(disty * 100) / 100;
dist := max(distx, disty);
DLabel := FormatFloat(ffMask, dist);
Result := False;
EnterStr := DLabel;
// EnterStr := FloatToStr(MetreToUOM(StrToFloat_My(EnterStr)));
if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
begin
// EnterStr := FloatToStr(UOMToMetre(StrToFloat_My(EnterStr)));
DLabel := EnterStr;
AutoText := False;
Modified := True;
result := true;
end;
end;
procedure TDimLine.Getbounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
end;
procedure TDimLine.GetModPoints(ModList: TMyList);
var
CControl: TPCDrawing;
begin
CControl := TPCDrawing(Owner);
ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,pointDim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,pointDim,ap2.x,ap2.y,2));
if PointCount > 2 then
ModList.Add(CControl.RegisterModPoint(Self,ptLineEnd,ptRect,clBlue,pointDim,ap3.x,ap3.y,3));
end;
procedure TDimLine.Initialize;
begin
inherited;
PointCount := 3;
Autotext := True;
Dlabel := '';
Prefix := '';
Suffix := '';
TextPos := tpAbove;
MapScale := 1;
if assigned(owner) then
begin
MapScale := TPCDrawing(Owner).MapScale;
end;
TextFont := 'Courier New';
TextHeight:= 4;
TextBold:= False;
TextItalic:= False;
EndType := etRow;
TextColor := clBlack;
Dlabel := 'Label';
end;
function TDimLine.IsPointIn(x, y: Double): boolean;
begin
result := false;
end;
function TDimLine.ModifyTextAndFont(mm: TModifyMode; valueI: Double;
valueS: string; valueSt: TFontStyles; ValueB: Boolean): Boolean;
begin
result := true;
if mm = mmFontName then
begin
TextFont := ValueS;
modified := true;
end
else
if mm = mmFontSize then
begin
TextHeight := valueI;
modified := true;
end
else
if mm = mmFontColor then
begin
TextColor := Round(valueI);
end
else
if mm = mmFontBold then
begin
TextBold := ValueB;
modified := true;
end
else
if mm = mmFontItalic then
begin
TextItalic := ValueB;
modified := true;
end;
end;
// Tolik 04/03/2020 --
Function TDimLine.DefineHStyle(currStyle: THDimLabelStyle): THDimLabelStyle; // ïåðåîïðåäåëèòü ïîëîæåíèå òåêñòà, åñëè äëèíà òåêñòà ïðåâûøàåò äëèíó ñàìîé ëèíèè
var
MetaFile: TMetafile;
FCanvas: TMetafileCanvas;
TxtHeight, Txtwidth, LineWidth: Double;
FontRecord : TLogFont;
TM : TTextMetric;
begin
Result := currStyle;
if GCadForm <> nil then
begin
MetaFile := TMetafile.Create;
FCanvas := TMetafileCanvas.Create(Metafile, 0);
FCanvas.Font.Name := TextFont;
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
TxtHeight := TextHeight * GCadForm.PCad.DotsPerMil * convertRatio;
FontRecord.lfHeight := Round(TxtHeight);
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
GetTextMetrics(FCanvas.Handle,TM);
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
TxtWidth := FCanvas.TextWidth(DLabel + GetUOMString(GCurrProjUnitOfMeasure));
{ FCanvas.Font.Height := Round(TextHeight) + 1;
TxtWidth := FCanvas.TextWidth(DLabel + GetUOMString(GCurrProjUnitOfMeasure));}
LineWidth := ap1.x - ap2.x;
if LineWidth < 0 then
LineWidth := LineWidth * (-1);
LineWidth := LineWidth * GCadForm.PCad.DotsPerMil * convertRatio;
if CompareValue(TxtWidth, LineWidth) > 0 then
Result := hlsRight;
FCanvas.Free;
MetaFile.Free;
end;
end;
Function TDimLine.DefineVStyle(currStyle: TVDimLabelStyle): TVDimLabelStyle; // ïåðåîïðåäåëèòü ïîëîæåíèå òåêñòà, åñëè äëèíà òåêñòà ïðåâûøàåò äëèíó ñàìîé ëèíèè
var
MetaFile: TMetafile;
FCanvas: TMetafileCanvas;
TxtHeight, Txtwidth, LineWidth: Double;
FontRecord : TLogFont;
TM : TTextMetric;
begin
//Result := currStyle;
Result := vlsInner;
MetaFile := TMetafile.Create;
FCanvas := TMetafileCanvas.Create(Metafile, 0);
FCanvas.Font.Name := TextFont;
{FCanvas.Font.Height := Round(TextHeight);
TxtWidth := FCanvas.TextWidth(DLabel + GetUOMString(GCurrProjUnitOfMeasure));}
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
TxtHeight := TextHeight * GCadForm.PCad.DotsPerMil * convertRatio;
FontRecord.lfHeight := Round(TxtHeight);
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
GetTextMetrics(FCanvas.Handle,TM);
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
FontRecord.lfWidth := round(TM.tmAveCharWidth*0.9);
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
TxtWidth := FCanvas.TextWidth(DLabel + GetUOMString(GCurrProjUnitOfMeasure));
LineWidth := ap1.y - ap2.y;
if LineWidth < 0 then
LineWidth := LineWidth * (-1);
LineWidth := LineWidth * GCadForm.PCad.DotsPerMil * convertRatio;
if CompareValue(TxtWidth, LineWidth) > 0 then
//Result := vlsTopRight;
Result := vlsTop;
FCanvas.Free;
MetaFile.Free;
end;
//
procedure TDimLine.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
inherited;
end;
function TDimLine.ShadowClick(ClickIndex:Integer;x,y:Double): Boolean;
begin
result := false;
ActualPoints[ClickIndex] := DoublePoint(x,y);
if ClickIndex = 3 then
result := true;
end;
function TDimLine.ShadowTrace(ClickIndex:Integer;x,y:Double): Boolean;
begin
if ClickIndex = 1 then
begin
ActualPoints[2] := DoublePoint(x,y);
ActualPoints[3] := DoublePoint(x,y);
end
else
if ClickIndex = 2 then
begin
ActualPoints[3] := DoublePoint(x,y);
end;
result := true;
end;
procedure TDimLine.WriteToStream(Stream: TStream);
begin
inherited;
end;
{ THDimLine }
class function THDimLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var x3,y3: double;
begin
result := THDimLine.Create(LHandle,mydsNormal,aOwner);
result.ActualPoints[1] := Shadow.ap1;
result.ActualPoints[2] := Shadow.ap2;
y3 := Shadow.ap3.y;
x3 := (Shadow.ap1.x+Shadow.ap2.x) / 2;
result.ActualPoints[3] := DoublePoint(x3,y3);
THDimLine(result).LStyle := THDimLine(Shadow).Lstyle;
// THDimLine(result).EndType := THDimLine(Shadow).EndType;
if GCadForm.FDimLinesType = dlt_None then
THDimLine(result).EndType := etClear;
if GCadForm.FDimLinesType = dlt_Row then
THDimLine(result).EndType := etRow;
if GCadForm.FDimLinesType = dlt_Stroke then
THDimLine(result).EndType := etNick;
end;
function THDimLine.CreateModification: TFigure;
begin
result := THDimLine.Create(0,dsTrace,nil);
result.ActualPoints[1] := ap1;
result.ActualPoints[2] := ap2;
result.ActualPoints[3] := ap3;
result.color := clLime;
result.RotPoint := RotPoint;
THDimLine(result).EndType := EndType;
THDimLine(result).Lstyle := Lstyle;
end;
class function THDimLine.CreateShadow(x, y: Double): TFigure;
begin
result := THDimLine.Create(0,dsTrace,nil);
result.ActualPoints[1] := DoublePoint(x,y);
result.ActualPoints[2] := DoublePoint(x,y);
result.ActualPoints[3] := DoublePoint(x,y);
result.color := clLime;
THDimLine(result).Lstyle := hlsInner;
end;
procedure THDimLine.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor : Tcolor;
p3 : TDoublepoint;
x3,y3,tx,ty: Double;
text:string;
dist: double;
l: integer;
st: TFontStyles;
begin
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then
DEngine.Canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
if DrawStyle = dsTrace then RegHandle := 1;
y3 := ap3.y;
x3 := (ap1.x + ap2.x) / 2;
p3 := DoublePoint(x3, y3);
text := '';
if DrawStyle = mydsNormal then
begin
if autotext then
begin
if assigned(owner) then
MapScale := TPCDrawing(Owner).MapScale;
dist := (abs(ap1.x - ap2.x) * MapScale) / 1000;
if self is TSCSHDimLine then
dist := round(dist * 10000) / 10000
else
dist := round(dist * 100) / 100;
dist := MetreToUOM(dist);
if self is TSCSHDimLine then
text := FormatFloat(ffMask + '#', dist)+ GetUOMString(GCurrProjUnitOfMeasure)
else
text := FormatFloat(ffMask, dist)+ GetUOMString(GCurrProjUnitOfMeasure);
text := Prefix + text + Suffix;
end
else
text := DLabel;
caption := text;
end;
st := [];
if TextBold then st := st + [fsBold];
if TextItalic then st := st + [fsItalic];
DEngine.DrawHDim(ap1,ap2,p3,Text,TextFont,st,aColor,TextColor,TextHeight,LStyle,
TextPos,EndType,RegHandle);
//Tolik
if RegHandle > 1 then
begin
GetRegObject;
if (TBrushStyle(brs) <> bsClear) then
RegObject.CheckPointByRects := true;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function THDimLine.Duplicate: TFigure;
var res: THDimLine;
begin
res := THDimLine.Create(LayerHandle,DrawStyle,Owner);
res.DLabel := Dlabel;
res.Prefix := Prefix;
res.Suffix := Suffix;
res.AutoText := AutoText;
res.TextPos := TextPos;
res.TextFont := TextFont;
res.TextHeight := TextHeight;
res.TextBold := TextBold;
res.TextItalic := TextItalic;
res.EndType := EndType;
res.MapScale := MapScale;
res.LStyle := Lstyle;
CopyProperties(res);
result := res;
end;
function THDimLine.Edit: Boolean;
var
EnterStr: string;
dist, distx, disty: double;
begin
if autotext then
begin
distx := (abs(ap1.x - ap2.x) * MapScale) / 1000;
distx := round(distx * 100) / 100;
distx := MetreToUOM(distx);
DLabel := FormatFloat(ffMask, distx);
end;
Result := False;
EnterStr := DLabel;
// EnterStr := FloatToStr(MetreToUOM(StrToFloat_My(EnterStr)));
if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
begin
// EnterStr := FloatToStr(UOMToMetre(StrToFloat_My(EnterStr)));
DLabel := EnterStr;
AutoText := False;
Modified := True;
result := true;
end;
end;
function THDimLine.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
var x3,y3: Double;
begin
if mp.SeqNbr = 3 then
begin
x3 := (ap1.x+ap2.x) / 2;
ActualPoints[3] := DoublePoint(x3,y);
end else
begin
ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
x3 := (ap1.x+ap2.x) / 2;
y3 := ap3.y;
ActualPoints[3] := DoublePoint(x3,y3);
LStyle := THDimLine(TraceFigure).LStyle;
end;
ResetRegion;
Modified := True;
LStyle := DefineHStyle(LStyle); //// Tolik 04/03/2020 --
end;
procedure THDimLine.Getbounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
if regHandle = 0 then begin
figMaxX := Max(ap1.x,ap2.x);
figMinX := Min(ap1.x,ap2.x);;
figMaxY := MaxValue([ap1.y,ap2.y,ap3.y]);
figMinY := MinValue([ap1.y,ap2.y,ap3.y]);
end else
GetRegionBounds(figMaxX, figMaxY, figMinX,figMinY);
end;
function THDimLine.GetClassName: String;
begin
result := 'HDimLine';
end;
function THDimLine.IsPointIn(x, y: Double): boolean;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
if isPointInRegion(x,y) then result := true;
//Tolik
if IsPointInRegionByRegObj(x,y) then result := true;
//
end;
procedure THDimLine.MenuClicked(CommandId: integer);
var idx: integer;
begin
idx := commandID-menuIndex;
case idx of
1: EndType := etClear;
2: EndType := etRow;
3: EndType := etDot;
4: EndType := etNick;
5: AutoText := not Autotext;
7: TextPos := tpOnLine;
8: TextPos := tpAbove;
9: TextPos := tpBelow;
11: LStyle := hlsInner;
12: LStyle := hlsLeft;
13: LStyle := hlsRight;
14: LStyle := hlsLeftTop;
15: LStyle := hlsLeftBottom;
16: LStyle := hlsRightTop;
17: LStyle := hlsRightBottom;
end;
ResetRegion;
Modified := true;
end;
procedure THDimLine.Mirror(Point1, Point2: TDoublePoint);
begin
end;
procedure THDimLine.Rotate(aAngle: Double; cPoint: TDoublePoint);
begin
end;
procedure THDimLine.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
Case xcode of
90 : TextBold := ((pByte(data)^) = 1);
91 : TextItalic := ((pByte(data)^) = 1);
92 : AutoText := ((pByte(data)^) = 1);
93 : TextPos := TDimTextPos(pByte(data)^);
94 : EndType := TEndType(pByte(data)^);
95 : LStyle := THDimLabelStyle(pByte(data)^);
180: DLabel := string(pchar(data));
181: Prefix := string(pchar(data));
182: Suffix := string(pchar(data));
183: TextFont := string(pchar(data));
220: TextHeight := pDouble(data)^;
end;
end;
function THDimLine.ShadowClick(ClickIndex:Integer; x, y: Double): Boolean;
begin
result := false;
ActualPoints[ClickIndex] := DoublePoint(x,y);
if ClickIndex = 3 then result := true;
end;
function THDimLine.ShadowTrace(ClickIndex:Integer; x, y:Double): Boolean;
begin
if ClickIndex = 1 then
begin
ActualPoints[2] := DoublePoint(x,y);
ActualPoints[3] := DoublePoint(x,y);
if abs(ActualPoints[1].x-ActualPoints[2].x) < 10 then Lstyle := hlsRight
else LStyle := hlsInner;
end else if ClickIndex = 2 then begin
ActualPoints[3] := DoublePoint(x,y);
end;
result := true;
end;
function THDimLine.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
begin
TraceFigure.ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
if mp.SeqNbr < 3 then begin
if abs(TraceFigure.ActualPoints[1].x-TraceFigure.ActualPoints[2].x) < 10
then THDimLine(TraceFigure).LStyle := hlsRight
else THDimLine(TraceFigure).Lstyle := hlsInner;
end;
end;
procedure THDimLine.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var
mnItem,mnSub: TMenuItem;
begin
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmEndType;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmClearEnd;
mnSub.Tag := sIndex+1;
if EndType = etClear then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRowEnd ;
mnSub.Tag := sIndex+2;
if EndType = etRow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmDotEnd;
mnSub.Tag := sIndex+3;
if EndType = etDot then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmNickEnd;
mnSub.Tag := sIndex+4;
if EndType = etNick then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+5;
mnItem.Caption := fmAutoLabel ;
if Autotext then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+6;
mnItem.Caption := fmTextPosition;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmOnline;
mnSub.Tag := sIndex+7;
if textPos = tpOnline then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmAboveLine;
mnSub.Tag := sIndex+8;
if textPos = tpAbove then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBelowLine;
mnSub.Tag := sIndex+9;
if textPos = tpBelow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+10;
mnItem.Caption := fmLabeling;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmInside ;
mnSub.Tag := sIndex+11;
if LStyle = hlsInner then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmLeft;
mnSub.Tag := sIndex+12;
if LStyle = hlsLeft then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRight;
mnSub.Tag := sIndex+13;
if LStyle = hlsRight then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmLeftTop;
mnSub.Tag := sIndex+14;
if LStyle = hlsLeftTop then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmLeftBottom;
mnSub.Tag := sIndex+15;
if LStyle = hlsLeftBottom then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRigthTop;
mnSub.Tag := sIndex+16;
if LStyle = hlsRightTop then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRightBottom;
mnSub.Tag := sIndex+17;
if LStyle = hlsRightBottom then mnSub.Checked := True;
mnItem.Add(mnSub);
sIndex := sIndex+18;
end;
procedure THDimLine.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
xStr := DLabel;
WriteStrField(180,Stream,xStr);
xStr := Prefix;
WriteStrField(181,Stream,xStr);
xStr := Suffix;
WriteStrField(182,Stream,xStr);
xStr := TextFont;
WriteStrField(183,Stream,xStr);
xDbl := TextHeight;
WriteField(220,Stream,xDbl,8);
if TextBold then
xByte := 1
else
xByte := 0;
WriteField(90,Stream,xByte,1);
if TextItalic then
xByte := 1
else
xByte := 0;
WriteField(91,Stream,xByte,1);
if AutoText then
xByte := 1
else
xByte := 0;
WriteField(92,Stream,xByte,1);
xByte := ord(TextPos);WriteField(93,Stream,xByte,1);
xByte := ord(EndType);WriteField(94,Stream,xByte,1);
xByte := ord(LStyle);WriteField(95,Stream,xByte,1);
end;
{ TVDimLine }
class function TVDimLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var x3,y3: Double;
begin
result := TVDimLine.Create(LHandle,mydsNormal,aOwner);
result.ActualPoints[1] := Shadow.ActualPoints[1];
result.ActualPoints[2] := Shadow.ActualPoints[2];
x3 := Shadow.ActualPoints[3].x;
y3 := (Shadow.ActualPoints[1].y+Shadow.ActualPoints[2].y) / 2;
result.ActualPoints[3] := DoublePoint(x3,y3);
TVDimLine(result).Lstyle := TVDimLine(Shadow).Lstyle;
// TVDimLine(result).EndType := TVDimLine(Shadow).EndType;
if GCadForm.FDimLinesType = dlt_None then
TVDimLine(result).EndType := etClear;
if GCadForm.FDimLinesType = dlt_Row then
TVDimLine(result).EndType := etRow;
if GCadForm.FDimLinesType = dlt_Stroke then
TVDimLine(result).EndType := etNick;
end;
function TVDimLine.CreateModification: TFigure;
begin
result := TVDimLine.Create(0,dsTrace,nil);
result.ActualPoints[1] := ActualPoints[1];
result.ActualPoints[2] := ActualPoints[2];
result.ActualPoints[3] := ActualPoints[3];
result.color := clLime;
result.RotPoint := RotPoint;
TVDimLine(result).EndType := EndType;
TVDimLine(result).Lstyle := Lstyle;
end;
class function TVDimLine.CreateShadow(x,y: Double): TFigure;
begin
result := TVDimLine.Create(0,dsTrace,nil);
result.ActualPoints[1] := DoublePoint(x,y);
result.ActualPoints[2] := DoublePoint(x,y);
result.ActualPoints[3] := DoublePoint(x,y);
result.color := clLime;
end;
procedure TVDimLine.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor : Tcolor;
p3 : TDoublepoint;
text:string;
x3,y3,tx,ty: Double;
dist: double;
l: integer;
st: TFontStyles;
begin
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then DEngine.Canvas.pen.mode := pmXor
else DEngine.canvas.pen.mode := pmCopy;
x3 := ap3.x;
y3 := (ap1.y+ap2.y) / 2;
p3 := DoublePoint(x3,y3);
text := '';
if DrawStyle = mydsNormal then
begin
if autotext then
begin
if assigned(owner) then
MapScale := TPCDrawing(Owner).MapScale;
dist := (abs(ap1.y - ap2.y) * MapScale) / 1000;
if self is TSCSVDimLine then
dist := round(dist * 10000) / 10000
else
dist := round(dist * 100) / 100;
dist := MetreToUOM(dist);
if self is TSCSVDimLine then
text := FormatFloat(ffMask + '#', dist)+ GetUOMString(GCurrProjUnitOfMeasure)
else
text := FormatFloat(ffMask, dist) + GetUOMString(GCurrProjUnitOfMeasure);
text := Prefix + text + Suffix;
end
else
text := DLabel;
caption := text;
end;
st := [];
if TextBold then st := st + [fsBold];
if TextItalic then st := st + [fsItalic];
DEngine.DrawVDim(ap1,ap2,p3,Text,TextFont,st,aColor,TextColor,TextHeight,LStyle,
TextPos,EndType,RegHandle);
// Tolik
if RegHandle > 1 then
begin
GetRegObject;
if (TBrushStyle(brs) <> bsClear) then
RegObject.CheckPointByRects := True;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TVDimLine.Duplicate: TFigure;
var res: TVDimLine;
begin
res := TVDimLine.Create(LayerHandle,DrawStyle,Owner);
res.DLabel := Dlabel;
res.Prefix := Prefix;
res.Suffix := Suffix;
res.AutoText := AutoText;
res.TextPos := TextPos;
res.TextFont := TextFont;
res.TextHeight := TextHeight;
res.TextBold := TextBold;
res.TextItalic := TextItalic;
res.EndType := EndType;
res.MapScale := MapScale;
res.LStyle := Lstyle;
CopyProperties(res);
result := res;
end;
function TVDimLine.Edit: Boolean;
var
EnterStr: string;
dist, distx, disty: double;
begin
if autotext then
begin
disty := (abs(ap1.y - ap2.y) * MapScale) / 1000;
disty := round(disty * 100) / 100;
disty := MetreToUOM(disty);
DLabel := FormatFloat(ffMask, disty);
end;
Result := False;
EnterStr := DLabel;
// EnterStr := FloatToStr(MetreToUOM(StrToFloat_My(EnterStr)));
if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
begin
// EnterStr := FloatToStr(UOMToMetre(StrToFloat_My(EnterStr)));
DLabel := EnterStr;
AutoText := False;
Modified := True;
result := true;
end;
end;
function TVDimLine.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
var x3,y3: Double;
begin
if mp.SeqNbr = 3 then
begin
y3 := (ActualPoints[1].y+ActualPoints[2].y) / 2;
ActualPoints[3] := DoublePoint(x,y3);
end else
begin
ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
y3 := (ActualPoints[1].y+ActualPoints[2].y) / 2;
x3 := ActualPoints[3].x;
ActualPoints[3] := DoublePoint(x3,y3);
LStyle := TVDimLine(TraceFigure).LStyle;
end;
ResetRegion;
Modified := True;
LStyle := DefineVStyle(LStyle); // Tolik 04/03/2020 --
end;
procedure TVDimLine.Getbounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
if regHandle = 0 then begin
figMaxY := Max(ap1.y,ap2.y);
figMinY := Min(ap1.y,ap2.y);;
figMaxX := MaxValue([ap1.x,ap2.x,ap3.x]);
figMinX := MinValue([ap1.x,ap2.x,ap3.x]);
end else
GetRegionBounds(figMaxX, figMaxY, figMinX,figMinY);
end;
function TVDimLine.GetClassName: String;
begin
result := 'VDimLine';
end;
function TVDimLine.IsPointIn(x, y: Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := isPointInRegion(x,y);
// Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TVDimLine.MenuClicked(CommandId: integer);
var idx: integer;
begin
idx := commandID-menuIndex;
case idx of
1: EndType := etClear;
2: EndType := etRow;
3: EndType := etDot;
4: EndType := etNick;
5: AutoText := not Autotext;
7: TextPos := tpOnLine;
8: TextPos := tpAbove;
9: TextPos := tpBelow;
11: LStyle := vlsInner;
12: LStyle := vlsTop;
13: LStyle := vlsBottom;
14: LStyle := vlsTopLeft;
15: LStyle := vlsTopRight;
16: LStyle := vlsBottomLeft;
17: LStyle := vlsBottomRight;
end;
ResetRegion;
Modified := true;
end;
procedure TVDimLine.Mirror(Point1, Point2: TDoublePoint);
begin
end;
procedure TVDimLine.Rotate(aAngle: Double; cPoint: TDoublePoint);
begin
end;
procedure TVDimLine.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
Case xcode of
90 : TextBold := ((pByte(data)^) = 1);
91 : TextItalic := ((pByte(data)^) = 1);
92 : AutoText := ((pByte(data)^) = 1);
93 : TextPos := TDimTextPos(pByte(data)^);
94 : EndType := TEndType(pByte(data)^);
95 : LStyle := TVDimLabelStyle(pByte(data)^);
180: DLabel := string(pchar(data));
181: Prefix := string(pchar(data));
182: Suffix := string(pchar(data));
183: TextFont := string(pchar(data));
220 : TextHeight := pDouble(data)^;
end;
end;
function TVDimLine.ShadowClick(ClickIndex:Integer; x, y: Double): Boolean;
begin
result := false;
ActualPoints[ClickIndex] := DoublePoint(x,y);
if ClickIndex = 3 then
result := true;
end;
function TVDimLine.ShadowTrace(ClickIndex:Integer;x,y: Double): Boolean;
begin
if ClickIndex = 1 then
begin
ActualPoints[2] := DoublePoint(x,y);
ActualPoints[3] := DoublePoint(x,y);
end
else
if ClickIndex = 2 then
begin
ActualPoints[3] := DoublePoint(x,y);
end;
if abs(ActualPoints[1].y-ActualPoints[2].y) < 10 then
LStyle := vlsTop
else
Lstyle := vlsInner;
result := true;
end;
function TVDimLine.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
begin
TraceFigure.ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
end;
procedure TVDimLine.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var mnItem,mnSub: TMenuItem;
begin
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmEndType;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmClearEnd;
mnSub.Tag := sIndex+1;
if EndType = etClear then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRowEnd;
mnSub.Tag := sIndex+2;
if EndType = etRow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmDotEnd;
mnSub.Tag := sIndex+3;
if EndType = etDot then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmNickEnd;
mnSub.Tag := sIndex+4;
if EndType = etNick then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+5;
mnItem.Caption :=fmAutoLabel;
if Autotext then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+6;
mnItem.Caption := fmTextPosition;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmOnLine;
mnSub.Tag := sIndex+7;
if textPos = tpOnline then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmAboveLine;
mnSub.Tag := sIndex+8;
if textPos = tpAbove then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBelowLine;
mnSub.Tag := sIndex+9;
if textPos = tpBelow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+10;
mnItem.Caption := fmLabeling;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmInside;
mnSub.Tag := sIndex+11;
if LStyle = vlsInner then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmTop;
mnSub.Tag := sIndex+12;
if LStyle = vlsTop then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBottom;
mnSub.Tag := sIndex+13;
if LStyle = vlsBottom then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmTopLeft;
mnSub.Tag := sIndex+14;
if LStyle = vlsTopLeft then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmTopRight;
mnSub.Tag := sIndex+15;
if LStyle = vlsTopRight then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBottomLeft;
mnSub.Tag := sIndex+16;
if LStyle = vlsBottomLeft then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBottomRight;
mnSub.Tag := sIndex+17;
if LStyle = vlsBottomRight then mnSub.Checked := True;
mnItem.Add(mnSub);
sIndex := sIndex+18;
end;
procedure TVDimLine.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
xStr := DLabel;
WriteStrField(180,Stream,xStr);
xStr := Prefix;
WriteStrField(181,Stream,xStr);
xStr := Suffix;
WriteStrField(182,Stream,xStr);
xStr := TextFont;
WriteStrField(183,Stream,xStr);
xDbl := TextHeight;
WriteField(220,Stream,xDbl,8);
xByte := 1;
if TextBold then
xByte := 1
else
xByte := 0;
WriteField(90,Stream,xByte,1);
if TextItalic then
xByte := 1
else
xByte := 0;
WriteField(91,Stream,xByte,1);
if AutoText then
xByte := 1
else
xByte := 0;
WriteField(92,Stream,xByte,1);
xByte := ord(TextPos);
WriteField(93,Stream,xByte,1);
xByte := ord(EndType);
WriteField(94,Stream,xByte,1);
xByte := ord(LStyle);
WriteField(95,Stream,xByte,1);
end;
{ TADimLine }
class function TADimline.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var x3,y3: Double;
p3: TDoublePoint;
begin
result := TADimline.Create(LHandle,mydsNormal,aOwner);
result.ActualPoints[1] := Shadow.ActualPoints[1];
result.ActualPoints[2] := Shadow.ActualPoints[2];
x3 := Shadow.ActualPoints[3].x;
y3 := Shadow.ActualPoints[3].y;
PointToParallelLine(Shadow.ActualPoints[1],Shadow.ActualPoints[2],x3,y3);
result.ActualPoints[3] := DoublePoint(x3,y3);
TADimline(result).LStyle := TADimline(Shadow).Lstyle;
TADimline(result).EndType := TADimline(Shadow).EndType;
end;
function TADimline.CreateModification: TFigure;
begin
result := TADimline.Create(0,dsTrace,nil);
result.ActualPoints[1] := ActualPoints[1];
result.ActualPoints[2] := ActualPoints[2];
result.ActualPoints[3] := ActualPoints[3];
result.color := clLime;
result.RotPoint := RotPoint;
TADimline(result).EndType := EndType;
TADimline(result).Lstyle := Lstyle;
end;
class function TADimline.CreateShadow(x, y: Double): TFigure;
begin
result := TADimline.Create(0,dsTrace,nil);
result.ActualPoints[1] := DoublePoint(x,y);
result.ActualPoints[2] := DoublePoint(x,y);
result.ActualPoints[3] := DoublePoint(x,y);
result.color := clLime;
TADimline(result).Lstyle := alsInner;
TADimline(result).HorzText := False;
end;
procedure TADimline.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor : Tcolor;
text:string;
dist: double;
l: integer;
st: TFontStyles;
begin
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then DEngine.Canvas.pen.mode := pmXor
else DEngine.canvas.pen.mode := pmCopy;
if DrawStyle = dsTrace then RegHandle := 1;
text := '';
if DrawStyle = mydsNormal then
begin
if autotext then begin
if assigned(owner) then
MapScale := TPCDrawing(Owner).MapScale;
dist := (GetLineLenght(ap1,ap2) *MapScale)/1000;
dist := round(dist*100)/100;
{//22.12.2011
text := FormatFloat(ffMask, dist)+ ' m';
if assigned(Owner) and (TPCDrawing(Owner).RulerSystem = rsWhitworth) then
begin
dist := (((GetLineLenght(ap1,ap2) *MapScale)/10)/2.54)/12;
dist := round(dist*100)/100;
text := FormatFloat(ffMask, dist)+ ' ft';
end;}
dist := MetreToUOM(dist);
text := FormatFloat(ffMask, dist)+ GetUOMString(GCurrProjUnitOfMeasure);
text := Prefix+text+Suffix;
end else text := DLabel;
end;
st := [];
if TextBold then st := st + [fsBold];
if TextItalic then st := st + [fsItalic];
DEngine.DrawAlignedDim(ap1,ap2,ap3,Text,TextFont,st,aColor,TextColor,TextHeight,LStyle,
TextPos,EndType,HorzText,RegHandle);
// Tolik
if RegHandle > 1 then
begin
GetRegObject;
if (TBrushStyle(brs) <> bsClear) then
RegObject.CheckPointByRects := True;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TADimline.Duplicate: TFigure;
var res: TADimline;
begin
res := TADimline.Create(LayerHandle,DrawStyle,Owner);
res.DLabel := Dlabel;
res.Prefix := Prefix;
res.Suffix := Suffix;
res.AutoText := AutoText;
res.TextPos := TextPos;
res.TextFont := TextFont;
res.TextHeight := TextHeight;
res.TextBold := TextBold;
res.TextItalic := TextItalic;
res.EndType := EndType;
res.MapScale := MapScale;
res.LStyle := Lstyle;
CopyProperties(res);
result := res;
end;
function TADimline.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
var x3,y3: Double;
begin
if mp.SeqNbr = 3 then
begin
PointToParallelLine(ActualPoints[1],ActualPoints[2],x,y);
ActualPoints[3] := DoublePoint(x,y);
end
else
begin
ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
x3 := ActualPoints[3].x;
y3 := ActualPoints[3].y;
PointToParallelLine(ActualPoints[1],ActualPoints[2],x3,y3);
ActualPoints[3] := DoublePoint(x3,y3);
LStyle := TADimline(TraceFigure).LStyle;
end;
ResetRegion;
Modified := True;
end;
procedure TADimline.Getbounds(var figMaxX, figMaxY, figMinX,
figMinY:Double);
begin
GetRegionBounds(figMaxX, figMaxY, figMinX,figMinY);
end;
function TADimLine.GetClassName: String;
begin
result := 'ADimLine';
end;
function TADimline.IsPointIn(x, y: Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := isPointInRegion(x,y);
// Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TADimline.MenuClicked(CommandId: integer);
var idx: integer;
begin
idx := commandID-menuIndex;
case idx of
1: EndType := etClear;
2: EndType := etRow;
3: EndType := etDot;
4: EndType := etNick;
5: AutoText := not Autotext;
7: TextPos := tpOnLine;
8: TextPos := tpAbove;
9: TextPos := tpBelow;
11: LStyle := alsInner;
12: LStyle := alsLeft;
13: LStyle := alsRight;
14: HorzText := not HorzText;
end;
ResetRegion;
Modified := true;
end;
procedure TADimline.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
Case xcode of
90 : TextBold := ((pByte(data)^) = 1);
91 : TextItalic := ((pByte(data)^) = 1);
92 : AutoText := ((pByte(data)^) = 1);
93 : HorzText := ((pByte(data)^) = 1);
94 : TextPos := TDimTextPos(pByte(data)^);
95 : EndType := TEndType(pByte(data)^);
96 : LStyle := TADimLabelStyle(pByte(data)^);
180: DLabel := string(pchar(data));
181: Prefix := string(pchar(data));
182: Suffix := string(pchar(data));
183: TextFont := string(pchar(data));
220: TextHeight := pDouble(data)^;
end;
end;
function TADimline.ShadowClick(ClickIndex:Integer; x, y:Double): Boolean;
begin
result := false;
ActualPoints[ClickIndex] := DoublePoint(x,y);
if ClickIndex = 3 then
result := true;
end;
function TADimline.ShadowTrace(ClickIndex:Integer; x, y: Double): Boolean;
begin
if ClickIndex = 1 then
begin
ActualPoints[2] := DoublePoint(x,y);
ActualPoints[3] := DoublePoint(x,y);
end
else
if ClickIndex = 2 then
begin
ActualPoints[3] := DoublePoint(x,y);
end;
result := true;
end;
function TADimline.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
begin
TraceFigure.ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
end;
procedure TADimline.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var
mnItem,mnSub: TMenuItem;
begin
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmEndType;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmClearEnd;
mnSub.Tag := sIndex+1;
if EndType = etClear then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRowEnd;
mnSub.Tag := sIndex+2;
if EndType = etRow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmDotEnd;
mnSub.Tag := sIndex+3;
if EndType = etDot then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmNickEnd;
mnSub.Tag := sIndex+4;
if EndType = etNick then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+5;
mnItem.Caption := fmAutoLabel;
if Autotext then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+6;
mnItem.Caption := fmTextPosition;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmOnLine;
mnSub.Tag := sIndex+7;
if textPos = tpOnline then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmAboveLine;
mnSub.Tag := sIndex+8;
if textPos = tpAbove then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBelowLine;
mnSub.Tag := sIndex+9;
if textPos = tpBelow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+10;
mnItem.Caption := fmLabeling;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmInside;
mnSub.Tag := sIndex+11;
if LStyle = alsInner then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmLeft;
mnSub.Tag := sIndex+12;
if LStyle = alsLeft then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRight;
mnSub.Tag := sIndex+13;
if LStyle = alsRight then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+14;
mnItem.Caption := fmAlwaysHorizontal;
if Horztext then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+15;
end;
procedure TADimline.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
xStr := DLabel;
WriteStrField(180,Stream,xStr);
xStr := Prefix;
WriteStrField(181,Stream,xStr);
xStr := Suffix;
WriteStrField(182,Stream,xStr);
xStr := TextFont;
WriteStrField(183,Stream,xStr);
xDbl := TextHeight;
WriteField(220,Stream,xDbl,8);
if TextBold then
xByte := 1
else
xByte := 0;
WriteField(90,Stream,xByte,1);
if TextItalic then
xByte := 1
else
xByte := 0;
WriteField(91,Stream,xByte,1);
if AutoText then
xByte := 1
else
xByte := 0;
WriteField(92,Stream,xByte,1);
if HorzText then
xByte := 1
else
xByte := 0;
WriteField(93,Stream,xByte,1);
xByte := ord(TextPos);
WriteField(94,Stream,xByte,1);
xByte := ord(EndType);
WriteField(95,Stream,xByte,1);
xByte := ord(LStyle);
WriteField(96,Stream,xByte,1);
end;
{ TPattern }
constructor TPattern.CreateFromFigure(aFigure: TFigure);
var r: TDoublerect;
baseP: TDoublepoint;
baseX,baseY: Double;
begin
inherited;
r := aFigure.GetBoundRect;
pwidth := abs(r.right - r.left);
if pwidth = 0 then pWidth := 10;
Vector := TVector.Create(0);
if aFigure.vertZero = 1 then
baseY := r.bottom else baseY := r.Top;
if aFigure.HorzZero = 0 then
baseX := r.Left else baseX := r.Right;
baseP := DoublePoint(baseX,baseY);
aFigure.GetVectorObjects(Vector.Objects,baseP);
end;
constructor TPattern.Create(aVector: TVector;aWidth,aGap:Double);
begin
inherited Create;
if assigned(avector) then
begin
Vector := aVector.Duplicate;
end;
pWidth := aWidth;
Gap := aGap;
end;
destructor TPattern.destroy;
begin
if assigned(Vector) then Vector.Free;
inherited;
end;
Procedure TPattern.Draw(DEngine:TPCDrawEngine;sCoord,eCoord:TDoublepoint;Scale:Double);
begin
Vector.Draw(DEngine,sCoord,eCoord,Scale);
end;
procedure TPattern.DrawObjects(DEngine: TPCDrawEngine; sCoord,
eCoord: TDoublepoint; Scale: Double);
begin
Vector.DrawObjects(DEngine,sCoord,eCoord,Scale);
end;
function TPattern.Duplicate: TPattern;
begin
Result := TPattern.Create(Vector,pWidth,Gap);
Result.PatName := PatName;
end;
procedure TPattern.LoadFromStream(Stream: TStream);
var version: Integer;
begin
Stream.Read(Version,4);
if version <> 100 then
begin
Stream.Position := 0;
LoadFromStreamOldFormat(Stream);
exit;
end;
Stream.Read(Gap,8);
if CompareValue(Gap, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
Gap := 0;
Stream.Read(PWidth,8);
if CompareValue(PWidth, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
PWidth := 0;
PatName := ReadStringFromStream(Stream);
Vector := Tvector.Create(0);
Vector.LoadFromStream(Stream);
end;
procedure TPattern.LoadFromStreamOldFormat(Stream: Tstream);
var pType: Byte;
figure: Tfigure;
r: TDoublerect;
baseP: TDoublepoint;
baseX,baseY: Double;
val: double;
begin
Stream.Read(Gap,8);
if CompareValue(Gap, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
Gap := 0;
Gap := Gap /10;
Stream.Read(val,8); // it was vertgap
if CompareValue(val, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
val := 0;
Stream.Read(PWidth,8);
if CompareValue(PWidth, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
PWidth := 0;
PWidth := PWidth / 10;
Stream.Read(pType,1);
if pType = 2 then // old style figure pattern
begin
figure := Tfigure.CreateFromStream(Stream,0,mydsNormal,nil);
r := Figure.GetBoundRect;
if pwidth = 0 then pwidth := abs(r.right - r.left);
if pwidth = 0 then pWidth := 10;
Vector := TVector.Create(0);
if Figure.VertZero = 1 then
baseY := r.bottom else baseY := r.Top;
if Figure.HorzZero = 0 then
baseX := r.Left else baseX := r.Right;
baseP := DoublePoint(baseX,baseY);
Figure.GetVectorObjects(Vector.Objects,baseP);
if figure is TfigureGrp then
TfigureGrp(figure).DestroyInFigures;
Figure.Free;
exit;
end else if pType = 1 then
begin
Vector := Tvector.Create(0);
Vector.LoadFromStreamOldFormat(Stream);
end;
end;
procedure TPattern.SaveToStream(Stream: TStream);
var version: Integer;
begin
version := 100;
Stream.Write(Version,4);
Stream.Write(Gap,8);
Stream.Write(PWidth,8);
WriteString(Stream,PatName);
if assigned(vector) then
Vector.SaveToStream(Stream);
end;
procedure TPattern.Scale(px, py: double);
begin
pWidth := pwidth*px;
Gap := Gap*px;
Vector.Scale(px,py);
end;
procedure TPattern.StartDraw(DEngine: TPCDrawEngine; sCoord: TDoublePoint);
begin
Dengine.MoveTo(DoublePOint(sCoord.x,Vector.StartY+sCoord.Y,SCoord.Z));
end;
{ TVectorSegment }
constructor TVectorSegment.CreateBezierSegment(ePoint, cp1, cp2: TDoublepoint);
begin
inherited Create;
EndPoint := ePoint;
Cpoint1 := cp1;
CPoint2 := cp2;
SegmentType := vstBezier;
end;
constructor TVectorSegment.CreateFromStream(Stream: TStream);
begin
inherited Create;
Stream.Read(SegmentType,1);
Stream.Read(endPoint.x,8);
if CompareValue(endPoint.x, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
endPoint.x := 0;
Stream.Read(endPoint.y,8);
if CompareValue(endPoint.y, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
endPoint.y := 0;
if SegmentType = vstBezier then
begin
Stream.Read(Cpoint1.x,8);
if CompareValue(Cpoint1.x, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
Cpoint1.x := 0;
Stream.Read(Cpoint1.y,8);
if CompareValue(Cpoint1.y, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
Cpoint1.y := 0;
Stream.Read(Cpoint2.x,8);
if CompareValue(Cpoint2.x, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
Cpoint2.x := 0;
Stream.Read(Cpoint2.y,8);
if CompareValue(Cpoint2.y, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
Cpoint2.y := 0;
end;
end;
constructor TVectorSegment.CreateFromStreamOldFormat(Stream: TStream);
var val: Integer;
begin
inherited Create;
Stream.Read(SegmentType,1);
Stream.Read(val,4); endPoint.x := val/10;
Stream.Read(val,4); endPoint.y := val/10;
if SegmentType = vstBezier then
begin
Stream.Read(val,4); Cpoint1.x := val/10;
Stream.Read(val,4); Cpoint1.y := val/10;
Stream.Read(val,4); Cpoint2.x := val/10;
Stream.Read(val,4); Cpoint2.y := val/10;
end;
end;
Destructor TVectorSegment.Destroy;
begin
inherited;
end;
constructor TVectorSegment.CreateLineSegment(ePoint: TDoublePoint);
begin
inherited Create;
EndPoint := ePoint;
SegmentType := vstLine;
end;
function TVectorSegment.Duplicate: TVectorSegment;
begin
Result := TvectorSegment.Create;
Result.SegmentType := SegmentType;
Result.EndPoint := EndPoint;
Result.Cpoint1 := Cpoint1;
Result.Cpoint2 := Cpoint2;
end;
procedure TVectorSegment.Move(dx, dy: Double);
begin
EndPoint.x := EndPoint.x + dx;
EndPoint.y := EndPoint.y + dy;
CPoint1.x := CPoint1.x + dx;
CPoint1.y := CPoint1.y + dy;
CPoint2.x := CPoint2.x + dx;
CPoint2.y := CPoint2.y + dy;
end;
procedure TVectorSegment.SaveToStream(Stream: TStream);
begin
Stream.Write(SegmentType,1);
Stream.Write(endPoint.x,8);
Stream.Write(endPoint.y,8);
if SegmentType = vstBezier then
begin
Stream.Write(Cpoint1.x,8);
Stream.Write(Cpoint1.y,8);
Stream.Write(Cpoint2.x,8);
Stream.Write(Cpoint2.y,8);
end;
end;
procedure TVectorSegment.Scale(px, py: double);
begin
EndPoint := ScalePoint(DoublePoint(0,0),EndPoint,px,py);
if SegmentType = vstbezier then begin
CPoint1 := ScalePoint(DoublePoint(0,0),CPoint1,px,py);
CPoint2 := ScalePoint(DoublePoint(0,0),CPoint2,px,py);
end;
end;
{ TVector }
function TVector.AddBezierSegment(ePoint, cPoint1,
cPoint2: TDoublePoint): TVectorSegment;
var Segment: TVectorSegment;
begin
Segment := TVectorSegment.CreateBezierSegment(ePoint,cPoint1,cPoint2);
Segments.Add(Segment);
end;
function TVector.AddLineSegment(ePoint: TDoublePoint): TVectorSegment;
var Segment: TVectorSegment;
begin
Segment := TVectorSegment.CreateLineSegment(ePoint);
Segments.Add(Segment);
end;
Procedure TVector.Draw(DEngine:TPCDrawEngine;sCoord,eCoord:TDoublepoint;Scale:Double);
var i: Integer;
Segment: TvectorSegment;
sPoint,ePoint,cP1,cp2: TDoublepoint;
Angle: Double;
begin
Angle := GetRadOfLine(sCoord,eCoord);
For i := 0 to Segments.Count -1 do
begin
Segment := TvectorSegment(Segments[i]);
if segment.SegmentType = vstLine then
begin
ePoint := Segment.EndPoint;
ePoint.x := ePoint.x*Scale;
ePoint := DoublePoint(ePoint.x+sCoord.x,ePoint.y+sCoord.y);
ePoint := RotatePoint(sCoord,ePoint,angle);
DEngine.LineTo(ePoint);
end else
begin
ePoint := Segment.EndPoint;
ePoint.x := ePoint.x*Scale;
ePoint := DoublePoint(ePoint.x+sCoord.x,ePoint.y+sCoord.y);
ePoint := RotatePoint(sCoord,ePoint,angle);
cP1 := Segment.CPoint1;
cP1.x := cp1.x*Scale;
cP1 := DoublePoint(CP1.x+sCoord.x,CP1.y+sCoord.y);
cP1 := RotatePoint(sCoord,cP1,angle);
cP2 := Segment.CPoint2;
cP2.x := cP2.x*Scale;
cP2 := DoublePoint(CP2.x+sCoord.x,CP2.y+sCoord.y);
cP2 := RotatePoint(sCoord,cP2,angle);
DEngine.BezierTo(cp1.x,cp1.y,cp2.x,cp2.y,ePoint.x,ePoint.y);
end;
end;
end;
constructor TVector.Create(SPointY: Double);
begin
inherited create;
Segments := TList.Create;
Objects := TList.Create;
StartY := sPointY;
end;
Function TVector.Duplicate:Tvector;
var i: Integer;
begin
Result := TVector.Create(StartY);
For i := 0 to Segments.Count -1 do
begin
Result.Segments.Add(TvectorSegment(Segments[i]).Duplicate);
end;
For i := 0 to Objects.Count -1 do
begin
Result.Objects.Add(TvectorObject(Objects[i]).Duplicate);
end;
end;
Destructor TVector.Destroy;
var i: Integer;
begin
try
For i := 0 to Segments.Count -1 do
begin
TvectorSegment(Segments[i]).Free;
end;
For i := 0 to Objects.Count -1 do
begin
TvectorObject(Objects[i]).Free;
end;
//Tolik
{ Segments.Clear;
Objects.Clear;}
//
Segments.Free;
Objects.Free;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TVector.Destroy' + E.Message);
end;
inherited;
end;
Procedure TVector.SaveToStream(Stream:TStream);
var i: Integer;
begin
Stream.Write(StartY,8);
Stream.Write(Segments.Count,4);
For i := 0 to Segments.Count -1 do
begin
TvectorSegment(Segments[i]).SaveToStream(Stream);
end;
Stream.Write(Objects.Count,4);
For i := 0 to Objects.Count -1 do
begin
TvectorObject(Objects[i]).SaveToStream(Stream);
end;
end;
Procedure TVector.LoadFromStream(Stream:TStream);
var i,cnt: Integer;
Segment: TVectorSegment;
xObject: TvectorObject;
begin
Stream.Read(StartY,8);
if CompareValue(StartY, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
StartY := 0;
Stream.Read(cnt,4);
For i := 1 to cnt do
begin
Segment := TvectorSegment.CreateFromStream(Stream);
Segments.Add(Segment);
end;
Stream.Read(cnt,4);
For i := 1 to cnt do
begin
xObject := TvectorObject.CreateFromStream(Stream);
Objects.Add(xObject);
end;
end;
procedure TVector.AddVectorObject(cObject: TVectorObject);
begin
Objects.add(cObject);
end;
procedure TVector.DrawObjects(DEngine: TPCDrawEngine; sCoord,
eCoord: TDoublePoint; Scale: Double);
var i,k: Integer;
xObject: TVectorObject;
Values: TDoublePointArr;
xPoint: TDoublePoint;
Angle: Double;
begin
Angle := GetRadOfLine(sCoord,eCoord);
For i := 0 to Objects.Count -1 do
begin
xObject := TVectorObject(Objects[i]);
SetLength(Values,xObject.ArrayLen);
xObject.GetLocalValues(Values,sCoord,scale,angle);
case xObject.ObjectType of
votLine:
DEngine.DrawLine(Values[0],Values[1]);
votBezier:
DEngine.DrawBezier(Values[0],Values[1],Values[2],Values[3]);
votEllipse:
DEngine.DrawEllipse(Values[0],Values[1].x,Values[1].y,angle);
votCircle:
DEngine.DrawCircle(Values[0],Values[1].x);
votPolyline:
DEngine.DrawPolyline(Values,False);
votPolygon:
DEngine.DrawPolyline(Values,True);
votPoint:
DEngine.DrawPoint(Values[0]);
end;
end;
end;
procedure TVector.MoveContent(dx, dy: Double);
var i: Integer;
begin
for i := 0 to Segments.Count -1 do
begin
TVectorSegment(Segments[i]).Move(dx,dy);
end;
for i := 0 to Objects.Count -1 do
begin
TVectorObject(objects[i]).Move(dx,dy);
end;
end;
procedure TVector.LoadFromStreamOldFormat(Stream: TStream);
var i,cnt,sY: Integer;
Segment: TvectorSegment;
begin
Stream.Read(sY,4);
StartY := sY/10;
Stream.Read(cnt,4);
For i := 1 to cnt do
begin
Segment := TvectorSegment.CreateFromStreamOldFormat(Stream);
Segments.Add(Segment);
end;
end;
procedure TVector.Scale(px, py: double);
var i: Integer;
begin
StartY := StartY*py;
for i := 0 to Segments.Count -1 do
TvectorSegment(Segments[i]).Scale(px,py);
for i := 0 to Objects.Count -1 do
TvectorObject(Objects[i]).Scale(px,py);
end;
{ TVectorObject }
constructor TVectorObject.CreateBezierObject(p1, p2, cp1,
cp2: TDoublePoint);
begin
inherited Create;
ObjectType := votBezier;
Setlength(Values,4);
ArrayLen := 4;
Values[0] := p1;
Values[1] := cp1;
Values[2] := cp2;
Values[3] := p2;
end;
constructor TVectorObject.CreateCircleObject(p1: TDoublePoint; r: Double);
begin
inherited Create;
ObjectType := votCircle;
ArrayLen := 2;
Setlength(Values,2);
Values[0] := p1;
Values[1] := DoublePoint(r,0) ;
end;
constructor TVectorObject.CreateEllipseObject(p1: TDoublePoint; a,b: Double);
begin
inherited Create;
ObjectType := votEllipse;
ArrayLen := 2;
Setlength(Values,2);
Values[0] := p1;
Values[1] := DoublePoint(a,b) ;
end;
constructor TVectorObject.CreateFromStream(Stream: TStream);
var valx,valy: Double;
i: Integer;
begin
inherited Create;
Stream.Read(ObjectType,1);
Stream.Read(arrayLen,4);
SetLength(Values,ArrayLen);
for i := 0 to ArrayLen -1 do
begin
Stream.Read(valx,8);
if CompareValue(valx, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
valx := 0;
Stream.Read(valy,8);
if CompareValue(valy, 0, 0.0000001) = 0 then // Tolik 23/06/2021 --
valy := 0;
Values[i] := DoublePoint(valx,valy);
end;
end;
constructor TVectorObject.CreateLineObject(p1, p2: TDoublePoint);
begin
inherited Create;
ArrayLen := 2;
ObjectType := votLine;
Setlength(Values,2);
Values[0] := p1;
Values[1] := p2;
end;
constructor TVectorObject.CreatePointObject(p: TDoublepoint);
begin
inherited Create;
ArrayLen := 1;
ObjectType := votPoint;
Setlength(Values,1);
Values[0] := p;
end;
constructor TVectorObject.CreatePolygonObject(nbrPoint: Integer;
p: array of TDoublePoint);
var i: Integer;
begin
inherited Create;
ArrayLen := nbrPoint;
ObjectType := votPolygon;
Setlength(Values,nbrPoint);
for i := 0 to nbrPoint-1 do
Values[i] := p[i];
end;
constructor TVectorObject.CreatePolyLineObject(nbrPoint: Integer;
p: array of TDoublePoint);
var i: Integer;
begin
inherited Create;
ArrayLen := nbrPoint;
ObjectType := votPolyline;
Setlength(Values,nbrPoint);
for i := 0 to nbrPoint-1 do
Values[i] := p[i];
end;
destructor TVectorObject.Destroy;
begin
Setlength(values,0);
inherited destroy;
end;
function TVectorObject.Duplicate: TVectorObject;
var i: Integer;
begin
Result := TVectorObject.Create;
Result.ObjectType := ObjectType;
Result.ArrayLen := ArrayLen;
SetLength(Result.Values,ArrayLen);
for i := 0 to ArrayLen -1 do
begin
Result.Values[i] := Values[i];
end;
end;
procedure TVectorObject.GetLocalValues(LValues: TDoublePointArr;
sCoord: TDoublePoint; Scale, Angle: Double);
var len,k: Integer;
xPoint: TDoublePoint;
begin
len := ArrayLen;
if (ObjectType = votCircle) or
(ObjectType = votEllipse) then
begin
len := Arraylen -1;
LValues[1] := Doublepoint(Values[1].x * Scale,Values[1].y * 1);
end;
for k := 0 to Len-1 do
begin
xPoint := Values[k];
xPoint := DoublePoint(xPoint.x+sCoord.x,xPoint.y+sCoord.y);
xPoint := ScalePoint(sCoord,xPoint,Scale,1);
xPoint := RotateDPoint(DoublePoint(scoord.x,scoord.y),xPoint,angle);
LValues[k] := xPoint;
end;
end;
procedure TVectorObject.Move(dx, dy: Double);
var i,pCnt: Integer;
begin
if ObjectType in [votCircle,votEllipse] then
pCnt := ArrayLen -1
else pCnt := ArrayLen;
for i := 0 to pCnt-1 do
begin
Values[i] := DoublePoint(Values[i].x+dx,Values[i].y+dy);
end;
end;
procedure TVectorObject.SaveToStream(Stream: TStream);
var i: Integer;
val: Double;
begin
Stream.Write(ObjectType,1);
Stream.Write(ArrayLen,4);
for i := 0 to ArrayLen -1 do
begin
val := Values[i].x;Stream.Write(val,8);
val := Values[i].y;Stream.Write(val,8);
end;
end;
procedure TVectorObject.Scale(px, py: double);
var len,k: Integer;
xPoint: TDoublePoint;
begin
len := ArrayLen;
if (ObjectType = votCircle) or
(ObjectType = votEllipse) then
begin
len := Arraylen -1;
Values[1] := Doublepoint(Values[1].x * px,Values[1].y * py);
end;
for k := 0 to Len-1 do
begin
xPoint := Values[k];
xPoint := ScalePoint(DoublePoint(0,0),xPoint,px,py);
Values[k] := xPoint;
end;
end;
procedure TFigure.SendSignal(port, value: Integer);
begin
//***
end;
procedure TLine.Move(deltax, deltay: Double);
begin
InMoveList := False;
if (JoinFigure1 = nil) or (JoinFigure2 = nil) then
inherited;
end;
function TFigure.GetClassName: String;
begin
Result := 'Figure';
end;
{ TUserRectangle }
procedure TUserRectangle.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
class function TUserRectangle.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TUserRectangle.create(Shadow.ap1.x,Shadow.ap1.y,
Shadow.ap3.x,Shadow.ap3.y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
TUserRectangle(Result).UserClass := Cad.CurrentUserClass;
end;
function TUserRectangle.duplicate:TFigure;
var res : TUserRectangle;
begin
res := TUserRectangle.create( originalpoints[1].x,
originalpoints[1].y,
originalpoints[3].x,
originalpoints[3].y,
width,
style,
color,
brs,
brc,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.originalpoints[4] := originalpoints[4];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
res.UserClass := UserClass;
result := res;
end;
function TUserRectangle.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
function TUserRectangle.GetClassName: String;
begin
result := 'UserRectangle';
end;
{ TUserLine }
class function TUserLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TUserLine.create( Shadow.ActualPoints[1].x,
Shadow.ActualPoints[1].y,
Shadow.ActualPoints[2].x,
Shadow.ActualPoints[2].y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultRowStyle),
LHandle,mydsNormal,cad);
TUserLine(Result).UserClass := Cad.CurrentUserClass;
end;
procedure TUserLine.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
function TUserLine.duplicate: TFigure;
var res : TUserLine;
begin
res := TUserLine.create( originalpoints[1].x,
originalpoints[1].y,
originalpoints[2].x,
originalpoints[2].y,
width,
style,
color,
RowStyle,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.rotpoint.x := rotpoint.x ;
res.rotpoint.y := rotpoint.y ;
res.AngleToPoint := AngleToPoint;
res.UserClass := UserClass;
result := res;
end;
function TUserLine.GetClassName: String;
begin
result := 'UserLine';
end;
function TUserLine.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
{ TUserVertex }
class function TUserVertex.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
result := TUserVertex.create(shadow.ap1.x,shadow.ap1.y,LHandle,mydsNormal,aOwner);
TUserVertex(Result).UserClass := Cad.CurrentUserClass;
end;
procedure TUserVertex.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
function TUserVertex.duplicate: TFigure;
begin
result := TVertex.create(originalpoints[1].x,
originalpoints[1].y, LayerHandle, DrawStyle,Owner);
result.actualpoints[1] := actualpoints[1];
result.AngleToPoint := AngleToPoint;
TUserVertex(Result).UserClass := UserClass;
end;
function TUserVertex.GetClassName: String;
begin
result := 'UserVertext';
end;
function TUserVertex.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
{ TUserCircle }
class function TUserCircle.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TUserCircle.create(shadow.ap1.x,shadow.ap1.y,
shadow.radius,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
TUserCircle(Result).UserClass := Cad.CurrentUserClass;
end;
procedure TUserCircle.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
DEngine.Canvas.Pen.Mode := pmCopy;
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
function TUserCircle.duplicate: TFigure;
var res : TuserCircle;
begin
res := TUserCircle.create( originalpoints[1].x,
originalpoints[1].y,
radius,
width,
style,
color,
brs,
brc,
LayerHandle,
drawstyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
res.UserClass := UserClass;
result := res;
end;
function TUserCircle.GetClassName: String;
begin
result := 'UserCircle';
end;
function TUserCircle.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
{ TUserArc }
class function TUserArc.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TUserArc.Create(
shadow.ap1.x,
shadow.ap1.y,
shadow.radius,
TArc(Shadow).SAngle,
TArc(Shadow).FAngle,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultArcStyle),LHandle,mydsNormal,aOwner);
TUserArc(Result).UserClass := Cad.CurrentUserClass;
end;
procedure TUserArc.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
function TUserArc.duplicate: TFigure;
var res : TUserArc;
begin
res := TUserArc.create( originalpoints[1].x,
originalpoints[1].y,
radius,
sAngle,
FAngle,
width,
style,
color,
brs,
brc,
ord(ArcStyle),
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
res.UserClass := UserClass;
result := res;
end;
function TUserArc.GetClassName: String;
begin
result := 'UserArc';
end;
function TUserArc.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
{ TUserEllipse }
class function TUserEllipse.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TUserEllipse.create(shadow.ap1.x,shadow.ap1.y,
TEllipse(Shadow).alen,
TEllipse(Shadow).blen,
TEllipse(Shadow).Angle,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);
Result.UserClass := Cad.CurrentUserClass;
end;
procedure TUserEllipse.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
function TUserEllipse.duplicate: TFigure;
var res : TUserEllipse;
begin
res := TUserEllipse.create( originalpoints[1].x,
originalpoints[1].y,
alen,
blen,
angle,
width,
style,
color,
brs,
brc,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
res.userClass := UserClass;
result := res;
end;
function TUserEllipse.GetClassName: String;
begin
result := 'UserEllipse';
end;
function TUserEllipse.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
{ TUserPolyline }
class function TUserPolyline.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
points: TDoublePointArr;
a: integer;
begin
cad := TPCDrawing(aOwner);
SetLength(points,Shadow.PointCount-2);
for a := 1 to Shadow.PointCount-2 do begin
points[a-1] := Shadow.ActualPoints[a];
end;
result := TUserPolyline.create(points,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultRowStyle),
Cad.DefaultPLineClosed,
LHandle,mydsNormal,aOwner);
Result.USerClass := Cad.CurrentUserClass;
end;
procedure TUserPolyline.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var cad: TPCDrawing;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
DEngine.Canvas.Pen.Mode := pmCopy;
if not Cad.DrawUserFigureEvent(UserClass,DEngine.Canvas.Handle,Handle,isGrayed) then inherited;
end else begin
inherited;
end;
end;
function TUserPolyline.duplicate: TFigure;
var res : TPolyLine;
newpoints : TDoublePointArr;
a: integer;
ps: TBezierPoint;
begin
SetLength(newPoints,2);
newPoints[0] := ap1;
newPoints[1] := ap2;
res := TPolyLine.create( newPoints,
width,
style,
color,
brs,
brc,
RowStyle,
Closed,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.PointCount := PointCount;
for a := 1 to PointCount do
begin
res.originalpoints[a] := originalpoints[a];
res.actualpoints[a] := actualpoints[a] ;
end;
res.ClearSegments;
for a := 0 to Segments.Count-1 do
res.Segments.Add(TplSegment(segments[a]).Duplicate);
res.rotPoint.x := rotpoint.x ;
res.rotPoint.y := rotpoint.y ;
res.AngleToPoint := AngleToPoint;
if assigned(PenPattern) then
res.PenPattern := PenPattern.Duplicate
else
res.PenPattern := nil;
res.UserClass := UserClass;
result := res;
end;
function TUserPolyline.GetClassName: String;
begin
result := 'UserPolyline';
end;
function TUserPolyline.isPointIn(x, y: double): boolean;
var cad: TPCDrawing;
test: Boolean;
begin
if assigned(Owner) then begin
cad := TPCDrawing(Owner);
if not Cad.PointInUserFigureEvent(UserClass,Handle,x,y,Test) then result := inherited isPointIn(x,y)
else result := Test;
end else begin
result := inherited isPointIn(x,y);
end;
end;
{ TFreeHand }
function TFreeHand.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
begin
result := false;
if clickindex > 1 then begin
result := true;
Info := '';
end;
end;
function TFreeHand.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean;
var dx,dy: Double;
begin
result := false;
dx := ABS(actualPoints[1].x - x);
dy := ABS(actualPoints[1].y - y);
if (dx > 5) or (dy > 5) then Info := 'X';
if (Info = 'X') and (PointCount > 2) and (dx < 3) and (dy < 3) then begin
x := actualPoints[1].x;
y := actualPoints[1].y;
end;
if not ((PointCount > 0) and
eqd(x,actualPoints[PointCount].x) and
eqd(y,actualPoints[PointCount].y)) then
begin
PointCount := PointCount+1;
actualPoints[PointCount] := DoublePoint(x,y);
end;
end;
class Function TFreeHand.CreateShadow(x,y:Double): TFigure;
var points: TDoublePointArr;
begin
SetLength(points,2);
points[0] := DoublePoint(x,y);
points[1] := DoublePoint(x,y);
CreateShadow := TFreeHand.create(Points,1,1,clLime,0,0,ord(rsNone),false,0,dsTrace,nil);
CreateShadow.PointCount := 1;
end;
procedure TFigure.SetInCombined(const Value: Boolean);
begin
fIncombined := Value;
end;
function TFreeHand.GetClassName: String;
begin
result := 'FreeHand';
end;
{ TCDimLine }
class function TCDimLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var x3,y3: Double;
p3: TDoublePoint;
begin
result := TCDimLine.Create(LHandle,mydsNormal,aOwner);
result.ActualPoints[1] := Shadow.ActualPoints[1];
result.ActualPoints[2] := Shadow.ActualPoints[2];
x3 := Shadow.ActualPoints[3].x;
y3 := Shadow.ActualPoints[3].y;
PointToParallelLine(Shadow.ActualPoints[1],Shadow.ActualPoints[2],x3,y3);
result.ActualPoints[3] := DoublePoint(x3,y3);
TCDimline(result).LStyle := TCDimline(Shadow).Lstyle;
TCDimline(result).EndType := TCDimline(Shadow).EndType;
end;
Procedure TCDimLine.Initialize;
begin
inherited;
PointCount := 2;
Prefix := 'Ø';
OuterGuide := True;
InnerGuide := False;
HorzText := True;
end;
procedure TCDimLine.getRotatePoints(ModList: TList);
var
CControl: TPCDrawing;
figMaxX, figMaxY, figMinX,figMinY:Double;
p1,p2,p3,p4,p5: TDoublePoint;
a: integer;
begin
if not assigned(owner) then exit;
CControl :=TPCDrawing(Owner);
getbounds(figMaxX,figMaxY,figMinX,figMinY);
p1 := ap1;
p2 := ap1;
p3 := ap2;
p4 := ap2;
RotPoint := MPoint(ap1,ap2);
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p1.x,p1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p2.x,p2.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p3.x,p3.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptRotPoint,ptCircle,clGreen,pointdim,p4.x,p4.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptRotCenter,ptRCenter,clRed,pointdim,RotPoint.x,RotPoint.y,5));
end;
function TCDimLine.CreateModification: TFigure;
begin
result := TCDimLine.Create(0,dsTrace,nil);
result.ActualPoints[1] := ActualPoints[1];
result.ActualPoints[2] := ActualPoints[2];
result.ActualPoints[3] := ActualPoints[3];
result.color := clLime;
result.RotPoint := RotPoint;
TCDimLine(result).EndType := EndType;
TCDimLine(result).Lstyle := Lstyle;
end;
class function TCDimLine.CreateShadow(x, y: Double): TFigure;
begin
result := TCDimline.Create(0,dsTrace,nil);
result.ActualPoints[1] := DoublePoint(x,y);
result.ActualPoints[2] := DoublePoint(x,y);
result.ActualPoints[3] := DoublePoint(x,y);
result.color := clLime;
TCDimLine(result).Lstyle := clsInner;
TCDimLine(result).HorzText := False;
end;
procedure TCDimLine.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor : Tcolor;
text:string;
dist: double;
l: integer;
st: TFontStyles;
begin
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then DEngine.Canvas.pen.mode := pmXor
else DEngine.canvas.pen.mode := pmCopy;
if DrawStyle = dsTrace then RegHandle := 1;
text := '';
if DrawStyle = mydsNormal then
begin
if autotext then begin
if assigned(owner) then
MapScale := TPCDrawing(Owner).MapScale;
dist := (GetLineLenght(ap1,ap2) *MapScale)/1000;
dist := round(dist*100)/100;
text := FormatFloat(ffMask, dist)+ ' m';
if assigned(Owner) and (TPCDrawing(Owner).RulerSystem = rsWhitworth) then
begin
dist := (((GetLineLenght(ap1,ap2) *MapScale)/10)/2.54)/12;
dist := round(dist*100)/100;
text := FormatFloat(ffMask, dist)+ ' ft';
end;
text := Prefix+text+Suffix;
end else text := DLabel;
end;
st := [];
if TextBold then st := st + [fsBold];
if TextItalic then st := st + [fsItalic];
DEngine.DrawCircleDim(ap1,ap2,Text,TextFont,st,aColor,TextColor,TextHeight,LStyle,
TextPos,EndType,HorzText,OuterGuide,InnerGuide,RegHandle);
// Tolik
if RegHandle > 1 then
begin
GetRegObject;
if (TBrushStyle(brs) <> bsClear) then
RegObject.CheckPointByRects := True;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TCDimLine.Duplicate: TFigure;
var res: TCDimLine;
begin
res := TCDimLine.Create(LayerHandle,DrawStyle,Owner);
res.DLabel := Dlabel;
res.Prefix := Prefix;
res.Suffix := Suffix;
res.AutoText := AutoText;
res.TextPos := TextPos;
res.TextFont := TextFont;
res.TextHeight := TextHeight;
res.TextBold := TextBold;
res.TextItalic := TextItalic;
res.EndType := EndType;
res.MapScale := MapScale;
res.LStyle := Lstyle;
res.InnerGuide := InnerGuide;
res.OuterGuide := OuterGuide;
res.HorzText := HorzText;
CopyProperties(res);
result := res;
end;
function TCDimLine.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
var x3,y3: Double;
begin
if mp.SeqNbr = 3 then
begin
PointToParallelLine(ActualPoints[1],ActualPoints[2],x,y);
ActualPoints[3] := DoublePoint(x,y);
end else
begin
ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
x3 := ActualPoints[3].x;
y3 := ActualPoints[3].y;
PointToParallelLine(ActualPoints[1],ActualPoints[2],x3,y3);
ActualPoints[3] := DoublePoint(x3,y3);
LStyle := TCDimLine(TraceFigure).LStyle;
end;
ResetRegion;
Modified := True;
end;
procedure TCDimLine.Getbounds(var figMaxX, figMaxY, figMinX,
figMinY:Double);
begin
GetRegionBounds(figMaxX, figMaxY, figMinX,figMinY);
end;
function TCDimLine.IsPointIn(x, y: Double): boolean;
begin
result := inherited isPointIn(x,y);
if result then exit;
result := isPointInRegion(x,y);
// Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TCDimLine.MenuClicked(CommandId: integer);
var idx: integer;
begin
idx := commandID-menuIndex;
case idx of
1: EndType := etClear;
2: EndType := etRow;
3: EndType := etDot;
4: EndType := etNick;
5: AutoText := not Autotext;
7: TextPos := tpOnLine;
8: TextPos := tpAbove;
9: TextPos := tpBelow;
11: LStyle := clsInner;
12: LStyle := clsLeft;
13: LStyle := clsRight;
14: HorzText := not HorzText;
15: InnerGuide := not InnerGuide;
16: OuterGuide := not OuterGuide;
end;
ResetRegion;
Modified := true;
end;
procedure TCDimLine.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
Case xcode of
90 : TextBold := ((pByte(data)^) = 1);
91 : TextItalic := ((pByte(data)^) = 1);
92 : AutoText := ((pByte(data)^) = 1);
93 : HorzText := ((pByte(data)^) = 1);
94 : TextPos := TDimTextPos(pByte(data)^);
95 : EndType := TEndType(pByte(data)^);
96 : LStyle := TCDimLabelStyle(pByte(data)^);
97 : InnerGuide := ((pByte(data)^) = 1);
98 : OuterGuide := ((pByte(data)^) = 1);
180: DLabel := string(pchar(data));
181: Prefix := string(pchar(data));
182: Suffix := string(pchar(data));
183: TextFont := string(pchar(data));
220: TextHeight := pDouble(data)^;
end;
end;
function TCDimLine.ShadowClick(ClickIndex:Integer; x, y:Double): Boolean;
begin
result := false;
ActualPoints[ClickIndex] := DoublePoint(x,y);
if ClickIndex = 2 then begin
result := true;
ActualPoints[3] := DoublePoint(x,y);
end;
end;
function TCDimLine.ShadowTrace(ClickIndex:Integer; x, y: Double): Boolean;
begin
if ClickIndex = 1 then
begin
ActualPoints[2] := DoublePoint(x,y);
ActualPoints[3] := DoublePoint(x,y);
end else if ClickIndex = 2 then begin
ActualPoints[3] := DoublePoint(x,y);
end;
result := true;
end;
function TCDimLine.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: Double; Shift: TShiftState): boolean;
begin
TraceFigure.ActualPoints[mp.SeqNbr] := DoublePoint(x,y);
end;
procedure TCDimLine.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var mnItem,mnSub: TMenuItem;
begin
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmEndType;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmClearEnd;
mnSub.Tag := sIndex+1;
if EndType = etClear then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRowEnd;
mnSub.Tag := sIndex+2;
if EndType = etRow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmDotEnd;
mnSub.Tag := sIndex+3;
if EndType = etDot then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmNickEnd;
mnSub.Tag := sIndex+4;
if EndType = etNick then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+5;
mnItem.Caption := fmAutoLabel;
if Autotext then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+6;
mnItem.Caption := fmTextPosition;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmOnLine;
mnSub.Tag := sIndex+7;
if textPos = tpOnline then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmAboveLine;
mnSub.Tag := sIndex+8;
if textPos = tpAbove then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmBelowLine;
mnSub.Tag := sIndex+9;
if textPos = tpBelow then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+10;
mnItem.Caption := fmLabeling;
PopMenu.Items.Add(mnItem);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmInside;
mnSub.Tag := sIndex+11;
if LStyle = clsInner then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmLeft;
mnSub.Tag := sIndex+12;
if LStyle = clsLeft then mnSub.Checked := True;
mnItem.Add(mnSub);
mnSub := TMenuItem.Create(PopMenu);
mnSub.Caption := fmRight;
mnSub.Tag := sIndex+13;
if LStyle = clsRight then mnSub.Checked := True;
mnItem.Add(mnSub);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+14;
mnItem.Caption := fmAlwaysHorizontal;
if Horztext then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+15;
mnItem.Caption := fmInnerGuide;
if InnerGuide then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+16;
mnItem.Caption := fmOuterGuide;
if OuterGuide then mnItem.Checked := True;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+17;
end;
procedure TCDimLine.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
xStr := DLabel;WriteStrField(180,Stream,xStr);
xStr := Prefix;WriteStrField(181,Stream,xStr);
xStr := Suffix;WriteStrField(182,Stream,xStr);
xStr := TextFont;WriteStrField(183,Stream,xStr);
xDbl := TextHeight; WriteField(220,Stream,xDbl,8);
if TextBold then xByte := 1 else xByte := 0;
WriteField(90,Stream,xByte,1);
if TextItalic then xByte := 1 else xByte := 0;
WriteField(91,Stream,xByte,1);
if AutoText then xByte := 1 else xByte := 0;
WriteField(92,Stream,xByte,1);
if HorzText then xByte := 1 else xByte := 0;
WriteField(93,Stream,xByte,1);
xByte := ord(TextPos);WriteField(94,Stream,xByte,1);
xByte := ord(EndType);WriteField(95,Stream,xByte,1);
xByte := ord(LStyle);WriteField(96,Stream,xByte,1);
if InnerGuide then xByte := 1 else xByte := 0;
WriteField(97,Stream,xByte,1);
if OuterGuide then xByte := 1 else xByte := 0;
WriteField(98,Stream,xByte,1);
end;
function TCDimLine.GetClassName: String;
begin
result := 'CDimLine';
end;
{ TArcDimLine }
class function TArcDimLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TArcDimline.Create(
shadow.ap1.x,
shadow.ap1.y,
shadow.radius,
TArc(Shadow).SAngle,
TArc(Shadow).FAngle,LHandle,mydsNormal,aOwner);
TArcDimline(Result).GuideLen := shadow.radius;
end;
function TArcDimLine.CreateModification: TFigure;
begin
result := TArcDimLine.create(ap1.x,
ap1.y,
Radius,
SAngle,
FAngle,0,dsTrace,nil);
TArcDimLine(result).LStyle := LStyle;
TArcDimLine(result).GuideLen := GuideLen;
TArcDimLine(result).DrawGuides := DrawGuides;
result.color := clLime;
result.RotPoint := RotPoint;
end;
class function TArcDimLine.CreateShadow(x, y: Double): TFigure;
begin
result := TArcDimline.create(x,y,0,0,0,0,dsTrace,nil);
result.color := clLime;
end;
procedure TArcDimLine.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor,bcolor : Tcolor;
dx,dy: real;
Angle,rad,MAngle: Double;
p4,p1,p2: TDOublePoint;
st: TFontstyles;
text: String;
gLen: Double;
begin
//07.10.2011 - ñáðîñ óãëîâ äëÿ ïåðåñ÷åòà, åñëè âûøëè çà ïðåäåëû 2*pi
if (DrawStyle = mydsNormal) and ((FAngle > 2*pi) or (SAngle > 2*pi)) then
begin
SAngle := 0;
FAngle := 0;
end;
if (FAngle = 0) and (SAngle = 0) and (DrawStyle = mydsNormal)
then
begin
Angle := GetradOfLine(ap1,ap2);
SAngle := Angle;
Angle := GetradOfLine(ap1,ap3);
FAngle := Angle;
end;
acolor := color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (isGrayed) then begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.Canvas.Pen.Mode := pmXor
else
DEngine.Canvas.Pen.Mode := pmCopy;
st := [];
if TextBold then st := st + [fsBold];
if TextItalic then st := st + [fsItalic];
text := '';
if DrawStyle = mydsNormal then
begin
if autotext then begin
if FAngle = SAngle then
begin
MAngle := 2*PI;
end else begin
if (FAngle < SAngle) then begin
MAngle := 2*Pi - SAngle+ FAngle;
end else begin
MAngle := FAngle-SAngle;
end;
end;
text := FloatToStr(Round2((MAngle/PI)*180)); //07.10.2011 inttostr(round((MAngle/PI)*180));
text := Prefix+text+Suffix;
end else text := DLabel;
end;
if DrawGuides then
gLen := GuideLen
else
gLen := 0;
Dengine.DrawArcDim(ap1,radius,SAngle,FAngle,text,TextFont,st,aColor,TextColor,TextHeight,gLen,LStyle,
RegHandle,p1,p2);
actualpoints[2] := p1;
actualpoints[3] := p2;
// Tolik
if RegHandle > 1 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := True;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TArcDimLine.Duplicate: TFigure;
var res : TArcDimLine;
begin
res := TArcDimLine.create( originalpoints[1].x,
originalpoints[1].y,
radius,
sAngle,
FAngle,
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
res.GuideLen := GuideLen;
result := res;
end;
function TArcDimLine.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
var Angle: Double;
cp: TDoublepoint;
r: Double;
bool:Boolean;
begin
bool := (radius = GuideLen);
result := Inherited EndModification(CadControl,mp,TraceFigure,x,y,shift);
if mp.SeqNbr = 4 then begin
if bool then GuideLen := Radius;
if GuideLen > Radius then GuideLen := Radius;
end else if mp.SeqNbr = 5 then begin
cp := ap1;
R := sqrt( sqr(x - cp.x)+sqr(y - cp.y) );
GuideLen := Radius-r;
end;
end;
procedure TArcDimLine.Getbounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
inherited GetBounds(figMaxX, figMaxY, figMinX,figMinY);
end;
procedure TArcDimLine.getModPoints(ModList: TMyList);
var
p4: TDoublePoint;
MAngle: Double;
CControl: TPCDrawing;
begin
if DrawGuides then begin
CControl := TPCDrawing(Owner);
if (FAngle < SAngle) then begin
MAngle := SAngle+((2*pi)-SAngle+FAngle)/2;
end else begin
MAngle := (SAngle+FAngle)/2;
end;
p4 := DoublePoint(ap1.x+Radius-GuideLen,ap1.y);
p4 := RotatePoint(ap1,p4,MAngle);
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,p4.x,p4.y,5));
end;
inherited GetModPoints(ModList);
end;
procedure TArcDimLine.Initialize;
begin
inherited;
GuideLen := 10;
DrawGuides:= True;
Autotext := True;
Dlabel := '';
Prefix := '';
Suffix := '°';
TextFont := 'Courier New';
TextHeight:= 4;
TextBold:= False;
TextItalic:= False;
Dlabel := 'Label';
LStyle := rlsInner;
TextColor := clBlack;
end;
Function TArcDimLine.Edit:Boolean;
var
enterstr: string;
begin
Result := False;
EnterStr := FloatToStr(Round2(GetAngle)); //06.10.2011 DLabel;
// if InputQuery(capDimensionLabel, msEnterNewLabelText, EnterStr) then
//06.10.2011 if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
begin
//DLabel := EnterStr;
//AutoText := False;
//Modified := True;
//result := true;
result := SetAngle(StrToFloat_My(EnterStr));
end;
end;
function TArcDimLine.IsPointIn(x, y: Double): boolean;
begin
result := inherited isPointIn(x,y);
if not result then begin
result := isPointInRegion(x,y);
// Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
end;
procedure TArcDimLine.MenuClicked(CommandId: integer);
var mnIdx: integer;
begin
mnIdx := CommandId-MenuIndex;
case mnIdx of
0: DrawGuides:= not DrawGuides;
1: LStyle:= rlsInner;
2: LStyle:= rlsOuter;
3: Invert;
4: AutoText := not AutoText;
end;
end;
procedure TArcDimLine.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited WriteToStream(Stream);
xStr := DLabel;WriteStrField(180,Stream,xStr);
xStr := Prefix;WriteStrField(181,Stream,xStr);
xStr := Suffix;WriteStrField(182,Stream,xStr);
xStr := TextFont;WriteStrField(183,Stream,xStr);
xDbl := TextHeight; WriteField(230,Stream,xDbl,8);
xDbl := GuideLen; WriteField(231,Stream,xDbl,8);
if TextBold then xByte := 1 else xByte := 0;
WriteField(100,Stream,xByte,1);
if TextItalic then xByte := 1 else xByte := 0;
WriteField(101,Stream,xByte,1);
if AutoText then xByte := 1 else xByte := 0;
WriteField(102,Stream,xByte,1);
if DrawGuides then xByte := 1 else xByte := 0;
WriteField(103,Stream,xByte,1);
xByte := ord(LStyle);WriteField(104,Stream,xByte,1);
end;
procedure TArcDimLine.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
inherited;
Case xcode of
100 : TextBold := ((pByte(data)^) = 1);
101 : TextItalic := ((pByte(data)^) = 1);
102 : AutoText := ((pByte(data)^) = 1);
103 : DrawGuides := ((pByte(data)^) = 1);
104 : LStyle := TArcDimLabelStyle(pByte(data)^);
180: DLabel := string(pchar(data));
181: Prefix := string(pchar(data));
182: Suffix := string(pchar(data));
183: TextFont := string(pchar(data));
230: TextHeight := pDouble(data)^;
231: GuideLen := pDouble(data)^;
end;
end;
function TArcDimLine.ShadowClick(ClickIndex: Integer; x,
y: Double): Boolean;
begin
result := inherited ShadowClick(ClickIndex,x,y);
end;
function TArcDimLine.ShadowTrace(ClickIndex: Integer; x,
y: Double): Boolean;
begin
result := inherited ShadowTrace(ClickIndex,x,y);
end;
function TArcDimLine.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
begin
result := inherited TraceModification(CadControl,mp,TraceFigure,x,y,shift);
end;
procedure TArcDimLine.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var mnItem,subItem:TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDrawGuides;
mnItem.Tag := sIndex;
if DrawGuides then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDimPosition;
mnItem.Tag := 0;
PopMenu.Items.Add(mnItem);
subItem := TMenuItem.Create(PopMenu);
subItem.Caption := fmInsideArc;
subItem.Tag := sIndex+1;
if LStyle = rlsInner then subItem.Checked := true;
mnItem.Add(subItem);
subItem := TMenuItem.Create(PopMenu);
subItem.Caption := fmOutsideArc;
subItem.Tag := sIndex+2;
if LStyle = rlsOuter then subItem.Checked := true;
mnItem.Add(subItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmInvertArc;
mnItem.Tag := sIndex+3;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmAutoLabel;
mnItem.Tag := sIndex+4;
if AutoText then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+5;
end;
function TFigure.GetEndPoint: TDoublePoint;
begin
result := FigurePoints[PointCount];
end;
function TFigure.GetStartPoint: TDoublePoint;
begin
result := FigurePoints[1];
end;
function TArc.GetEndPoint: TDoublePoint;
begin
result := ap3;
end;
function TArc.GetStartPoint: TDoublePoint;
begin
result := ap2;
end;
function TElpArc.GetEndPoint: TDoublePoint;
begin
result := ap3;
end;
function TElpArc.GetStartPoint: TDoublePoint;
begin
result := ap2;
end;
function TFigure.IsWelded(f: Tfigure): Integer;
var p1,p2,x1,x2: TDoublePoint;
w1,w2: Boolean;
begin
result := 0;
p1 := GetStartPoint;
p2 := GetEndPoint;
x1 := f.GetStartPoint;
x2 := f.GetEndPoint;
w1 := EQDP(p1,x1) or EQDP(p1,x2);
w2 := EQDP(p2,x1) or EQDP(p2,x2);
if (w1 and w2) then result := 3
else if w1 then result := 1
else if w2 then result := 2;
end;
function TArcDimLine.GetClassName: String;
begin
result := 'ArcDimLine';
end;
function TArcDimLine.ModifyTextAndFont(mm: TModifyMode; valueI: Double;
valueS: string; valueSt: TFontStyles; ValueB: Boolean): Boolean;
begin
result := true;
if mm = mmFontName then
begin
TextFont := ValueS;
modified := true;
end
else if mm = mmFontSize then
begin
TextHeight := valueI;
modified := true;
end
else if mm = mmFontColor then
begin
TextColor := Round(valueI);
end
else if mm = mmFontBold then
begin
TextBold := ValueB;
modified := true;
end
else if mm = mmFontItalic then
begin
TextItalic := ValueB;
modified := true;
end;
end;
function TArcDimLine.GetAngle: Double;
var
Angle1, Angle2: Double;
begin
Result := 0;
Angle2 := GetradOfLine(ap1,ap2);
Angle1 := GetradOfLine(ap1,ap3);
if Angle1 = Angle2 then
Result := 2*PI
else
begin
if (Angle1 < Angle2) then
Result := 2*Pi - Angle2+ Angle1
else
Result := Angle1-Angle2;
end;
Result := Result *(180/pi);
end;
procedure TArcDimLine.Scale(percentx, percenty: Double; rPoint: TDoublePoint);
var
p1,p2:TDoublePoint;
cp: TDoublePOint;
division: Double;
Begin
division := $FFFF;
if GuideLen > 0 then
division := Radius / GuideLen;
Inherited;
if (division <> $FFFF) and (division <> 0) then
GuideLen := Radius / division;
end;
function TArcDimLine.SetAngle(AValue: Double): Boolean;
var
NewAngle, AngleDelta: Double;
begin
Result := false;
if (FAngle = 0) and (SAngle = 0) then
begin
SAngle := GetradOfLine(ap1,ap2);
FAngle := GetradOfLine(ap1,ap3);
end;
if (AValue >= 0) and (AValue <= 360) then
begin
NewAngle := (AValue/180)*pi;
//if (NewAngle = 0) or (NewAngle = 2*Pi) then
//begin
// SAngle := 0;
// FAngle := 0;
//end
//else
begin
AngleDelta := 0;
if (FAngle < SAngle) then
begin
AngleDelta := NewAngle - (2*Pi - SAngle + FAngle);
SAngle := SAngle - AngleDelta;
if SAngle > 2*pi then
SAngle := SAngle - (2*pi);
end
else
begin
AngleDelta := NewAngle - (FAngle-SAngle);
FAngle := FAngle + AngleDelta;
if FAngle > 2*pi then
FAngle := FAngle - (2*pi);
end;
// Åñëè óãëû ïî÷òè îäèíàêîâû
if Abs(FAngle - SAngle) < 0.01 then
SAngle := FAngle;
Result := true;
ResetRegion;
Modified := True;
end;
end;
end;
constructor TArcDimLine.Create(cx, cy, rad, a1, a2: Double;
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
inherited Create(cx,cy,rad,a1,a2,1,ord(psSolid),clBlack,ord(bsClear),
clWhite,ord(asOpen),LHandle,adrawStyle,aOwner)
end;
{ TElpArc }
constructor TElpArc.create(cx, cy, radA, radB, a1, a2: Double;aAngle:Double; w, s, c,
abrs, abrc, aArcStyle, LHandle: Integer; aDrawStyle: TDrawStyle;
aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(cx,cy);
actualpoints[1] := DoublePoint(cx,cy);
originalpoints[2] := DoublePoint(cx,cy);
actualpoints[2] := DoublePoint(cx,cy);
originalpoints[3] := DoublePoint(cx,cy);
actualpoints[3] := DoublePoint(cx,cy);
originalpoints[4] := RotatePoint(ap1,DoublePoint(ap1.x + radA,ap1.y),aAngle);
actualpoints[4] := Originalpoints[4];
SAngle:= a1;
FAngle:= a2;
ALen := rada;
BLen := radb;
ArcStyle := TArcStyle(aArcStyle);
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
angle := aAngle;
end;
function TElpArc.CreateModification: TFigure;
begin
result := TElpArc.create(ap1.x,
ap1.y,
ALen,
BLen,
SAngle,
FAngle,
Angle,
1,1,clLime,0,0,0,0,dsTrace,nil);
Result.ActualPoints[1] := ap1;
Result.ActualPoints[2] := ap2;
Result.ActualPoints[3] := ap3;
Result.ActualPoints[4] := ap4;
TElpArc(result).ArcStyle := asOpen;
//TElpArc(result).Angle := Angle;
result.RotPoint := RotPoint;
end;
class function TElpArc.CreateShadow(x, y: Double): TFigure;
begin
result := TElpArc.create(x,y,0.1,0.1,0,0,0,1,1,clLime,0,0,0,0,dsTrace,nil);
end;
procedure TElpArc.Initialize;
begin
inherited;
pointcount := 4;
end;
function TElpArc.EndModification(CadControl: Pointer;mp: TModPoint;
TraceFigure: TFigure; x,y: Double;Shift: TShiftState): boolean;
var xAngle: Double;
p1: TDoublepoint;
begin
p1 := DoublePoint(x,y);
if mp.SeqNbr = 2 then begin
p1 := RotatePoint(ap1,p1,-1*Angle);
xAngle := GetRadOfLine(ap1,p1);
SAngle := xAngle;
end else if mp.SeqNbr = 3 then begin
p1 := RotatePoint(ap1,p1,-1*Angle);
xAngle := GetRadOfLine(ap1,p1);
FAngle := xAngle;
end else if (mp.SeqNbr = 4) then
begin
ALen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y));
end else if (mp.SeqNbr = 5) then
begin
BLen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y));
end else if (mp.SeqNbr = 6) then
begin
xAngle := GetRadOfLine(ap1,p1);
p1 := DoublePoint(ap1.x+ALen,ap1.y);
ActualPoints[4] := RotatePoint(ap1,p1,xAngle);
end;
ResetRegion;
Modified := True;
end;
function TElpArc.ShadowClick(ClickIndex:Integer;x,y: Double): Boolean;
var cp,p1: TDoublePoint;
begin
result := false;
Angle := 0;
if clickIndex = 2 then
begin
ALen := sqrt(sqr(x - ap1.x) + sqr(y - ap1.y));
BLen := ALen;
end
else
if clickIndex = 3 then
begin
BLen := sqrt(sqr(x - ap1.x) + sqr(y - ap1.y));
cp := ap1;
p1 := DoublePoint(x,y);
p1 := RotatePoint(cp,p1,-1*Angle);
SAngle := GetradOfLine(cp,p1);
FAngle := SAngle;
result := false;
end
else
if clickindex = 4 then
begin
cp := ap1;
p1 := DoublePoint(x,y);
p1 := RotatePoint(cp,p1,-1*Angle);
FAngle := GetradOfLine(cp,p1);
result := true;
end;
end;
class function TElpArc.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := TElpArc.Create(
shadow.ap1.x,
shadow.ap1.y,
TElpArc(Shadow).ALen,
TElpArc(Shadow).BLen,
TElpArc(Shadow).SAngle,
TElpArc(Shadow).FAngle,
TElpArc(Shadow).Angle,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultArcStyle),LHandle,mydsNormal,aOwner);
end;
function TElpArc.ShadowTrace(ClickIndex:Integer;x,y:Double): Boolean;
var rad:Double;
cp,p1,p2: TDoublepoint;
begin
Angle := 0;
If ClickIndex = 1 then
begin
rad := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
ALen := rad;
BLen := rad;
end else If ClickIndex = 2 then
begin
rad := sqrt(sqr(x - ap1.x)+
sqr(y - ap1.y));
BLen := Rad;
cp := ap1;
p1 := DoublePoint(x,y);
p1 := RotatePoint(cp,p1,-1*Angle);
SAngle := GetradOfLine(cp,p1);
FAngle := SAngle;
end
else if ClickIndex = 3 then
begin
cp := ap1;
p1 := DoublePoint(x,y);
p1 := RotatePoint(cp,p1,-1*Angle);
FAngle := GetradOfLine(cp,p1);
end;
end;
function TElpArc.TraceModification(CadControl: Pointer;mp: TModPoint;TraceFigure:TFigure;
x, y: Double;Shift: TShiftState): boolean;
var xAngle: Double;
p1: TDoublepoint;
begin
p1 := DoublePoint(x,y);
if mp.SeqNbr = 2 then begin
p1 := RotatePoint(ap1,p1,-1*Angle);
xAngle := GetRadOfLine(ap1,p1);
TElpArc(TraceFigure).SAngle := xAngle;
end else if mp.SeqNbr = 3 then begin
p1 := RotatePoint(ap1,p1,-1*Angle);
xAngle := GetRadOfLine(ap1,p1);
TElpArc(TraceFigure).FAngle := xAngle;
end else if (mp.SeqNbr = 4) then
begin
TElpArc(TraceFigure).ALen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y));
end else if (mp.SeqNbr = 5) then
begin
TElpArc(TraceFigure).BLen := sqrt( sqr(x - ap1.x)+sqr(y - ap1.y));
end else if (mp.SeqNbr = 6) then
begin
xAngle := GetRadOfLine(ap1,p1);
p1 := DoublePoint(ap1.x+ALen,ap1.y);
TraceFigure.ActualPoints[4] := RotatePoint(ap1,p1,xAngle);
end;
end;
procedure TElpArc.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xDbl: Double;
begin
inherited;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
//xByte := brs;
WriteField(90,Stream,xByte,1);
xByte := ord(ArcStyle);
WriteField(91,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xDbl := ALen;
WriteField(222,Stream,xDbl,8);
xDbl := BLen;
WriteField(223,Stream,xDbl,8);
xDbl := SAngle;
WriteField(220,Stream,xDbl,8);
xDbl := FAngle;
WriteField(221,Stream,xDbl,8);
end;
Procedure TElpArc.SetPropertyFromStream(xCode:Byte;data:pointer;size:integer);
begin
Case xcode of
20: brc := pInt(data)^;
21: Radius := pInt(data)^/10;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
91: ArcStyle := TArcStyle(pByte(data)^);
220: SAngle := pDouble(data)^;
221: FAngle := pDouble(data)^;
222: ALen := pDouble(data)^;
223: BLen := pDouble(data)^;
end;
end;
procedure TElpArc.draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var
acolor, bColor : Tcolor;
dx, dy: real;
xAngle: Double;
p1, p2: TDOublePoint;
aawidth: integer;
begin
aawidth := width;
if width > 1 then
begin
if TPCDrawing(owner).ZoomScale < 100 then
begin
aawidth := Trunc(width * (TPCDrawing(owner).ZoomScale / 100));
if aawidth = 0 then
aawidth := 1;
end;
end;
if (ap4.y = ap1.y) then
begin
if (ap4.x > ap1.x) then
angle := 0
else
angle := pi
end
else
if (ap4.x = ap1.x) then
begin
if (ap4.y > ap1.y) then
angle := -1 * (pi / 2)
else
angle := pi / 2
end
else
begin
Angle := GetRadOfLine(ap1, ap4);
end;
Angle := 0;
if (FAngle = 0) and (SAngle = 0)
then
begin
p1 := RotatePoint(ap1, ap2, -1 * Angle);
p2 := RotatePoint(ap1, ap3, -1 * Angle);
xAngle := GetradOfLine(ap1,p1);
SAngle := xAngle;
xAngle := GetradOfLine(ap1,p2);
FAngle := xAngle;
end;
acolor := color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
bColor := brc;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
if (isGrayed) then begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bcolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.Canvas.Pen.Mode := pmXor
else
DEngine.Canvas.Pen.Mode := pmCopy;
if NeedRegion and (ArcStyle <> asOpen) then
DEngine.drawbezelparc(ap1.x,ap1.y,ALen,BLen,SAngle,FAngle,Angle,acolor, aawidth,style,
bColor,GDIbrs,Ord(ArcStyle),RegHandle,p1,p2,InCombined,RowStyle);
if ArcStyle <> asOpen then DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
DEngine.drawbezelparc(ap1.x,ap1.y,ALen,BLen,SAngle,FAngle,Angle,acolor, aawidth,style,
bColor,GDIbrs,Ord(ArcStyle),RegHandle,p1,p2,InCombined,RowStyle);
actualpoints[2] := NormalizePoint(p1);
actualpoints[3] := NormalizePoint(p2);
// Tolik
if RegHandle > 1 then
begin
GetRegObject;
if (TBrushStyle(brs) <> bsClear) then
RegObject.CheckPointByRects := True;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
procedure TElpArc.getModPoints(ModList: TMyList);
var
p4,p5,p6: TDoublePoint;
CControl: TPCDrawing;
dx,dy: Double;
MAngle: Double;
begin
CControl := TPCDrawing(Owner);
p4 := DoublePoint(ap1.x-ALen,ap1.y);
p5 := DoublePoint(ap1.x,ap1.y+BLen);
p6 := DoublePoint(ap1.x+ALen,ap1.y);
p4 := RotatePoint(ap1,p4,Angle);
p5 := RotatePoint(ap1,p5,Angle);
p6 := RotatePoint(ap1,p6,Angle);
if (ALen = 0) and (BLen = 0) then begin
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,p4.x,p4.y,4));
end else begin
ModList.Add(CControl.RegisterModPoint(self,ptUndefined,ptCross,clBlue,pointdim,ap1.x,ap1.y,1));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clBlue,pointdim,ap2.x,ap2.y,2));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clBlue,pointdim,ap3.x,ap3.y,3));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clRed,2,p4.x,p4.y,4));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clRed,2,p5.x,p5.y,5));
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clGreen,4,p6.x,p6.y,6));
end;
end;
procedure TElpArc.getbounds(var figMaxX,figMaxY,figMinX,figMinY:Double);
begin
GetArcBounds(ap1,ALen,BLen,ord(arcstyle),sAngle,fAngle,Angle,figMaxX,figMaxY,figMinX,figMinY);
end;
function TElpArc.isAngleIn(a: Double): boolean;
begin
if FAngle > SAngle then begin
result := Between(a,SAngle,FAngle);
end else if FAngle = SAngle then begin
result := true;
end else begin
result := not Between(a,SAngle,FAngle);
end;
end;
function TElpArc.isPointIn(x,y:Double):boolean;
var CControl:TPCdrawing;
pt: TDoublePoint;
a: Double;
begin
result := false;
result := inherited isPointIn(x,y);
if result then exit;
pt := DoublePoint(x,y);
pt := RotatePoint(ap1,pt,-1*angle);
a := GetRadOfLine(ap1,pt);
result := isPointinEllipse(x,y,ap1.x,ap1.y,Alen,Blen,Angle) and isAngleIn(a);
if ((ArcStyle <> asOpen) or (SAngle = FAngle)) and (brs <> ord(bsClear)) then
begin
if IsPointInRegion(x,y) then result := true;
//Tolik
if IsPointInRegionByRegObj(x,y) then Result := True;
//
end;
end;
function TElpArc.DuplicateAsBezier: TFigure;
var Points: T2DPointArray;
cnt,cntA,i: Integer;
p: TDoublePoint;
pp: TDoublePointArr;
res: TPolyline;
cx,cy: Double;
begin
cx := ap1.x;
cy := ap1.y;
BezierElpArcPoints(Points,ap1.x,ap1.y,Alen,Blen,Angle,SAngle,FAngle);
cnt := Length(Points);
cntA := 0;
if arcStyle = asPie then cntA := 6
else if ArcStyle = asChord then cntA := 3;
SetLength(pp,cnt+cntA);
for i := 0 to cnt-1 do
begin
p := DoublePoint(Points[i].x,Points[i].y);
pp[i] := p;
end;
if arcStyle = asPie then begin
pp[cnt-1+1] := QrPoint(pp[cnt-1],ap1);
pp[cnt-1+2] := QrPoint(ap1,pp[cnt-1]);
pp[cnt-1+3] := ap1;
pp[cnt-1+4] := QrPoint(ap1,pp[0]);
pp[cnt-1+5] := QrPoint(pp[0],ap1);
pp[cnt-1+6] := pp[0];
end else if ArcStyle = asChord then begin
pp[cnt-1+1] := QrPoint(pp[cnt-1],pp[0]);
pp[cnt-1+2] := QrPoint(pp[0],pp[cnt-1]);
pp[cnt-1+3] := pp[0];
end;
SetLength(Points,0);
result := TPolyline.createFromBezierPoints(pp,Width,Style,color,Brs,Brc,0,
(ArcStyle <> asOpen),Layerhandle,mydsNormal,owner);
end;
function TElpArc.duplicate:TFigure;
var res : TElpArc;
begin
res := TElpArc.create( originalpoints[1].x,
originalpoints[1].y,
ALen,
BLen,
sAngle,
FAngle,
Angle,
width,
style,
color,
brs,
brc,
ord(ArcStyle),
LayerHandle,
DrawStyle,Owner);
res.angle := angle;
res.actualpoints[1] := actualpoints[1];
res.actualpoints[2] := actualpoints[2];
res.actualpoints[3] := actualpoints[3];
res.actualpoints[4] := actualpoints[4];
res.originalpoints[1] := originalpoints[1];
res.originalpoints[2] := originalpoints[2];
res.originalpoints[3] := originalpoints[3];
res.originalpoints[4] := originalpoints[4];
res.rotPoint.x := rotPoint.x ;
res.rotPoint.y := rotPoint.y ;
res.AngleToPoint := AngleToPoint;
result := res;
end;
function TElpArc.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
var np1,np2,pt:TDoublePoint;
iCnt,xCnt: Integer;
a: Double;
begin
result := false;
if GetLineEllipseIntersection(p1,p2,ap1,aLen,bLen,Angle,np1,np2,icnt,false) then begin
xCnt := 0;
if iCnt > 0 then begin
pt := np1;
pt := RotatePoint(ap1,pt,-1*angle);
a := GetRadOfLine(ap1,pt);
if isPointInEllipse(np1.x,np1.y,ap1.x,ap1.y,aLen,bLen,angle) and isAngleIn(a) then begin
xCnt := xcnt+1;
SetLength(pArr,xCnt);
pArr[xCnt-1] := np1;
end;
end;
if iCnt > 1 then begin
pt := np2;
pt := RotatePoint(ap1,pt,-1*angle);
a := GetRadOfLine(ap1,pt);
if isPointInEllipse(np2.x,np2.y,ap1.x,ap1.y,aLen,bLen,angle) and isAngleIn(a) then begin
xCnt := xcnt+1;
SetLength(pArr,xCnt);
pArr[xCnt-1] := np2;
end;
end;
if xCnt > 0 then result := True;
end;
end;
function TElpArc.BreakByPoint(p: TdoublePoint;var Figures: TList): boolean;
var a: Double;
Fig: Tfigure;
pt:TdoublePoint;
begin
result := false;
pt := p;
pt := RotatePoint(ap1,pt,-1*angle);
a := GetRadOfLine(ap1,pt);
if isPointInEllipse(p.x,p.y,ap1.x,ap1.y,aLen,blen,Angle) and isAngleIn(a) then begin
fig := TElpArc.create(ap1.x,ap1.y,aLen,bLen,SAngle,a,Angle,width,style,color,
brs,brc,ord(arcStyle),LayerHandle,mydsNormal,owner);
Figures.Add(fig);
fig := TElpArc.create(ap1.x,ap1.y,aLen,bLen,a,Fangle,Angle,width,style,color,
brs,brc,ord(arcStyle),LayerHandle,mydsNormal,owner);
Figures.Add(fig);
result := true;
end;
end;
Procedure TElpArc.Invert;
var tA: double;
Begin
ta := SAngle;
Sangle := FAngle;
FAngle := ta;
Resetregion;
Modified := true;
End;
procedure TElpArc.VerifyZeroPoints(orgV, orgH: Byte);
begin
inherited;
if (orgV <> VertZero) then
begin
SAngle := 2*pi - SAngle;
FAngle := 2*pi - FAngle;
Invert;
end;
if (orgH <> HorzZero) then
begin
SAngle := pi - SAngle;
FAngle := pi - FAngle;
Invert;
end;
end;
procedure TElpArc.ArrangeStyle(val: TArcStyle);
begin
ArcStyle := val;
Resetregion;
end;
Procedure TElpArc.Mirror(Point1,Point2: TDoublePoint);
var p1: TDoublePoint;
dx,dy:Double;
begin
inherited Mirror(Point1,Point2);
SAngle := 0;
FAngle := 0;
p1 := ap2;
ActualPoints[2] := ap3;
ActualPoints[3] := p1;
ResetRegion;
end;
procedure TElpArc.Rotate(aAngle: Double; cPoint: TDoublePoint);
var
a: integer;
point1,point2 :TPoint;
pd1 :TDoublePoint;
fig: TFigure;
Cad: TPCDrawing;
elp: TEllipse;
ElpArc: TElpArc;
Arc: TElpArc;
begin
inherited;
(*
Cad := TPCdrawing(owner);
Cad.ClearUndoList;
Arc := TElpArc(self);
fig := Arc;
pd1.X := Arc.ap1.x;
pd1.y := Arc.ap1.y;
pd1 := RotatePoint(cPoint, pd1);
ElpArc := TElpArc.create(pd1.x, pd1.y, arc.Radius, arc.Radius, arc.SAngle + aAngle, arc.FAngle + aAngle, arc.Angle,
fig.Width, fig.Style, fig.Color, fig.brs, fig.brc, ord(asOpen), fig.LayerHandle, mydsNormal, fig.Owner);
// ElpArc.Scale(percentx, percenty, rPoint);
Arc.Destroy;
*)
(*
If modified or ((cPoint.x <> rotpoint.x) or (cPoint.y <> rotpoint.y)) then
begin
angletoPoint := 0;
for a := 1 to pointcount do originalpoints[a] := actualpoints[a];
rotpoint.x := cPoint.x;
rotpoint.y := cPoint.y;
end;
angletoPoint := angletoPoint + Aangle;
for a:= 1 to pointcount do
begin
actualpoints[a] := RotatePoint(cPoint,originalpoints[a],angletoPoint);
end;
if DimLines.Count > 0 then CreateDimLines;
if assigned(Fill) then Fill.Rotate(aAngle,cPoint);
ResetRegion;
*)
Fangle := 0;
SAngle := 0;
draw(GCadForm.PCad.DEngine, False);
// SAngle := GetradOfLine(ap1, ap2);
// FAngle := GetradOfLine(ap1, ap3);
// SAngle := SAngle + aAngle;
// if SAngle > 2 * pi then
// SAngle := SAngle - 2 * pi;
// FAngle := FAngle + aAngle;
// if FAngle > 2 * pi then
// FAngle := FAngle - 2 * pi;
end;
Procedure TElpArc.Scale(percentx,percenty: double; rPoint: TDoublepoint);
var
p1, p2: TDoublePoint;
cp: TDoublePOint;
x: double;
Realp1, Realp2: TDoublePoint;
ta: double;
a1, a2: double;
Begin
cp := ap1;
Inherited;
p1 := DoublePoint(cp.x + Alen, cp.y);
p2 := DoublePoint(cp.x, cp.y + Blen);
p1 := RotatePoint(cp, p1, Angle);
p2 := RotatePoint(cp, p2, Angle);
p1 := ScalePoint(rPoint, p1, percentx, percenty);
p2 := ScalePoint(rPoint, p2, percentx, percenty);
ALen := GetLineLenght(ap1, p1);
Blen := GetLineLenght(ap1, p2);
a1 := SAngle;
a2 := FAngle;
if percentx < 0 then
begin
a1 := a1 + 2 * (pi / 2 - a1);
a2 := a2 + 2 * (pi / 2 - a2);
ta := a2;
a2 := a1;
a1 := ta;
end;
if percenty < 0 then
begin
a1 := a1 + 2 * (pi - a1);
a2 := a2 + 2 * (pi - a2);
ta := a2;
a2 := a1;
a1 := ta;
end;
Sangle := a1;
FAngle := a2;
Fangle := 0;
SAngle := 0;
draw(GCadForm.PCad.DEngine, False);
End;
procedure TElpArc.MenuClicked(CommandId: integer);
var mnIdx: integer;
begin
mnIdx := CommandId-MenuIndex;
case mnIdx of
0: ArcStyle:= asOpen;
1: ArcStyle:= asPie;
2: ArcStyle:= asChord;
3: Invert;
end;
end;
procedure TElpArc.UpdateMenu(var popMenu: TPopUpMenu; var sIndex: Integer);
var mnItem:TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmOpenArc;
mnItem.Tag := sIndex;
if arcStyle = asOpen then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmPieArc;
mnItem.Tag := sIndex+1;
if arcStyle = asPie then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmChordArc;
mnItem.Tag := sIndex+2;
if arcStyle = asChord then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmInvertArc;
mnItem.Tag := sIndex+3;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+4;
end;
Function TFigure.Knife(p1,p2:TdoublePoint;Figures:TList):Boolean;
var pArr: TdoublePointArr;
begin
result := false;
if GetLinearInterSections(p1,p2,pArr) then
begin
result := BreakByPoints(parr,Figures);
SetLength(parr,0);
end;
end;
function TFigure.BreakByPoint(p: TdoublePoint; var Figures: TList): boolean;
begin
result := false;
end;
Function TFigure.GetLinearInterSections(p1,p2:TDoublePoint; var pArr:TDoublePointArr):Boolean;
begin
result := false;
end;
function TFigure.BreakbyPoints(p: TdoublePointArr; var Figures: TList):Boolean;
var pcnt,i,k,fcnt: Integer;
p1: TDoublePoint;
Fig: Tfigure;
iList: Tlist;
begin
pCnt := Length(p);
Figures.Add(Self);
result := false;
iList := TList.Create;
for i := 0 to pcnt-1 do
begin
k := 0;
p1 := p[i];
fcnt := Figures.Count;
for k := 0 to fCnt-1 do
begin
Fig := Tfigure(Figures[k]);
if Fig.BreakByPoint(p1,Figures) then begin
iList.Add(Fig);
result := true;
end;
end;
try
for k := 0 to iList.Count - 1 do
Figures.Remove(iList[k]);
iList.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.BreakbyPoints' + E.Message);
end;
end;
Figures.Remove(Self);
//Tolik
iList.Free;
end;
function TElpArc.Offset(Thick: Double): TFigure;
begin
if vertZero = ord(vzBottom) then Thick := -Thick;
result := TElpArc.create(ap1.x,ap1.y,aLen-thick,bLen-thick,SAngle,FAngle,
angle,width,style,color,brs,brc,ord(arcStyle),LayerHandle,mydsNormal,owner);
end;
function TElpArc.GetClassName: String;
begin
result := 'ElpArc';
end;
{ TKnife }
class function TKnife.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
cad.KnifeSelection(Shadow.ap1,Shadow.ap2);
result := nil;
end;
class function TKnife.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TKnife.create(DoublePoint(x,y),DoublePoint(x,y));
end;
function TFigure.Offset(Thick: Double): TFigure;
begin
result := nil;
end;
function TLine.Offset(Thick: Double): TFigure;
var p1,p2: TDoublePoint;
begin
GetParallelPoints(ap1,ap2,p1,p2,Thick);
Result := TLine.create(p1.x,p1.y,p2.x,p2.y,Width,Style,Color,ord(RowStyle),
LayerHandle,mydsNormal,owner);;
end;
function TPolyline.Offset(Thick: Double): TFigure;
var NewSegments: TList;
pArr: TDoublePointArr;
pl: TPolyline;
mSeg,nSeg: TPLSegment;
i,pCnt:Integer;
begin
result := nil;
NewSegments := TList.Create;
OffsetSegments(NewSegments,Thick);
// Tolik 18/05/2018 --
//if newsegments.Count = 0 then exit;
if newsegments.Count = 0 then
begin
NewSegments.Free; // free mem
exit;
end;
//
if Closed then pCnt := newSegments.Count else pCnt := newSegments.Count+1;
SetLength(pArr,pCnt);
for i := 0 to newSegments.Count-1 do
begin
pArr[i] := TPLSegment(newSegments[i]).tp1;
end;
if not Closed then
pArr[pCnt-1] := TPLSegment(newSegments[pCnt-2]).tp2;
pl := TPolyline.create(pArr,width,style,color,brs,brc,ord(rowStyle),
Closed,LayerHandle,mydsNormal,owner);
for i := 0 to newSegments.Count - 1 do
begin
mSeg := TPLSegment(pl.Segments[i]);
nSeg := TPLSegment(newSegments[i]);
mSeg.CopyFrom(nSeg);
end;
try
for i := 0 to newSegments.Count - 1 do
begin
TPLSegment(newSegments[i]).Free;
end;
newSegments.Free;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPolyline.Offset' + E.Message);
end;
result := pl;
NeedBounds := True; //Tolik 02/08/2021 --
end;
function TEllipse.Offset(Thick: Double): TFigure;
begin
if vertZero = ord(vzBottom) then Thick := -Thick;
result := TEllipse.create(ap1.x,ap1.y,aLen-thick,bLen-thick,
angle,width,style,color,brs,brc,LayerHandle,mydsNormal,owner);
end;
function TCircle.Offset(Thick: Double): TFigure;
begin
if vertZero = ord(vzBottom) then Thick := -Thick;
result := TCircle.create(ap1.x,ap1.y,Radius-thick,width,style,color,brs,brc,
LayerHandle,mydsNormal,owner);
end;
function TRectangle.Offset(Thick: Double): TFigure;
var p1,p2,p3,p4,cp: TdoublePoint;
ang: Double;
fig : Tfigure;
begin
if vertZero = ord(vzBottom) then Thick := -Thick;
if (ap4.x = ap3.x) or (ap4.y = ap3.y) then ang := 0
else ang := GetRadOfLine(ap4,ap3);
p1 := RotatePoint(ap4,ap1,-ang);
p2 := RotatePoint(ap4,ap2,-ang);
p3 := RotatePoint(ap4,ap3,-ang);
p4 := ap4;
cp := MPoint(MPoint(p1,p2),MPoint(p3,p4));
p1 := MovePointTo(p1,cp,thick,thick);
p2 := MovePointTo(p2,cp,thick,thick);
p3 := MovePointTo(p3,cp,thick,thick);
p4 := MovePointTo(p4,cp,thick,thick);
p1 := RotatePoint(ap4,p1,ang);
p2 := RotatePoint(ap4,p2,ang);
p3 := RotatePoint(ap4,p3,ang);
p4 := RotatePoint(ap4,p4,ang);
result := TRectangle.create(0,0,0,0,width,style,color,brs,brc,LayerHandle,mydsNormal,owner);
result.ActualPoints[1] := p1;
result.ActualPoints[2] := p2;
result.ActualPoints[3] := p3;
result.ActualPoints[4] := p4;
end;
function TArc.Offset(Thick: Double): TFigure;
begin
if vertZero = ord(vzBottom) then Thick := -Thick;
result := TArc.create(ap1.x,ap1.y,radius-thick,SAngle,FAngle,width,style,color,
brs,brc,ord(arcstyle),LayerHandle,mydsNormal,owner);
end;
function TPolyline.DuplicateAsBezier: TFigure;
begin
result := nil;
end;
{ TDuplicateAsBezier }
class function TDuplicateAsBezier.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
cad.DuplicateSelectionAsBezier(Shadow.ap2.x-Shadow.ap1.x,Shadow.ap2.y-Shadow.ap1.y);
result := nil;
end;
class function TDuplicateAsBezier.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TDuplicateAsBezier.create(DoublePoint(x,y),DoublePoint(x,y));
end;
function TText.DuplicateAsBezier: TFigure;
var
Layer: TLayer;
acolor : TColor;
a,i,k : integer;
TestX,TestY1,TestY2,Z: Double;
TopY : boolean;
lMult: integer;
points: TDoublePointArr;
xlen: Double;
nLen,nH: Integer;
pt: TPoint;
typ: Byte;
PointArr:array of TPoint;
TypeArr: array of Byte;
Dengine: TPCDrawEngine;
pCnt,kCnt: Integer;
fCnt: Integer;
fClosed: Boolean;
pArr: TDoublePointArr;
Segments: TList;
plSegment,dSegment: TPLSegment;
x,y: Double;
dp: TDoublePOint;
bezIndex: Integer;
grp: TFigureGrp;
pl: TPolyline;
begin
result := nil;
if assigned(owner) then begin
Dengine := TPCDrawing(Owner).Dengine;
end else exit;
Segments := TList.Create;
TestX := 0; TestY1:= 100; TestY2 := 200;
Z := 0;
DEngine.ConvertPoint(TestX,TestY1,Z);
DEngine.ConvertPoint(TestX,TestY2,Z);
if TestY2 > TestY1 then topY := true else topY := false;
if TopY then lMult := 1 else lMult := -1;
DEngine.Canvas.Pen.Mode := pmCopy;
BeginPath(DEngine.Canvas.Handle);
if fKeepA then
begin
DEngine.drawtext(ap1,ap2,ap3,ap4,lMult*angle,text,font,height,0,cSpace,nH,nLen);
fKeepA := False;
end
else
DEngine.drawtext(ap1,ap2,ap3,ap4,lMult*angle,text,font,height,CWidth,cSpace,nH,nLen);
TextHeight := nH;
TextLength := nLen;
EndPath(DEngine.Canvas.Handle);
SetLength(PointArr,1000);
SetLength(TypeArr,1000);
pCnt := GetPath(DEngine.Canvas.Handle,PointArr,TypeArr,0);
SetLength(PointArr,pCnt);
SetLength(TypeArr,pCnt);
pCnt := GetPath(DEngine.Canvas.Handle,PointArr[0],TypeArr[0],pcnt);
fCnt := 0;
kCnt := 0;
bezIndex := 0;
grp := TFigureGrp.create(LayerHandle,Owner);
for i:= 0 to pcnt-1 do
begin
pt := PointArr[i];
x := pt.x;
y := pt.y;
z := 0;
Dengine.DeConvertPoint(x,y,z);
dp := DoublePOint(x,y);
typ := TypeArr[i];
Case typ of
PT_LINETO or PT_CLOSEFIGURE:
begin
fClosed := True;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
plSegment := TPlSegment.Create(0,sLine,dp,dp);
Segments.Add(plSegment);
end;
PT_BEZIERTO or PT_CLOSEFIGURE:
begin
fClosed := True;
bezIndex := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
PT_LINETO:
begin
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
plSegment := TPlSegment.Create(0,sLine,dp,dp);
Segments.Add(plSegment);
end;
PT_BEZIERTO:
begin
bezIndex := BezIndex+1;
if bezIndex = 1 then begin
plSegment := TPlSegment.Create(0,sCurve,dp,dp);
Segments.Add(plSegment);
end else if bezIndex = 2 then begin
plSegment.Cpoint2 := dp;
end else if BezIndex = 3 then begin
bezIndex := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
end;
PT_MOVETO: begin
fcnt := fcnt+1;
if fcnt > 1 then begin
pl := TPolyline.create(parr,width,ord(psSolid),color,ord(bsClear),color,
0,fClosed,LayerHandle,mydsNormal,owner);
grp.AddFigure(pl);
for k := 0 to Segments.Count-1 do
begin
plSegment := TPLSegment(Segments[k]);
if plSegment.SType = sCurve then begin
dSegment := TPLSegment(pl.Segments[k]);
dSegment.SType := sCurve;
dSegment.CPoint1 := plSegment.CPoint1;
dSegment.CPoint2 := plSegment.CPoint2;
end;
plSegment.free;
end;
Segments.Clear;
end;
fClosed := false;
kCnt := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
end;
end;
if kcnt > 0 then begin
pl := TPolyline.create(parr,width,ord(psSolid),color,ord(bsClear),color,
0,fClosed,LayerHandle,mydsNormal,owner);
grp.AddFigure(pl);
for k := 0 to Segments.Count-1 do
begin
plSegment := TPLSegment(Segments[k]);
if plSegment.SType = sCurve then begin
dSegment := TPLSegment(pl.Segments[k]);
dSegment.SType := sCurve;
dSegment.CPoint1 := plSegment.CPoint1;
dSegment.CPoint2 := plSegment.CPoint2;
end;
plSegment.free;
end;
Segments.Clear;
end;
Segments.Free;
if assigned(pl) then result := grp else begin
grp.DestroyInFigures;
grp.Destroy;
end;
end;
function TFigure.DuplicateAsBezier: TFigure;
var
Layer: TLayer;
acolor : TColor;
a,i,k : integer;
TestX,TestY1,TestY2,Z: Double;
TopY : boolean;
lMult: integer;
points: TDoublePointArr;
xlen: Double;
nLen,nH: Integer;
pt: TPoint;
typ: Byte;
PointArr:array of TPoint;
TypeArr: array of Byte;
Dengine: TPCDrawEngine;
pCnt,kCnt: Integer;
fCnt: Integer;
fClosed: Boolean;
pArr: TDoublePointArr;
Segments: TList;
plSegment,dSegment: TPLSegment;
x,y: Double;
dp: TDoublePOint;
bezIndex: Integer;
grp: TFigureGrp;
pl: TPolyline;
begin
result := nil;
exit;
if assigned(owner) then begin
Dengine := TPCDrawing(Owner).Dengine;
end else exit;
Segments := TList.Create;
BeginPath(DEngine.Canvas.Handle);
Draw(Dengine,false);
EndPath(DEngine.Canvas.Handle);
//WidenPath(DEngine.Canvas.Handle);
SetLength(PointArr,1000);
SetLength(TypeArr,1000);
pCnt := GetPath(DEngine.Canvas.Handle,PointArr,TypeArr,0);
SetLength(PointArr,pCnt);
SetLength(TypeArr,pCnt);
pCnt := GetPath(DEngine.Canvas.Handle,PointArr[0],TypeArr[0],pcnt);
fCnt := 0;
kCnt := 0;
bezIndex := 0;
grp := TFigureGrp.create(LayerHandle,Owner);
for i:= 0 to pcnt-1 do
begin
pt := PointArr[i];
x := pt.x;
y := pt.y;
z := 0;
Dengine.DeConvertPoint(x,y,z);
dp := DoublePOint(x,y);
typ := TypeArr[i];
Case typ of
PT_LINETO or PT_CLOSEFIGURE:
begin
fClosed := True;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
plSegment := TPlSegment.Create(0,sLine,dp,dp);
Segments.Add(plSegment);
end;
PT_BEZIERTO or PT_CLOSEFIGURE:
begin
fClosed := True;
bezIndex := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
PT_LINETO:
begin
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
plSegment := TPlSegment.Create(0,sLine,dp,dp);
Segments.Add(plSegment);
end;
PT_BEZIERTO:
begin
bezIndex := BezIndex+1;
if bezIndex = 1 then begin
plSegment := TPlSegment.Create(0,sCurve,dp,dp);
Segments.Add(plSegment);
end else if bezIndex = 2 then begin
plSegment.Cpoint2 := dp;
end else if BezIndex = 3 then begin
bezIndex := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
end;
PT_MOVETO: begin
fcnt := fcnt+1;
if fcnt > 1 then begin
pl := TPolyline.create(parr,width,ord(psSolid),color,ord(bsClear),color,
0,fClosed,LayerHandle,mydsNormal,owner);
grp.AddFigure(pl);
try
for k := 0 to Segments.Count-1 do
begin
plSegment := TPLSegment(Segments[k]);
if plSegment.SType = sCurve then begin
dSegment := TPLSegment(pl.Segments[k]);
dSegment.SType := sCurve;
dSegment.CPoint1 := plSegment.CPoint1;
dSegment.CPoint2 := plSegment.CPoint2;
end;
plSegment.free;
end;
Segments.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.DuplicateAsBezier' + E.Message);
end;
end;
fClosed := false;
kCnt := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
end;
end;
if kcnt > 0 then begin
pl := TPolyline.create(parr,width,ord(psSolid),color,ord(bsClear),color,
0,fClosed,LayerHandle,mydsNormal,owner);
grp.AddFigure(pl);
try
for k := 0 to Segments.Count-1 do
begin
plSegment := TPLSegment(Segments[k]);
if plSegment.SType = sCurve then begin
dSegment := TPLSegment(pl.Segments[k]);
dSegment.SType := sCurve;
dSegment.CPoint1 := plSegment.CPoint1;
dSegment.CPoint2 := plSegment.CPoint2;
end;
plSegment.free;
end;
Segments.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.DuplicateAsBezier' + E.Message);
end;
end;
Segments.Free;
if assigned(pl) then
result := grp
else
begin
grp.DestroyInFigures;
grp.Destroy;
end;
end;
{ THellical }
function THellical.BreakByPoint(p: TdoublePoint;
var Figures: TList): boolean;
begin
end;
constructor THellical.create(aX1, aY1, aX2, aY2: Double; w, s, c, row,
LHandle: Integer; aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
inherited create(LHandle,aDrawStyle,aOwner);
initialize;
RowStyle := row;
originalpoints[1] := DoublePoint(ax1,ay1);
originalpoints[2] := DoublePoint(ax2,ay2);
actualpoints[1] := DoublePoint(ax1,ay1);
actualpoints[2] := DoublePoint(ax2,ay2);
width := w;
color := c;
style := s;
end;
class function THellical.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
Result := THEllical.create( Shadow.ActualPoints[1].x,
Shadow.ActualPoints[1].y,
Shadow.ActualPoints[2].x,
Shadow.ActualPoints[2].y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultRowStyle),
LHandle,mydsNormal,cad);
end;
procedure THellical.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor : Tcolor;
rad,l: Double;
cp1,cp2,p1,p2 : TDoublePoint;
i: Integer;
rgn: HRGN;
begin
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
if DrawStyle = dsTrace then DEngine.Canvas.pen.mode := pmXor
else DEngine.canvas.pen.mode := pmCopy;
l := GetLineLenght(ap1,ap2);
cp1 := DoublePoint(ap1.x+(l/2),ap1.y);
cp2 := ap1;
rgn := 1;
for i := 1 to step do
begin
rad := (l+((i-1)*2)*l)/2;
Dengine.drawbezarc(cp1.x,cp1.y,rad,pi,2*pi,color,width,style,0,ord(bsClear),0,rgn,p1,p2,false,0);
end;
for i := 1 to step-1 do
begin
rad := (i*2*l)/2;
Dengine.drawbezarc(cp2.x,cp2.y,rad,0,pi,color,width,style,0,ord(bsClear),0,rgn,p1,p2,false,0);
end;
end;
procedure THellical.DrawFigureGuides(DEngine: TPCDrawEngine);
begin
inherited;
end;
function THellical.duplicate: TFigure;
begin
end;
function THellical.DuplicateAsBezier: TFigure;
begin
end;
function THellical.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
var ap: TDoublepoint;
begin
ap := actualpoints[mp.SeqNbr];
ActualPoints[mp.SeqNbr] := DoublePoint(ActualPoints[mp.SeqNbr].x + (x-ap.x),
ActualPoints[mp.SeqNbr].y + (y-ap.y));
ResetRegion;
Modified := True;
end;
procedure THellical.getbounds(var figMaxX, figMaxY, figMinX,
figMinY: double);
begin
inherited;
end;
function THellical.GetClassName: String;
begin
result := 'Hellical';
end;
function THellical.GetLinearInterSections(p1, p2: TDoublePoint;
var pArr: TDoublePointArr): Boolean;
begin
end;
procedure THellical.getModPoints(ModList: TMyList);
begin
inherited;
end;
procedure THellical.Initialize;
begin
inherited;
pointcount := 2;
Step := 4;
end;
function THellical.isPointIn(x, y: double): boolean;
begin
end;
procedure THellical.Move(deltax, deltay: Double);
begin
inherited;
end;
function THellical.Offset(Thick: Double): TFigure;
begin
end;
procedure THellical.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
inherited;
end;
function THellical.ShadowClick(ClickIndex: Integer; x, y: Double): Boolean;
begin
result := false;
if clickIndex = 2 then begin
ActualPoints[2] := DoublePoint(x,y);
Result := True;
end;
end;
function THellical.ShadowTrace(ClickIndex: Integer; x, y: Double): Boolean;
begin
if clickIndex = 1 then begin
ActualPoints[2] := DoublePoint(x,y);
Result := True;
end;
end;
class function THellical.ShadowType: TShadowType;
begin
Result := stLine;
end;
function THellical.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
begin
TraceFigure.ActualPoints[MP.SeqNbr] := DoublePoint(x,y);
end;
procedure THellical.WriteToStream(Stream: TStream);
begin
inherited;
end;
procedure TFigure.SelectPoint(ModPOint:TModPoint);
begin
end;
procedure TPolyline.SelectPoint(ModPoint: TModpoint);
begin
if ModPoint.PType = ptPolyPoint then begin
ModPoint.Color := clRed;
SelectedPoint:= ModPOint.SeqNbr;
end;
end;
function TFigure.SnapPoints(var x, y: Double;DotsPerMil:Double): Boolean;
var dx,dy: Double;
a: Integer;
xMod: TModPOint;
begin
result := false;
for a := 1 to PointCount do
begin
dx := abs(FigurePoints[a].x-x);
dy := abs(FigurePoints[a].y-y);
dx := dx*DotsPerMil;
dy := dy*dotsPerMil;
if (dx <= 12) and (dy <= 12) and not result then
begin
x := FigurePoints[a].x;
y := FigurePoints[a].y;
result := true;
end;
end;
if Selected and not result then
begin
SelPoints.Pack; // Tolik 24/12/2019 --
for a := 1 to SelPoints.Count - 1 do
begin
xMod := TModPoint(SelPoints[a]);
dx := abs(xMod.CoordX-x);
dy := abs(xMod.CoordY-y);
dx := dx*DotsPerMil;
dy := dy*dotsPerMil;
if (dx <= 12) and (dy <= 12) and not result then
begin
x := xMod.CoordX;
y := xMod.CoordY;
result := true;
end;
end;
end;
end;
function TLine.GetClassName: String;
begin
result := 'Line';
end;
function TVertex.GetClassName: String;
begin
result := 'Vertex';
end;
function TPolyline.GetClassName: String;
begin
result := 'Polyline';
end;
function TEllipse.GetClassName: String;
begin
result := 'Ellipse';
end;
function TCircle.GetClassName: String;
begin
result := 'Circle';
end;
function TArc.GetClassName: String;
begin
result := 'Arc';
end;
function TRectangle.GetClassName: String;
begin
result := 'Rectangle';
end;
function TBMPObject.GetClassName: String;
begin
result := 'BMPObject';
end;
function TText.GetClassName: String;
begin
result:= 'Text';
end;
function TFigure.isVisible: Boolean;
begin
result := true;
if LayerHandle > 0 then result := (TLayer(LayerHandle).visible <> lost);
end;
Procedure TFigure.ShowProperties;
begin
end;
procedure TFigure.PropUpdate(PropName, PropVal: String);
begin
end;
procedure TFigure.DrawDetail(DEngine: TPCDrawEngine;DetailStyle:TDetailStyle);
begin
Draw(Dengine,False);
end;
function TFigure.GetZAvg(dRect: TDoubleRect; var fAvg: Double): Boolean;
var fRect:TDoubleRect;
begin
result := false;
fRect := GetBoundRect;
if RectOverlaps(dRect,fRect) then begin
fAvg :=0;
result := True;
end;
end;
function TModPoint.IsPointInDetInt(x, y, pdim: Integer): Boolean;
begin
result := false;
If ((x <= PixDetX+pdim) and (x >= PixDetX-pdim)) and
((y <= PixDetY+pdim) and (y >= PixDetY-pdim)) then
begin
result := true;
end;
end;
function TModPoint.IsPointInInt(x, y, pdim: Integer): Boolean;
begin
result := false;
if onlyiso then exit;
If ((x <= PixX+pdim) and (x >= PixX-pdim)) and
((y <= PixY+pdim) and (y >= PixY-pdim)) then
begin
result := true;
end;
end;
function TFigure.IsPointInInt(x, y: Integer): Boolean;
begin
result := false;
end;
procedure TFigure.GetIsometricBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
end;
procedure TFigure.DeSelectPoint(Modpoint: TModPOint);
begin
end;
procedure TPolyline.DeSelectPoint(ModPoint: TModpoint);
begin
if ModPoint.PType = ptPolyPoint then ModPoint.Color := clBlue;
end;
class function TPolyline.InsideSelection: Boolean;
begin
result := true;
end;
function TCircle.Edit: Boolean;
var
r: Double;
ValS: String;
begin
result := false;
// Val := FloatToStr(Self.Radius);
// Val := InputBox(capCircleRadius,mesEnterAsMM,Val);
r := Radius * GCadForm.PCad.MapScale / 1000;
r := MetreToUOM(r);
ValS := FormatFloat(ffMask, r);
ValS := InputBox(cDrawObjects_Mes1, cDrawObjects_Mes2, ValS);
try
r := StrToFloat_My(ValS);
except
ShowMessage(cDrawObjects_Mes3);
Exit;
end;
if r < 0 then
r := 0;
r := r * 1000 / GCadForm.PCad.MapScale;
r := UOMToMetre(r);
Self.Radius := r;
result := true; // set this true so Powercad will make a refresh.
end;
procedure TFigure.UpdateBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
var xmin,xmax,ymin,ymax: Double;
begin
GetBounds(xmax,ymax,xmin,ymin);
figMaxX := Max(figMaxX,xMax);
figMaxY := Max(figMaxY,ymax);
figMinX := Min(figMinX,xmin);
figMinY := Min(figMinY,ymin);
end;
class function TPolyline.createP4(p1, p2, p3, p4: TDoublePoint; w, s, c,
abrs, abrc, row: integer; aClosed: Boolean; LHandle: Integer;
aDrawStyle: TDrawStyle; aOwner: TComponent): TPolyline;
var p: TDoublePOintArr;
begin
setLength(p,4); p[0] := p1; p[1] := p2; p[2] := p3; p[3] := p4;
result := create(p,w, s, c,abrs, abrc, row,aClosed,LHandle,aDrawStyle,aOwner);
end;
procedure TFigure.DrawFigureGuidesInDetail(DEngine: TPCDrawEngine;DetailStyle:TDetailStyle);
begin
DrawFigureGuides(DEngine);
end;
procedure TPolyline.InsertKnot(SegNbr: Integer; MP: TDoublePoint);
var Seg : TPLSegment;
NewSeg: TPLSegment;
i: Integer;
begin
if SegNbr = 0 then exit;
Seg := Segments[SegNbr-1];
if assigned(seg) then begin
PointCount := PointCount+1;
ActualPoints[PointCount] := ActualPoints[PointCount-1];
OriginalPoints[PointCount] := OriginalPoints[PointCount-1];
for i := PointCount downto SegNbr + 1 do
begin
ActualPoints[i] := ActualPoints[i-1];
OriginalPoints[i] := OriginalPoints[i-1];
end;
ActualPoints[SegNbr+1] := MP;
OriginalPoints[Segnbr+1] := MP;
SegMents.Move(PointCount-1,SegNbr);
Seg := Segments[SegNbr-1];
ArrangeSegment(SegNbr, Seg.SType);
ArrangeSegment(SegNbr+1, Seg.SType);
NeedBounds := True; //Tolik 02/08/2021 --
end;
end;
procedure TPolyline.DivideSegment(SegNbr, Cnt: Integer);
var p1,p2,mp: TDoublePoint;
len,d: Double;
i:INteger;
begin
if SegNbr = PointCount then begin
p1 := ActualPoints[SegNbr];
p2 := ActualPoints[1];
end else begin
p1 := ActualPoints[SegNbr];
p2 := ActualPoints[SegNbr+1];
end;
len := GetLineLenght(p1,p2);
d := len / Cnt;
for i := 1 to Cnt-1 do
begin
mp := MPoint(p2,p1,i*d);
InsertKnot(SegNbr,mp);
end;
NeedBounds := True; //Tolik 02/08/2021 --
end;
procedure TFigure.DrawSelPoint(DEngine: TPCDrawEngine; isGrayed: Boolean;
mp: TModPoint);
var acolor:TColor;
begin
if not mp.isDraw then exit;
if isGrayed then acolor := clGray else acolor := mp.Color;
DEngine.drawselectionpoint(mp.CoordX,mp.CoordY,mp.CoordZ,mp.DType,mp.Dim,acolor);
end;
{ TCircleVertex }
class function TCircleVertex.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
result := TCircleVertex.create(shadow.ap1.x,shadow.ap1.y,LHandle,mydsNormal,aOwner);
end;
function TCircleVertex.CreateModification: TFigure;
begin
Result := TCircleVertex.create(ap1.x,ap1.y,0,dsTrace,nil);
DragDeltaX := DragStartX-ap1.x;
DragDeltaY := DragStartY-ap1.y;
Result.ActualPoints[1] := DoublePoint(DragStartX,DragStartY);
Result.Color := clLime;
end;
procedure TCircleVertex.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor,bcolor : Tcolor;
begin
acolor := color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.canvas.pen.mode := pmXor
else
DEngine.canvas.pen.mode := pmCopy;
DEngine.drawcircle(ap1.x,ap1.y,radius,acolor,width,style,0,ord(bsClear),RegHandle,InCombined);
Dengine.drawline(ap1.x-1,ap1.y,ap1.x-radius-1,ap1.y,aColor,1,ord(psSOlid),0);
Dengine.drawline(ap1.x+1,ap1.y,ap1.x+radius+1,ap1.y,aColor,1,ord(psSOlid),0);
Dengine.drawline(ap1.x,ap1.y-1,ap1.x,ap1.y-radius-1,aColor,1,ord(psSOlid),0);
Dengine.drawline(ap1.x,ap1.y+1,ap1.x,ap1.y+radius+1,aColor,1,ord(psSOlid),0);
end;
function TCircleVertex.duplicate: TFigure;
begin
result := TCircleVertex.create(originalpoints[1].x,
originalpoints[1].y, LayerHandle, DrawStyle,Owner);
result.actualpoints[1] := actualpoints[1];
result.AngleToPoint := AngleToPoint;
result.Radius := Radius;
end;
procedure TCircleVertex.getbounds(var figMaxX, figMaxY, figMinX,
figMinY: double);
begin
figMaxX := ap1.x + radius +1;
figMaxY := ap1.y + radius +1;
figMinX := ap1.x - radius -1;
figMinY := ap1.y - radius -1;
end;
function TCircleVertex.GetClassName: String;
begin
result := 'CircleVertex';
end;
procedure TCircleVertex.getModPoints(ModList: TMyList);
var cControl:TPCDrawing;
begin
CControl := TPCDrawing(Owner);
ModList.Add(CControl.RegisterModPoint(self,ptUndefined,ptRect,clBlue,
pointDim,ap1.x,ap1.y,0));
end;
procedure TCircleVertex.Initialize;
begin
inherited;
Radius := 4;
FullHitTest := True;
Color := clred;
end;
function TCircleVertex.isPointIn(x, y: double): boolean;
begin
result := false;
result := inherited isPointIn(x,y);
end;
function TVertex.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
begin
ActualPoints[1] := DoublePoint(x,y);
end;
function TVertex.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
begin
TraceFigure.ActualPoints[1] := DoublePoint(x,y);
end;
function TLine.SnapPoints(var x, y: Double; DotsPerMil: Double): Boolean;
var pd:TDoublePoint;
onLine: Boolean;
d:double;
begin
result := inherited SnapPoints(x,y,DotsPerMil);
if not result then begin
pd := DoublePoint(x,y);
PointToLine(ap1,ap2,pd.x,pd.y);
onLine := isPointInLine(ap1,ap2,pd,1,0.1);
d := GetLineLenght(pd,DoublePoint(x,y));
if (d*dotsPermil < 18) and onLine then begin
x := pd.x;
y := pd.y;
result := true;
end;
end;
end;
procedure TFigure.CreateDimLines;
begin
ClearDimLines;
end;
procedure TFigure.ClearDimLines;
var
i:Integer;
begin
try
for i := 0 to DimLines.Count-1 do
begin
TFigure(DimLines[i]).Free;
end;
Dimlines.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.ClearDimLines' + E.Message);
end;
end;
procedure TRectangle.CreateDimLines;
var dim1,dim2,dim3,dim4:TADimLine;
begin
inherited;
if DimTop then begin
Dim1 := CreateAlignedDimLine(ap1,ap2,ap4,ap3,Owner);
DimLines.Add(dim1);
end;
if DimBottom then begin
Dim2 := CreateAlignedDimLine(ap3,ap4,ap1,ap2,Owner);
DimLines.Add(dim2);
end;
if DimLeft then begin
Dim3 := CreateAlignedDimLine(ap1,ap4,ap2,ap3,Owner);
DimLines.Add(dim3);
end;
if DimRight then begin
Dim4 := CreateAlignedDimLine(ap3,ap2,ap1,ap4,Owner);
DimLines.Add(dim4);
end;
end;
procedure TFigure.DrawDimLines(DEngine: TPCDrawEngine; isGrayed: Boolean);
var i: Integer;
begin
for i := 0 to DimLines.Count-1 do
Tfigure(Dimlines[i]).Draw(Dengine,isGrayed);
end;
Function CreateAlignedDimLine(p1,p2,offp1,offp2:TDoublePoint;Owner:TComponent):TADimLine;
var mp1,mp2:TDoublePoint;
begin
result := TADimLine.Create(0,mydsNormal,Owner);
result.ActualPoints[1] := p1;
result.ActualPoints[2] := p2;
mp1 := MPoint(p1,p2);
mp2 := MPoint(offp1,offp2);
result.ActualPoints[3] := MPoint(mp1,mp2,-6.0);
end;
Function CreateVerticalDimLine(p1,p2,offp1,offp2:TDoublePoint;Owner:TComponent):TVDimLine;
var mp1,mp2:TDoublePoint;
begin
result := TVDimLine.Create(0,mydsNormal,Owner);
result.ActualPoints[1] := p1;
result.ActualPoints[2] := p2;
mp1 := MPoint(p1,p2);
mp2 := MPoint(offp1,offp2);
result.ActualPoints[3] := MPoint(mp1,mp2,-6.0);
end;
procedure TLine.CreateDimLines;
var dim1: TADimLine;
p1,p2:TDoublePoint;
begin
inherited;
GetParallelPoints(ap1,ap2,p1,p2,5);
Dim1 := CreateAlignedDimLine(ap1,ap2,p1,p2,Owner);
Dimlines.Add(dim1);
end;
procedure TPolyline.CreateDimLines;
var i: Integer;
seg:TPLSegment;
p1,p2,op1,op2:TDoublePoint;
begin
ClearDimlines;
for i := 0 to Segments.Count-1 do
begin
seg := TPlSegment(Segments[i]);
if seg.ShowDim then begin
p1 := ActualPoints[i+1];
if i+2 > PointCount then
p2 := ActualPoints[1]
else
p2 := ActualPoints[i+2];
GetParallelPoints(p1,p2,op1,op2,5);
DimLines.Add(CreateAlignedDimLine(p1,p2,op1,op2,Owner));
end;
end;
end;
procedure TPolyline.ClearDimLines;
var i:Integer;
begin
inherited;
end;
function TPolyline.GetSegmentDimension(SegNbr: Integer): Boolean;
begin
result := TPlSegment(Segments[SegNbr]).ShowDim;
end;
procedure TPolyline.SetSegmentDimension(SegNbr: Integer; Vis: Boolean);
begin
TPlSegment(Segments[SegNbr]).ShowDim := vis;
CreateDimLines;
end;
procedure TPolyline.ToggleSegmentDimension(SegNbr: Integer);
begin
TPlSegment(Segments[SegNbr]).ShowDim :=
not TPlSegment(Segments[SegNbr]).ShowDim;
CreateDimLines;
end;
procedure TCircle.CreateDimLines;
var dim1: TCDimline;
begin
inherited;
Dim1 := TCDimLine.Create(LayerHandle,mydsNormal,Owner);
Dim1.ActualPoints[1] := MHPoint(ap1,-radius);
Dim1.ActualPoints[2] := MHPoint(ap1,+radius);
Dim1.Rotate(-pi/4,ap1);
Dim1.HorzText := False;
Dimlines.Add(Dim1);
end;
procedure TArc.CreateDimLines;
var dim1:TArcDimLine;
begin
inherited;
dim1 := TArcDimline.create(ap1.x,ap1.y,radius+6,SAngle,FAngle,0,mydsNormal,owner);
dim1.GuideLen := 5.5;
Dimlines.Add(Dim1);
end;
class function TText.CreateCentered(aX1, aY1, h, w: double; atext,
FontName: String; FontCharset: Byte; aColor, LHandle: Integer;
aDrawStyle: TDrawStyle; aOwner: TComponent): TText;
var
p1 : TDoublePoint;
TM : TTextMetric;
FCanvas: TCanvas;
FontRecord : TLogFont;
xHeight,xWidth: Double;
vl,hl:DOuble;
xlen: Double;
r: real;
mCanvas: TMetafileCanvas;
ww,hh: Double;
fc:TFigureClass;
begin
fc := TText;
result := TText(fc.Create(LHandle,aDrawStyle,aOwner));
result.initialize;
result.Color := aColor;
result.Text := aText;
result.Font.Charset := FontCharset;
result.Font.Name := FontName;
result.Font.Color := aColor;
result.Height := h;
result.CWidth := w;
result.Modified := true;
result.originalpoints[1] := DoublePoint(ax1,ay1);
result.actualpoints[1]:= DoublePoint(ax1,ay1);
if result.owner <> nil then
begin
TPCDrawing(Result.Owner).DEngine.GetTextLens(Result.TextLength,Result.TextHeight,
Result.Text,Result.Font,Result.Height,Result.CWidth,Result.CSpace);
(*
Fcanvas := TPCDrawing(result.Owner).DEngine.canvas;
xHeight := result.Height*4;
FCanvas.Font.Height := Round(xHeight);
if result.CWidth <> 0 then begin
xWidth := result.CWidth*4;
GetObject(FCanvas.Font.Handle,sizeof(FontRecord),Addr(FontRecord));
FontRecord.lfWidth := Round(xWidth);
FCanvas.Font.handle := CreateFontIndirect(FontRecord);
end;
result.TextLength := Fcanvas.TextWidth(result.text);
result.TextHeight := Fcanvas.TextHeight(result.text);
result.TextLength := (result.TextLength/4);
result.TextHeight := (result.TextHeight/4);
*)
if result.HorzZero = 1 then hl := -1 else hl := 1;
if result.VertZero = 1 then vl := -1 else vl := 1;
end;
result.originalpoints[1] := DoublePoint(ax1-hl*result.TextLength/2,ay1+vl*result.TextHeight/2);
result.actualpoints[1]:= result.originalpoints[1];
result.originalpoints[2] := Doublepoint( result.originalpoints[1].x + hl*result.TextLength, result.originalpoints[1].y);
result.actualpoints[2] := Doublepoint( result.originalpoints[1].x + hl*result.TextLength, result.originalpoints[1].y);
result.originalpoints[3] := Doublepoint( result.originalpoints[1].x + hl*result.TextLength , result.originalpoints[1].y - vl*result.TextHeight);
result.actualpoints[3] := Doublepoint( result.originalpoints[1].x + hl*result.TextLength , result.originalpoints[1].y - vl*result.TextHeight);
result.originalpoints[4] := Doublepoint( result.originalpoints[1].x , result.originalpoints[1].y - vl*result.TextHeight);
result.actualpoints[4] := Doublepoint( result.originalpoints[1].x , result.originalpoints[1].y - vl*result.TextHeight);
//result.SetRegionPoints;
end;
procedure TFigure.Rotate(aAngle: Double);
begin
Rotate(aAngle,CenterPoint);
end;
procedure TPolyline.CollectPolyLinePoints(var pdPoints: TDoublePointArr);
var i: Integer;
begin
SetLength(pdPoints,PointCount);
for i := 1 to PointCount do pdPoints[i-1] := ActualPoints[i];
end;
procedure TFigure.GetSelBounds(var figMaxX, figMaxY, figMinX,
figMinY: Double);
var i: Integer;
begin
GetBounds(figMaxX,figMaxY,figMinX,figMinY);
if Dimlines.Count > 0 then begin
for i := 0 to Dimlines.Count-1 do begin
TFigure(Dimlines[i]).UpdateBounds(figMaxX, figMaxY, figMinX,figMinY);
end;
end;
end;
procedure TFigure.CreateDimLinesFromStream(xStream: TStream;
LHandle: Integer; Owner: TComponent);
var fSize,i,dcnt: Integer;
fStream: TMemoryStream;
xFig:Tfigure;
begin
ClearDimlines;
xStream.Read(dcnt,4);
for i := 1 to dcnt do begin
xStream.Read(fSize,4);
fStream := TMemoryStream.Create;
StreamToStream(xStream,fStream,fSize);
fStream.Position := 0;
xFig := Tfigure.CreateFromStream(fStream,LHandle,mydsNormal,Owner);
if assigned(xFig) then DimLines.Add(xFig);
fStream.Free;
end;
end;
(*
function TRectangle.Edit: Boolean;
var dial: TfrmRectangle;
p1,p2: TdoublePoint;
w,h: Double;
begin
Result := False;
dial := TfrmRectangle.Create(nil);
p1 := ap1;
p2 := ap3;
if dial.SetValues(p1,p2) then begin
w := abs(p1.x-p2.x);
h := abs(p1.y-p2.y);
actualpoints[1] := p1;
actualpoints[2] := DoublePoint(p1.x+w,p1.y);
actualpoints[3] := p2;
actualpoints[4] := DoublePoint(p1.x,p1.y+h);
Modified := True;
Result := True;
end;
end;
*)
{ TTextPanel }
constructor TTextPanel.create(xp1, xp2: TDoublePoint; LHandle: Integer;
aDrawStyle: TDrawStyle; aOwner: TComponent);
begin
inherited Create(xp1.x,xp1.y,xp2.x,xp2.y,1,ord(psClear),
clBlack,ord(bsClear),clWhite,LHandle,mydsNormal,aOwner);
//initialize; // Tolik 29/07/2021 --
end;
class function TTextPanel.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
result := TTextPanel.create(Shadow.ap1,shadow.ap3,LHandle,mydsNormal,aOwner);
end;
destructor TTextPanel.Destroy;
begin
Font.Free;
inherited;
end;
procedure TTextPanel.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var nh,nl: Integer;
oFont:TFont;
VAlign: TTextVAlign;
HAlign: TTextHAlign;
begin
brs := ord(bsClear);
style := ord(psClear);
if RegHandle = 0 then begin
RegHandle := DEngine.PolygonRegion(ap1,ap2,ap3,ap4);
end;
Case Alignment of
taTopLeft : VAlign := vtTop;
taTopCenter : VAlign := vtTop;
taTopRight : VAlign := vtTop;
taMiddleLeft : VAlign := vtCenter;
taMiddleCenter : VAlign := vtCenter;
taMiddleRight : VAlign := vtCenter;
taBottomLeft : VAlign := vtBottom;
taBottomCenter : VAlign := vtBottom;
taBottomRight : VAlign := vtBottom;
end;
Case Alignment of
taTopLeft : HAlign := htLeft;
taTopCenter : HAlign := htCenter;
taTopRight : HAlign := htRight;
taMiddleLeft : HAlign := htLeft;
taMiddleCenter : HAlign := htCenter;
taMiddleRight : HAlign := htRight;
taBottomLeft : HAlign := htLeft;
taBottomCenter : HAlign := htCenter;
taBottomRight : HAlign := htRight;
end;
oFont := DEngine.SetCanvasFont(Font.Name,Height,0,CSpace,0,Font.Style,Font.Charset,Font.Color);
Dengine.GDIDrawText(ap1,ap2,ap3,ap4,Text,VAlign,HAlign);
Dengine.ResetCanvasFont(oFont);
end;
procedure TTextPanel.DrawFigureGuides(DEngine: TPCDrawEngine);
begin
inherited;
end;
function TTextPanel.duplicate: TFigure;
begin
result := TTextPanel.create(ap1,ap3,LAyerHandle,mydsNormal,Owner);
TTextPanel(result).Text := Text;
TTextPanel(result).Alignment := Alignment;
TTextPanel(result).Height := Height;
TTextPanel(result).CSpace := CSpace;
TTextPanel(result).Font.Assign(Font);
end;
function TTextPanel.Edit: Boolean;
var
xText: String;
begin
xText := Text;
// result := InputMemo(capTextPanel,prmTextPanel,xText);
Result := InputMemo(cDrawObjects_Mes11, cDrawObjects_Mes12, xText);
if result then
begin
Text := xText;
end;
end;
function TTextPanel.GetClassName: String;
begin
result := 'TTextPanel';
end;
procedure TTextPanel.Initialize;
begin
inherited;
Text := 'TextPanel'+inttostr(Handle);
if textPanelDefault <> '' then Text := textPanelDefault;
Font := TFont.Create;
Font.Style := [];
if assigned(owner) then begin
Font.Name := TPCDrawing(owner).Font.Name;
Height := TPCDrawing(owner).DefaultTextHeight;
Alignment:= taMiddleCenter;
Font.Charset := TPCDrawing(owner).Font.Charset;
CSpace := 0;
Font.Style := TPCDrawing(owner).Font.Style;
Font.Color := TPCDrawing(owner).Font.Color;
end;
end;
function TTextPanel.isPointIn(x, y: Double): boolean;
begin
result := isPointInRegion(x,y);
//Tolik
Result := IsPointInRegionByRegObj(x,y);
//
end;
procedure TTextPanel.MenuClicked(CommandId: integer);
var idx: Integer;
begin
idx := commandID-menuIndex;
case idx of
1..9: Alignment := TTextAlign(idx-1);
10: Height := 8;
11: Height := 4;
12: Height := 2;
end;
end;
function TTextPanel.ModifyTextAndFont(mm: TModifyMode; valueI: Double;
valueS: string; valueSt: TFontStyles; ValueB: Boolean): Boolean;
begin
result := true;
if mm = mmText then
begin
Text := valueS;
modified := true;
end
else if mm = mmFontName then
begin
Font.Name := valueS;
modified := true;
end
else if mm = mmFontCs then
begin
Font.Charset := Round(valueI);
modified := true;
end
else if mm = mmFontSize then
begin
Height := valueI;
modified := true;
end
else if mm = mmFontColor then
begin
Font.Color := Round(valueI);
Color := Round(valueI);
end
else if mm = mmFontStyle then
begin
Font.Style := valueSt;
modified := true;
end
else if mm = mmFontBold then
begin
if ValueB then Font.Style := Font.Style + [fsBold] else
Font.Style := Font.Style - [fsBold];
modified := true;
end
else if mm = mmFontItalic then
begin
if ValueB then Font.Style := Font.Style + [fsItalic] else
Font.Style := Font.Style - [fsItalic];
modified := true;
end
else if mm = mmFontUnderline then
begin
if ValueB then Font.Style := Font.Style + [fsUnderline] else
Font.Style := Font.Style - [fsUnderline];
modified := true;
end
else if mm = mmFontStrike then
begin
if ValueB then Font.Style := Font.Style + [fsStrikeOut] else
Font.Style := Font.Style - [fsStrikeOut];
modified := true;
end;
end;
procedure TTextPanel.scale(percentx, percenty: Double;
rPoint: TDoublepoint);
begin
inherited;
end;
procedure TTextPanel.SetField(FName, FValue: String);
begin
if Pos(FName,Text)>0 then Text := StringReplace(Text,fname,fvalue,[rfIgnoreCase]);
end;
procedure TTextPanel.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
inherited;
Case xcode of
21: Color := pInt(data)^;
100: font.Style := font.Style + [fsBold];
101: font.Style := font.Style + [fsItalic];
102: font.Style := font.Style + [fsStrikeout];
103: font.Style := font.Style + [fsUnderLine];
104: Alignment := TTextAlign(pByte(data)^);
//Tolik 26/03/2019 --
// 180: Text := string(pAnsiChar(data));
// 181: font.name := string(pAnsiChar(data));
180: Text := string(pchar(data));
181: font.name := string(pchar(data));
//
221: Height := pDouble(data)^;
222: CSpace := pDouble(data)^;
end;
end;
class function TTextPanel.ShadowType: TShadowType;
begin
result := stRectangle;
end;
const taStr: array [0..8] of String = (fmtaTopLeft,fmtaTopCenter,fmtaTopRight,
fmtaMiddleLeft,fmtaMiddleCenter,fmtaMiddleRight,fmtaBottomLeft,
fmtaBottomCenter,fmtaBottomRight);
procedure TTextPanel.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var mnItem,mnSub: TMenuItem;
i:Integer;
begin
menuIndex:= sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex;
mnItem.Caption := fmTextAlignment;
PopMenu.Items.Add(mnItem);
for i := 0 to 8 do begin
mnSub := TMenuItem.Create(PopMenu);
mnSub.Tag := sIndex+1+i;
mnSub.Caption := taStr[i];
mnItem.Add(mnSub);
if ord(alignment) = i then mnSub.Checked := True;
end;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := 0;
mnItem.Caption := '-';
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+10;
mnItem.Caption := fmTextBig;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+11;
mnItem.Caption := fmTextMedium;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Tag := sIndex+12;
mnItem.Caption := fmTextSmall;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+13;
end;
procedure TTextPanel.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited;
xStr := Text;WriteStrField(180,Stream,xStr);
xStr := Font.Name;WriteStrField(181,Stream,xStr);
xInt := Color; WriteField(21,Stream,xInt,4);
xDbl := Height; WriteField(221,Stream,xDbl,8);
xDbl := CSpace; WriteField(222,Stream,xDbl,8);
xByte := 1;
if fsBold in Font.Style then WriteField(100,Stream,xByte,1);
if fsItalic in Font.Style then WriteField(101,Stream,xByte,1);
if fsStrikeout in Font.Style then WriteField(102,Stream,xByte,1);
if fsUnderLine in Font.Style then WriteField(103,Stream,xByte,1);
xByte := ord(Alignment);WriteField(104,Stream,xByte,1);
end;
procedure TText.SetField(FName, FValue: String);
begin
if Pos(FName,Text)>0 then Text := StringReplace(Text,fname,fvalue,[rfIgnoreCase]);
end;
procedure TBMPObject.CreateMWPath(x, y, Tol: Double;
var DPoints: TDoublePointArr;var closed:Boolean);
var Dengine:TPCDrawEngine;
p1,p2,p3,p4,p,tp: TDoublePoint;
z: DOuble;
px,py: Integer;
dx,dy: Double;
bit: TBitmap;
mask,maskx:tbool2darray;
points: TPointArray;
i,j: Integer;
vert:Tvertex;
begin
DEngine := TPowercad(Owner).Dengine;
z := 0;
p1 := ap1;
p2 := ap2;
p3 := ap3;
p4 := ap4;
DEngine.ConvertCoord(p1.x,p1.y,z);
DEngine.ConvertCoord(p2.x,p2.y,z);
DEngine.ConvertCoord(p3.x,p3.y,z);
DEngine.ConvertCoord(p4.x,p4.y,z);
DEngine.ConvertCoord(x,y,z);
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;
px := round(x)-round(p1.x);
py := round(y)-round(p1.y);
bit:=tbitmap.create;
bit.Width := Round(p2.x)-round(p1.x);
bit.Height := Round(p3.y)-round(p1.y);
bit.Canvas.StretchDraw(Rect(0,0,bit.Width,bit.Height),picture);
bit.pixelformat:=pf24bit;
Setlength(mask,bit.width+5,bit.height+5);
MagicWand(bit,px,py,bit.canvas.pixels[px,py],tol,mask);
bit.Free;
MakePath(mask,points,Closed);
SetLength(DPoints,Length(Points));
for i := 0 to Length(points)-1 do
begin
px := Points[i].X;
py := Points[i].Y;
px := px+round(p1.x);
py := py+round(p1.y);
dx := px;
dy := py;
Dengine.DeConvertCoord(dx,dy,z);
Dpoints[i] := DoublePOint(dx,dy,0);
end;
//Tolik
if Length(Points) > 0 then
SetLength(Points,0);
//
end;
function TPolyline.SelfIntersecting: Boolean;
var lCnt,i,k:Integer;
xp1,xp2,xp3,xp4,p: TDoublePoint;
begin
result := false;
if closed then lCnt := PointCount else lCnt := PointCount-1;
for i := 1 to lcnt do
begin
xp1 := ActualPoints[i];
xp2 := ActualPoints[i+1];
for k := i+1 to lCnt do
begin
xp3 := ActualPoints[k];
xp4 := ActualPoints[k+1];
if GetIntersectionPoint(xp1,xp2,xp3,xp4,p,false,false) then begin
result := true;
break;
end;
if result then break;
end;
end;
end;
constructor TBMPObject.createExRes(x, y: Double; BmpRes: Integer;
aBitmap: TBitmap; LHandle: Integer; aDrawStyle: TDrawStyle;
aOwner: TComponent);
var picW,picH : Double;
begin
inherited create(LHandle, aDrawStyle,aOwner);
originalpoints[1] := DoublePoint(x,y);
originalpoints[1] := DoublePoint(x,y);
originalpoints[2] := DoublePoint(x,y);
originalpoints[3] := DoublePoint(x,y);
originalpoints[4] := DoublePoint(x,y);
actualpoints[1] := originalpoints[1];
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
SelMode := 2;
pointcount := 4;
if DrawStyle = mydsNormal then
begin
PictureName := '';
Picture := TBitmap.create;
Picture.Assign(aBitmap);
Picture.PixelFormat := pf24bit;
PicW := (Picture.width / bmpres) * 25.4 ;
if horzZero = 1 then PicW := -1* PicW;
PicH := (Picture.Height / bmpres) * 25.4 ;
if vertZero = 1 then PicH := -1* PicH;
originalpoints[2] := DoublePoint(x+PicW,y);
originalpoints[3] := DoublePoint(x+PicW,y-PicH);
originalpoints[4] := DoublePoint(x,y-PicH);
actualpoints[2] := originalpoints[2];
actualpoints[3] := originalpoints[3];
actualpoints[4] := originalpoints[4];
width := 1;
color := clBlack;
VertFlipped := false;
HorzFlipped := false;
Image := TBitmap.Create;
Modified := True;
ImageEdited := True; // Tolik 20/04/2018 --
end;
end;
function TFigure.GetArea: Double;
begin
result := 0;
end;
function TFigure.GetLength: Double;
begin
result := 0;
end;
function TFigure.GetModPointBySeqNbr(ANbr: Integer; x, y: Double): TModPoint;
var
i: Integer;
pdim : Double;
begin
Result := nil;
pdim := pointdim;
TPCDrawing(Owner).DeConvertDim(pdim);
// Tolik 24/12/2019 --
//for i := 0 to SelPoints.count - 1 do
for i := SelPoints.count - 1 downto 0 do
begin
if SelPoints[i] = nil then
SelPoints.delete(i)
else
//
begin
if (TModPoint(SelPoints[i]).SeqNbr = ANbr) and TModPoint(SelPoints[i]).IsPointIn(x,y,pdim) then
begin
Result := TModPoint(SelPoints[i]);
Break; //// BREAK ////
end;
end;
end;
end;
function TLine.GetLength: Double;
begin
result := GetLineLength(ap1,ap2);
end;
// Tolik -- 23/05/2017 -- PIE FIGURE --
Constructor TPie.Create( cx,cy,rad,a1,a2:Double;w,s,c,abrs,abrc: Integer;
LHandle:LongInt; aDrawStyle: TDrawStyle; aOwner: TComponent; aCutStyle: TPieCutStyle; aCutRadius: Double = 0);
var p1,p2:TDoublePoint;
cp: TDoublePOint;
MiddleAngle: Double;
begin
inherited create(LHandle,aDrawStyle,aOwner);
Initialize;
originalpoints[1] := DoublePoint(cx,cy); // Center Point
actualpoints[1] := DoublePoint(cx,cy); // Center Point
SAngle:= a1;
FAngle:= a2;
radius := rad;
width := w;
color := c;
style := s;
brs := abrs;
brc := abrc;
brs := Ord(bsSolid);
//brc := clSkyBlue;
CutStyle := aCutStyle; // cut style
//
CutRadius := aCutRadius;
{if aCutRadius <> -1 then
begin
if (FAngle < SAngle) then begin
MiddleAngle := SAngle+((2*pi)-SAngle+FAngle)/2;
end
else
begin
MiddleAngle := (SAngle+FAngle)/2;
end;
p1 := DoublePoint(cp.x + aCutRadius, cp.y);
p1 := RotatePoint(cp, p1, MiddleAngle);
originalpoints[4] := DoublePoint(p1.x,p1.y);
actualpoints[4] := DoublePoint(p1.x,p1.y);
end
else
begin
originalpoints[4] := DoublePoint(cx,cy);
actualpoints[4] := DoublePoint(cx,cy);
end;
}
end;
Destructor TPie.Destroy;
begin
inherited;
end;
Procedure TPie.Initialize;
begin
inherited;
pointcount := 1;
FillColor := clSkyBlue;
GuideLen := 10;
DrawGuides:= True;
Autotext := True;
Dlabel := '';
Prefix := '';
Suffix := '°';
TextFont := 'Courier New';
TextHeight:= 4;
TextBold:= False;
TextItalic:= False;
Dlabel := 'Label';
LStyle := rlsInner;
TextColor := clBlack;
Visible := True;
end;
procedure TPie.getModPoints(ModList: TMyList);
var
mp1, mp2, mp3,mp4: TDoublePoint;
MAngle: Double;
CControl: TPCDrawing;
procedure CorrectCutModPoint;
var p1, p2: TDoublePoint;
GradAngleVal, Angle1, Angle2: Integer;
begin
if CutRadius = 0 then
exit;
if Comparevalue(Fangle, Sangle) = 0 then
exit;
if cutStyle = PieArcCut then
exit;
GradAngleVal := 0;
// angles
Angle1 := Round((180/pi)*Sangle);
Angle2 := Round((180/pi)*Fangle);
if Angle1 = 360 then
Angle1 := 0;
if Angle2 = 360 then
Angle2 := 0;
while Angle1 <> Angle2 do
begin
angle1 := angle1 + 1;
if angle1 = 360 then
angle1 := 0;
inc(GradAngleVal);
if GradAngleVal > 160 then
break;
end;
if GradAngleVal <= 160 then
begin
p1.x := ap1.x + CutRadius;
p1.y := ap1.y;
p2.x := ap1.x + CutRadius;
p2.y := ap1.y;
p1 := RotatePoint(ap1, p1, FAngle);
p2 := RotatePoint(ap1, p2, SAngle);
mp1.x := (p1.x + p2.x)/2;
mp1.y := (p1.y + p2.y)/2;
end;
end;
begin
begin
CControl := TPCDrawing(Owner);
end;
mp1 := ap1; // 1 = mp -- modificate cut Radius
mp2 := DoublePoint(ap1.x + Radius, ap1.y);
mp3 := DoublePoint(ap1.x + Radius, ap1.y);
mp4 := DoublePoint(ap1.x + Radius, ap1.y); // Pie Radius Modificate
mp2 := RotatePoint(AP1, mp2, SAngle);
mp3 := RotatePoint(AP1, mp3, FAngle);
if FAngle = SAngle then
begin
mp4 := RotatePoint(AP1, mp4, FAngle); // not means (Fangle = Sangle)
end
else
begin
if (FAngle < SAngle) then
MAngle := SAngle+((2*pi)-SAngle+FAngle)/2
else
MAngle := (SAngle+FAngle)/2;
mp4 := RotatePoint(AP1, mp4, MAngle);
if CutRadius <> 0 then
begin
mp1.x := mp1.x + cutRadius;
mp1 := RotatePoint(ap1, mp1,Mangle);
if cutStyle = PieLinearCut then
CorrectCutModPoint;
end;
end;
if Radius = 0 then
begin
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,mp4.x,mp4.y,4));
end
else
begin
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clRed,2,mp1.x,mp1.y,1)); // pie Cut Point
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clBlue,pointdim,mp2.x,mp2.y,2)); // one borderPoint
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptRect,clBlue,pointdim,mp3.x,mp3.y,3)); // another borderPoint
ModList.Add(CControl.RegisterModPoint(self,ptArcEnd,ptCircle,clRed,2,mp4.x,mp4.y,4)); // Pie ARC border modPoint
end;
end;
function TPie.GetCutStyle: TPieCutStyle;
var angle1, angle2: Integer;
i: Integer;
begin
Result := PieLinearCut;
Angle1 := Round((180/pi)*Sangle);
Angle2 := Round((180/pi)*Fangle);
if Angle1 = 360 then
Angle1 := 0;
if Angle2 = 360 then
Angle2 := 0;
while angle1 <> angle2 do
begin
inc(angle1);
inc(i);
if angle1 = 360 then
angle1 := 0;
end;
if i >= 160 then
Result := PieArcCut;
end;
Procedure TPie.Rotate(aAngle: Double; cPoint: TDoublePoint);
var RotatedCP: TDoublePoint;
begin
{
Fangle := FAngle + aAngle;
SAngle := SAngle + aAngle;
}
// Tolik 01/11/2019 -- ýòî ÷òîáû êðóã íå ïîâîðà÷èâàòü (èáî íåõ)
if RadToDeg(Sangle) = 0 then
if RadToDeg(Fangle) = 360 then
exit;
//
Fangle := ABS(FAngle + aAngle);
SAngle := ABS(SAngle + aAngle);
While FAngle > 2*PI do
FAngle := FAngle - 2*PI;
While SAngle > 2*PI do
SAngle := SAngle - 2*PI;
if ((CompareValue(ap1.x, cPoint.x) <> 0) or (CompareValue(ap1.y, cPoint.y) <> 0)) then
begin
RotatedCP := RotatePoint(cPoint, ap1, aAngle);
originalpoints[1] := RotatedCP;
ActualPoints[1] := RotatedCP;
end;
end;
Procedure TPie.Mirror(Point1,Point2: TDoublePoint);
var i: Double;
begin
i := PI;
Rotate(I, Point1);
ResetRegion;
end;
procedure TPie.getbounds(var figMaxX,figMaxY,figMinX,figMinY: double);
var points: array of TDoublePoint;
angle1, angle2: integer;
ArrayLength: Integer;
PointToRotate: TDoublePoint;
{Procedure GetPiePoints;
var a: Integer;
z: Double;
begin
Angle1 := Round((180/pi)*Sangle);
Angle2 := Round((180/pi)*Fangle);
ArrayLength := 1;
SetLength(Points, 1);
points[0] := ap1; // centerPoint
z := 0;
while Angle1 <> Angle2 do
begin
PointToRotate := DoublePoint(ap1.x + Radius, ap1.y, 0);
PointToRotate := RotatePoint(ap1,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;
end;
}
Procedure GetPiePoints;
var i, cutArrayLength: Integer;
cutRadius: double;
cutArray: Array of TDoublePoint;
p1: TDoublePoint;
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;
// 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 Self.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 ord(CutStyle) = 0 then // Linear Cutting
begin
p1.x := ap1.x + Self.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 + Self.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 ord(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 + Self.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 + Self.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;
{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
figMinX := points[0].x;
figMinY := points[0].y;
figMaxX := points[0].x;
figMaxY := points[0].y;
if ArrayLength = 1 then
begin
SetLength(points, 0);
exit;
end;
for i := 1 to ArrayLength - 1 do
begin
if Comparevalue(figMinX, points[i].x) = 1 then
figMinX := points[i].x;
if Comparevalue(figMinY, points[i].y) = 1 then
figMinY := points[i].y;
if Comparevalue(figMaxX, points[i].x) = -1 then
figMaxX := points[i].x;
if Comparevalue(figMaxY, points[i].y) = -1 then
figMaxY := points[i].y;
end;
end;
SetLength(points, 0);
end;
begin
//z := 0;
// 01/11/2019 --
Angle1 := Round((180/pi)*Sangle);
Angle2 := Round((180/pi)*Fangle);
if Angle1 = 0 then
if Angle2 = 360 then
begin
figMinX := ActualPoints[1].x - radius;
figMinY := ActualPoints[1].y - radius;
figMaxX := ActualPoints[1].x + radius;
figMaxY := ActualPoints[1].y + radius;
exit;
end;
//
GetPiePoints; // òî÷êè
GetPieBounds; // ãðàíèöû
SetLength(Points, 0);
end;
class function TPie.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
Result := Nil;
if ((CompareValue(TPie(Shadow).Fangle, TPie(Shadow).Sangle) = 0) or (TPie(Shadow).radius = 0)) then
exit;
cad := TPCDrawing(aOwner);
Result := TPie.Create(
shadow.ap1.x,
shadow.ap1.y,
TPie(shadow).radius,
TPie(Shadow).SAngle,
TPie(Shadow).FAngle,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
//ord(cad.DefaultBrushStyle),
1,
cad.DefaultBrushColor,
LHandle,mydsNormal,aOwner,
TPie(Shadow).CutStyle, TPie(Shadow).CutRadius);
end;
class function TPie.CreateShadow(x, y: Double): TFigure;
var cutRad: double;
begin
Result := TPie.Create(x,y,0,0,0,0,0,0,Ord(bsNone),clLime,
0, dsTrace, Nil, PieLinearCut);
result.color := clLime;
end;
Function TPie.GetClassName:String;
begin
Result := 'Pie';
end;
Function TPie.Edit:Boolean;
var
enterstr: string;
begin
(* Result := False;
EnterStr := FloatToStr(Round2(GetAngle)); //06.10.2011 DLabel;
// if InputQuery(capDimensionLabel, msEnterNewLabelText, EnterStr) then
//06.10.2011 if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
if InputQuery(cDrawObjects_Mes4, cDrawObjects_Mes5, EnterStr) then
begin
//DLabel := EnterStr;
//AutoText := False;
//Modified := True;
//result := true;
result := SetAngle(StrToFloat_My(EnterStr));
end;
*)
end;
procedure TPie.Draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var
acolor, bcolor : Tcolor;
dx,dy: real;
Angle,rad,MAngle: Double;
p4,p1,p2: TDOublePoint;
st: TFontstyles;
text: String;
gLen: Double;
Rect: TRect;
aRect: TDoubleRect;
maxx, minx, maxy, miny: Double;
Function GetCutStyleForDraw: Integer;
var
GradAngleVal, Angle1, Angle2: Integer;
begin
Result := 0;
if CutRadius = 0 then
exit;
if Comparevalue(Fangle, Sangle) = 0 then
exit;
if cutStyle = PieArcCut then
begin
Result := 1;
exit;
end;
GradAngleVal := 0;
// angles
Angle1 := Round((180/pi)*Sangle);
Angle2 := Round((180/pi)*Fangle);
if Angle1 = 360 then
Angle1 := 0;
if Angle2 = 360 then
Angle2 := 0;
while Angle1 <> Angle2 do
begin
angle1 := angle1 + 1;
if angle1 = 360 then
angle1 := 0;
inc(GradAngleVal);
if GradAngleVal > 160 then
break;
end;
if GradAngleVal > 160 then
Result := 1;
end;
begin
//07.10.2011 - ñáðîñ óãëîâ äëÿ ïåðåñ÷åòà, åñëè âûøëè çà ïðåäåëû 2*pi
if (DrawStyle = mydsNormal) and ((FAngle > 2*pi) or (SAngle > 2*pi)) then
begin
SAngle := 0;
FAngle := 0;
end;
acolor := color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
if (isGrayed) then begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
end;
if DrawStyle = dsTrace then
DEngine.Canvas.Pen.Mode := pmXor
else
DEngine.Canvas.Pen.Mode := pmCopy;
st := [];
if TextBold then st := st + [fsBold];
if TextItalic then st := st + [fsItalic];
text := '';
if DrawStyle = mydsNormal then
begin
if autotext then begin
if FAngle = SAngle then
begin
MAngle := 2*PI;
end else begin
if (FAngle < SAngle) then begin
MAngle := 2*Pi - SAngle+ FAngle;
end else begin
MAngle := FAngle-SAngle;
end;
end;
text := FloatToStr(Round2((MAngle/PI)*180)); //07.10.2011 inttostr(round((MAngle/PI)*180));
text := Prefix+text+Suffix;
end else text := DLabel;
end;
if DrawGuides then
gLen := GuideLen
else
gLen := 0;
if DrawStyle = mydsNormal then
begin
//Dengine.DrawPie(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, brc, brs, ord(cutStyle), RegHandle, AP1, FAngle, SAngle, Radius, CutRadius);
//Dengine.DrawPie(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom, brc, brs, GetCutStyleForDraw, RegHandle, AP1, FAngle, SAngle, Radius, CutRadius);
if (isAutoCreatedFigure = biFalse) then
Dengine.DrawPie(brc, brs, GetCutStyleForDraw, RegHandle, AP1, FAngle, SAngle, Radius, CutRadius)
else
Dengine.DrawPie(brc, brs, ord(CutStyle), RegHandle, AP1, FAngle, SAngle, Radius, CutRadius);
DrawFill(Dengine,isGrayed);
DrawClipFigures(Dengine,isGrayed);
end
else
if DrawStyle = dsTrace then
begin
// DEngine.DrawPieShadow(ap1, Radius, Sangle, Fangle, cutRadius, ord(cutStyle));
DEngine.DrawPieShadow(ap1, Radius, Sangle, Fangle, cutRadius, GetCutStyleForDraw);
end;
// Tolik
if RegHandle > 1 then
begin
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := True;
deleteObject(RegHandle);
RegHandle := 0;
end;
//
end;
function TPie.IsPointIn(x, y: Double): boolean;
begin
result := inherited isPointIn(x,y);
if not result then begin
result := isPointInRegion(x,y);
// Tolik
result := IsPointInRegionByRegObj(x,y);
//
end;
end;
procedure TPie.MenuClicked(CommandId: integer);
var mnIdx: integer;
begin
{ mnIdx := CommandId-MenuIndex;
case mnIdx of
0: DrawGuides:= not DrawGuides;
1: LStyle:= rlsInner;
2: LStyle:= rlsOuter;
3: Invert;
4: AutoText := not AutoText;
end;
}
end;
function TPie.GetAngle: Double;
var
Angle1, Angle2: Double;
begin
Result := 0;
Angle2 := GetradOfLine(ap1,ap2);
Angle1 := GetradOfLine(ap1,ap3);
if Angle1 = Angle2 then
Result := 2*PI
else
begin
if (Angle1 < Angle2) then
Result := 2*Pi - Angle2+ Angle1
else
Result := Angle1-Angle2;
end;
Result := Result *(180/pi);
end;
procedure TPie.Scale(percentx, percenty: Double; rPoint: TDoublePoint);
var
p1,p2:TDoublePoint;
cp: TDoublePOint;
division: Double;
Begin
division := $FFFF;
if GuideLen > 0 then
division := Radius / GuideLen;
Inherited;
if (division <> $FFFF) and (division <> 0) then
GuideLen := Radius / division;
end;
function TPie.SetAngle(AValue: Double): Boolean;
var
NewAngle, AngleDelta: Double;
begin
Result := false;
if (FAngle = 0) and (SAngle = 0) then
begin
SAngle := GetradOfLine(ap1,ap2);
FAngle := GetradOfLine(ap1,ap3);
end;
if (AValue >= 0) and (AValue <= 360) then
begin
NewAngle := (AValue/180)*pi;
begin
AngleDelta := 0;
if (FAngle < SAngle) then
begin
AngleDelta := NewAngle - (2*Pi - SAngle + FAngle);
SAngle := SAngle - AngleDelta;
if SAngle > 2*pi then
SAngle := SAngle - (2*pi);
end
else
begin
AngleDelta := NewAngle - (FAngle-SAngle);
FAngle := FAngle + AngleDelta;
if FAngle > 2*pi then
FAngle := FAngle - (2*pi);
end;
// Åñëè óãëû ïî÷òè îäèíàêîâû
if Abs(FAngle - SAngle) < 0.01 then
SAngle := FAngle;
Result := true;
ResetRegion;
Modified := True;
end;
end;
end;
procedure TPie.WriteToStream(Stream: TStream);
var xByte: Byte;
xInt: Integer;
xStr: String;
xDbl: Double;
begin
inherited WriteToStream(Stream);
//xByte := brs;
if brs = -1 then
xByte := 255
else
xByte := LoByte(LoWord(brs));
WriteField(90,Stream,xByte,1);
xByte := ord(CutStyle);
WriteField(91,Stream,xByte,1);
xInt := brc;
WriteField(20,Stream,xInt,4);
xDbl := Radius;
WriteField(222,Stream,xDbl,8);
xDbl := SAngle;
WriteField(220,Stream,xDbl,8);
xDbl := FAngle;
WriteField(221,Stream,xDbl,8);
xStr := DLabel;
WriteStrField(180,Stream,xStr);
xStr := Prefix;
WriteStrField(181,Stream,xStr);
xStr := Suffix;
WriteStrField(182,Stream,xStr);
xStr := TextFont;
WriteStrField(183,Stream,xStr);
xDbl := TextHeight;
WriteField(230,Stream,xDbl,8);
xDbl := GuideLen;
WriteField(231,Stream,xDbl,8);
xDbl := CutRadius;
WriteField(232,Stream,xDbl,8); // cutRadius
if TextBold then xByte := 1 else xByte := 0;
WriteField(100,Stream,xByte,1);
if TextItalic then xByte := 1 else xByte := 0;
WriteField(101,Stream,xByte,1);
if AutoText then xByte := 1 else xByte := 0;
WriteField(102,Stream,xByte,1);
if DrawGuides then xByte := 1 else xByte := 0;
WriteField(103,Stream,xByte,1);
xByte := ord(LStyle);WriteField(104,Stream,xByte,1);
end;
procedure TPie.SetPropertyFromStream(xCode: Byte; data: pointer;
size: integer);
begin
inherited;
Case xcode of
20: brc := pInt(data)^;
21: Radius := pInt(data)^/10;
90:
begin
if pByte(data)^ = 255 then
brs := -1
else
brs := pByte(data)^;
end;
91: CutStyle := TPieCutStyle(pByte(data)^);
220: SAngle := pDouble(data)^;
221: FAngle := pDouble(data)^;
222: Radius := pDouble(data)^;
100 : TextBold := ((pByte(data)^) = 1);
101 : TextItalic := ((pByte(data)^) = 1);
102 : AutoText := ((pByte(data)^) = 1);
103 : DrawGuides := ((pByte(data)^) = 1);
104 : LStyle := TArcDimLabelStyle(pByte(data)^);
180: DLabel := string(pchar(data));
181: Prefix := string(pchar(data));
182: Suffix := string(pchar(data));
183: TextFont := string(pchar(data));
230: TextHeight := pDouble(data)^;
231: GuideLen := pDouble(data)^;
232: CutRadius := pDouble(data)^; // cut Radius (from center Point)
253: isAutocreatedFigure := pByte(data)^;
254: Transparency := PInteger(data)^;
end;
end;
function TPie.ShadowClick(ClickIndex: Integer; x,
y: Double): Boolean;
var cp,p1: TDoublePoint;
begin
result := false;
if clickIndex = 2 then
begin
radius := sqrt(sqr(x - ap1.x) +
sqr(y - ap1.y));
cp := ap1;
p1 := DoublePoint(x,y);
SAngle := GetradOfLine(cp,p1);
FAngle := SAngle;
result := false;
end
else
if clickindex = 3 then
begin
cp := ap1;
p1 := DoublePoint(x,y);
FAngle := GetradOfLine(cp,p1);
result := true;
end;
end;
function TPie.ShadowTrace(ClickIndex: Integer; x,
y: Double): Boolean;
var cp,p1,p2: TDoublepoint;
Degree: Double;
StrRadius: string;
begin
strradius := '';
If ClickIndex = 1 then
begin
Radius := sqrt(sqr(x - ap1.x)+ sqr(y - ap1.y));
cp := ap1;
p1 := DoublePoint(x,y);
SAngle := GetradOfLine(cp,p1);
FAngle := SAngle;
end
else
if ClickIndex = 2 then
begin
cp := ap1;
p1 := DoublePoint(x,y);
FAngle := GetradOfLine(cp,p1);
end;
end;
function TPie.CreateModification: TFigure;
begin
Result := TPie.Create(ap1.x,ap1.y,Radius,SAngle,Fangle,0,0,0,Ord(bsNone),clLime,
0, dsTrace, nil, cutStyle, cutRadius);
Result.Color := clLime;
end;
Function TPie.GetMiddleAngle: Double;
var i, angle1, angle2 : Integer;
pp1: TDoublepoint;
begin
Result := 0;
// angles
Angle1 := Round((180/pi)*Fangle);
Angle2 := Round((180/pi)*Sangle);
if Angle1 = 360 then
Angle1 := 0;
if Angle2 = 360 then
Angle2 := 0;
i := 0;
while Angle1 <> Angle2 do
begin
inc(Angle1);
inc(i);
if Angle1 = 360 then
begin
Angle1 := 0;
i := 0;
end;
end;
if i <> 0 then
Result := (i/2)/180*PI;
end;
function TPie.TraceModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
var Angle, MiddleAngle: Double;
cp,p1, p2: TDoublepoint;
Minx, Miny, MaxX, MaxY: Double;
cutRadius: Double;
begin
cp := ap1;
p1 := DoublePoint(x,y);
Angle := GetRadOfLine(cp,p1);
if mp.SeqNbr = 2 then
begin
TPie(TraceFigure).SAngle := Angle;
//TPie(TraceFigure).FAngle := Angle;
end
else
if mp.SeqNbr = 3 then
begin
TPie(TraceFigure).FAngle := Angle;
end
else
if (mp.SeqNbr = 4) then //or (mp.SeqNbr = 5) then
begin
TPie(TraceFigure).Radius := sqrt( sqr(x - cp.x)+sqr(y - cp.y));
//TPie(TraceFigure).Fangle := TPie(TraceFigure).Sangle;
end
else
if (mp.SeqNbr = 1) then // CUT PIE MODPOINT !!!
begin
TPie(TraceFigure).cutRadius := sqrt(sqr(x - ap1.x) + sqr(y - ap1.y));
{if (FAngle < SAngle) then begin
MiddleAngle := SAngle+((2*pi)-SAngle+FAngle)/2;
end
else
begin
MiddleAngle := (SAngle+FAngle)/2;
end;
}
end;
end;
function TPie.EndModification(CadControl: Pointer; mp: TModPoint;
TraceFigure: TFigure; x, y: double; Shift: TShiftState): boolean;
var Angle, MAngle: Double;
cp, p1, p2: TDoublepoint;
r: Double;
bool:Boolean;
begin
bool := (radius = GuideLen);
//result := Inherited EndModification(CadControl,mp,TraceFigure,x,y,shift);
cp := ap1;
p1 := DoublePoint(x,y);
Angle := GetradOfLine(cp,p1);
if mp.SeqNbr = 2 then
SAngle := Angle
else if mp.SeqNbr = 3 then
FAngle := Angle
else if mp.SeqNbr = 4 then
Radius := sqrt( sqr(x - cp.x)+sqr(y - cp.y) );
ResetRegion;
Modified := True;
if mp.SeqNbr = 4 then
begin
if bool then GuideLen := Radius;
if GuideLen > Radius then GuideLen := Radius;
end
else
if mp.SeqNbr = 1 then
begin
CutRadius := sqrt( sqr(x - cp.x)+sqr(y - cp.y));
GuideLen := Radius - CutRadius;
end;
end;
procedure TPie.UpdateMenu(var popMenu: TPopUpMenu;
var sIndex: Integer);
var mnItem,subItem:TMenuItem;
begin
menuIndex := sIndex;
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDrawGuides;
mnItem.Tag := sIndex;
if DrawGuides then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmDimPosition;
mnItem.Tag := 0;
PopMenu.Items.Add(mnItem);
subItem := TMenuItem.Create(PopMenu);
subItem.Caption := fmInsideArc;
subItem.Tag := sIndex+1;
if LStyle = rlsInner then subItem.Checked := true;
mnItem.Add(subItem);
subItem := TMenuItem.Create(PopMenu);
subItem.Caption := fmOutsideArc;
subItem.Tag := sIndex+2;
if LStyle = rlsOuter then subItem.Checked := true;
mnItem.Add(subItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmInvertArc;
mnItem.Tag := sIndex+3;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(PopMenu);
mnItem.Caption := fmAutoLabel;
mnItem.Tag := sIndex+4;
if AutoText then mnItem.Checked := true;
PopMenu.Items.Add(mnItem);
sIndex := sIndex+5;
end;
// ------------- End Pie ----------------------//
function TPolyline.GetArea: Double;
begin
result := 0;
if closed then begin
result := GetAreaOfPGon(Actuals);
end;
end;
function TPolyline.GetLength: Double;
var i: Integer;
begin
result := 0;
for i := 1 to PointCount-1 do begin
result:= result+GetLineLength(FigurePoints[i],FigurePoints[i+1]);
end;
if closed then begin
result:= result+GetLineLength(FigurePoints[PointCount],FigurePoints[1]);
end;
end;
function TEllipse.GetArea: Double;
begin
result := pi*alen*bLen;
end;
function TEllipse.GetLength: Double;
var a2pb2:Double;
amb2d2:double;
begin
a2pb2 := alen*alen+blen*blen;
amb2d2 := ((alen-bLen)*(alen-bLen))/2;
result := sqrt(2*a2pb2-amb2d2)*pi;
end;
function TCircle.GetArea: Double;
begin
result := GetareaOfCircle(Radius);
end;
function TCircle.GetLength: Double;
begin
result := GetPerimeterOfCircle(Radius);
end;
function TRectangle.GetArea: Double;
begin
result := GetLineLength(ap1,ap2)* GetLineLength(ap2,ap3);
end;
Destructor TRectangle.Destroy;
begin
FreeMem(FDrawPoints, 5*8);
Inherited;
end;
function TRectangle.GetLength: Double;
begin
result := GetLineLength(ap1,ap2)+ GetLineLength(ap2,ap3);
result := 2*result;
end;
procedure Tlayer.SetLayerPropertyStream(xCode: Byte; Stream: TStream;
CadControl: TObject);
var Cad:TPCDrawing;
begin
if xCode = 151 then begin
Cad := TPCDrawing(CadCOntrol);
if assigned(Stream) and assigned(Cad) and assigned(Cad.OnLayerLoadData) then
begin
Cad.OnLayerLoadData(Cad,Self,Stream);
end;
end;
end;
procedure TPolyline.SimplfyPoints;
var i: Integer;
p1,p2,p3: TDoublePoint;
p: Array of Integer;
cnt: Integer;
d: Double;
begin
cnt := 0;
SetLength(p,cnt);
for i := 2 to PointCount -1 do
begin
if (i mod 2) = 0 then
begin
p1 := ActualPoints[i-1];
p2 := ActualPoints[i];
p3 := ActualPoints[i+1];
d := GetDistToLine(p1,p3,p2);
if d <= 1 then begin
cnt := cnt+1;
SetLength(p,cnt);
p[cnt-1] := i;
end;
end;
end;
for i:= cnt-1 downto 0 do
begin
DeleteKnot(p[i]);
end;
NeedBounds := True; //Tolik 02/08/2021 --
end;
{ TPointSet }
class function TPointSet.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
points: TDoublePointArr;
a: integer;
begin
result := nil;
cad := TPCDrawing(aOwner);
if Shadow.PointCount < 3 then exit;
SetLength(points,Shadow.PointCount-2);
for a := 1 to Shadow.PointCount-2 do begin
points[a-1] := Shadow.ActualPoints[a];
end;
result := TPointSet.create(points,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultRowStyle),
TPolyline(Shadow).Closed or
Cad.DefaultPLineClosed,
LHandle,mydsNormal,aOwner);
end;
function TPointSet.CreateModification: TFigure;
var points: TDoublePointArr;
a: integer;
Res: TPolyLine;
p: PPoint;
begin
SetLength(points,PointCount);
for a := 1 to PointCount do
begin
points[a-1] := ActualPoints[a];
end;
Res := TPointSet.create(points,1,1,clLime,0,0,0,closed,0,dsTrace,nil);
res.SelectedPoint := SelectedPoint;
if assigned(res) then res.RotPoint := RotPoint;
CreateModification := res;
end;
class function TPointSet.CreateShadow(x, y: Double): TFigure;
var points: TDoublePointArr;
begin
SetLength(points,2);
points[0] := DoublePoint(x,y);
points[1] := DoublePoint(x,y);
CreateShadow := TPointSet.create(Points,1,1,clLime,0,0,ord(rsNone),false,0,dsTrace,nil);
//CreateShadow.PointCount := 1;
end;
procedure TPointSet.Draw(Dengine: TPCDrawEngine; isGrayed: Boolean);
var
Layer: TLayer;
acolor,bColor : Tcolor;
Grayedd : boolean;
ap: TdoublePoint;
i: Integer;
rgn: HRGN;
begin
aColor := Color;
if (aColor = -255) and (LayerHandle <> 0) then begin
aColor := TLayer(LayerHandle).PenColor;
end;
bColor := brc;
if (bColor = -255) and (LayerHandle <> 0) then begin
bColor := TLayer(LayerHandle).BrushColor;
end;
Grayedd := false;
if (isGrayed) then
begin
acolor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
bColor := TPCDrawing(Owner).FGrayedColor; //06.08.2012 GrayedColor;
Grayedd := true;
end;
if drawStyle = dsTrace then DEngine.Canvas.Pen.Mode := pmXor
else DEngine.Canvas.Pen.Mode := pmCopy;
for i := 1 to PointCount do
begin
ap := ActualPoints[i];
rgn := 1;
Dengine.DrawCircle(ap,0.8,aColor,1,ord(psSolid),aColor,ord(bsSolid),rgn);
//Dengine.drawselectionpoint(ap.x,ap.y,ap.z,ptCircle,4,aColor,(drawStyle = dsTrace));
end;
if (drawStyle = dsTrace) and
(PointCount > 2) and
(ap1.x = ActualPoints[PointCount].x) and
(ap1.y = ActualPoints[PointCount].y)
then
begin
DEngine.drawselectionpoint(ap1.x,ap1.y,ap1.z,ptECircle,6,clLime,True);
end;
end;
procedure TPointSet.DrawSelectionPoints(DEngine: TPCDrawEngine;
isGrayed: Boolean);
var Layer: TLayer;
a : integer;
pt : TModPoint;
aColor : TColor;
fKnot:TPoint;
lColor: integer;
idx: Integer;
x,y,z: Double;
ap: TDoublePoint;
begin
// Tolik 24/12/2019 --
//For a := 0 to SelPoints.Count -1 do
for a := SelPoints.Count - 1 downto 0 do
begin
if SelPoints[a] = nil then
SelPoints.delete(a)
else
begin //
pt := TModPoint(SelPoints[a]);
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
aColor := pt.Color;
if isGrayed then
lcolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
lColor := clred;
if pt.pType = ptPolyPoint then begin
if selectedpoint = pt.SeqNbr then begin
aColor := clRed;
if SelectedPoint = PointCount then
ap := ActualPoints[1] else
ap := ActualPoints[selectedpoint+1];
end;
DrawSelPoint(DEngine,isGrayed,pt);
end;
x := pt.CoordX;
y := pt.CoordY;
z := pt.CoordY;
DEngine.ConvertPoint(x,y,z);
pt.PixX := Round(x);
pt.PixY := Round(y);
end;
end;
end;
function TPointSet.GetClassName: String;
begin
result := 'PointSet';
end;
{ TAngleLine }
class function TAngleLine.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
points: TDoublePointArr;
a: integer;
begin
cad := TPCDrawing(aOwner);
SetLength(points,Shadow.PointCount-1);
for a := 1 to Shadow.PointCount-1 do begin
points[a-1] := Shadow.ActualPoints[a];
end;
result := TAngleLine.create(points,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
ord(cad.DefaultRowStyle),
TPolyline(Shadow).Closed or
False,
LHandle,mydsNormal,aOwner);
end;
function TAngleLine.CreateModification: TFigure;
var points: TDoublePointArr;
a: integer;
Res: TPolyLine;
p: PPoint;
begin
SetLength(points,PointCount);
for a := 1 to PointCount do
begin
points[a-1] := ActualPoints[a];
end;
Res := TAngleLine.create(points,1,1,clLime,0,0,0,closed,0,dsTrace,nil);
res.SelectedPoint := SelectedPoint;
if assigned(res) then res.RotPoint := RotPoint;
CreateModification := res;
end;
class function TAngleLine.CreateShadow(x, y: Double): TFigure;
var points: TDoublePointArr;
begin
SetLength(points,2);
points[0] := DoublePoint(x,y);
points[1] := DoublePoint(x,y);
CreateShadow := TAngleLine.create(Points,1,1,clLime,0,0,ord(rsNone),false,0,dsTrace,nil);
end;
procedure TAngleLine.Draw(Dengine: TPCDrawEngine; isGrayed: Boolean);
var xp1,xp2,cp: TDoublePoint;
rgn: HRGN;
a,a1,a2: Double;
sw: Boolean;
begin
inherited;
if drawStyle = mydsNormal then
begin
xp1 := ap1;
xp2 := ap3;
cp := ap2;
a1 := GetRadOfLine(cp,xp1);
a2 := GetRadOfLine(cp,xp2);
sw := false;
if a1 > a2 then begin
a := a1-a2;
if a < pi then sw := true;
end else begin
a := a2-a1;
if a > pi then sw := true;
end;
if sw then begin
a := a1;
a1 := a2;
a2 := a;
end;
a := GetAngle;
DEngine.drawbezarc(cp.x,cp.y,10.0,a1,a2,color,1,style,brc,brs,
ord(asOpen),rgn,xp1,xp2,false,ord(rsBothSolid),1.5,0.7);
xp1 := Mpoint(cp,xp1,10.0);
xp2 := Mpoint(cp,xp2,10.0);
xp1 := MPoint(xp1,xp2);
xp1 := Mpoint(cp,xp1,10.0);
xp1 := MovePoint(xp1,2.5,0);
Dengine.DrawCenteredText(xp1,color,floattostr(a)+'°','Tahoma',2.0);
end;
end;
procedure TAngleLine.DrawSelectionPoints(DEngine: TPCDrawEngine;
isGrayed: Boolean);
var Layer: TLayer;
a : integer;
pt : TModPoint;
aColor : TColor;
fKnot:TPoint;
lColor: integer;
idx: Integer;
x,y,z: Double;
ap: TDoublePoint;
begin
// Tolik 24/12/2019 --
//For a := 0 to SelPoints.Count -1 do
For a := SelPoints.Count - 1 downto 0 do
begin
pt := TModPoint(SelPoints[a]);
if pt = nil then
SelPoints.delete(a)
else
begin
//
if isGrayed then
acolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
aColor := pt.Color;
if isGrayed then
lcolor := TPCDrawing(Owner).FGrayedColor //06.08.2012 Grayedcolor
else
lColor := clred;
if pt.pType = ptPolyPoint then begin
if selectedpoint = pt.SeqNbr then begin
aColor := clRed;
if SelectedPoint = PointCount then
ap := ActualPoints[1] else
ap := ActualPoints[selectedpoint+1];
end;
DrawSelPoint(DEngine,isGrayed,pt);
end;
x := pt.CoordX;
y := pt.CoordY;
z := pt.CoordY;
DEngine.ConvertPoint(x,y,z);
pt.PixX := Round(x);
pt.PixY := Round(y);
end;
end;
end;
function TAngleLine.GetAngle: Double;
var a: DOuble;
begin
a := GetRadOf2Lines(ap1,ap2,ap3);
a := abs(a);
if a > pi then a := 2*pi-a;
a := a * (180/pi);
result := Trunc(a*10)/10;
end;
function TAngleLine.GetClassName: String;
begin
Result := 'AngleLine';
end;
function TAngleLine.ShadowClick(ClickIndex: Integer; x,
y: Double): Boolean;
begin
result := inherited ShadowClick(ClickIndex,x,y);
result := false;
if clickIndex = 3 then result := True;
end;
{ TCalibrate }
class function TCalibrate.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
var cad: TPCDrawing;
begin
cad := TPCDrawing(aOwner);
cad.CalibrateLayerScale(Shadow.ap1,Shadow.ap2,CalibrateUnit);
result := nil;
end;
class function TCalibrate.CreateShadow(x, y: Double): TFigure;
begin
CreateShadow := TCalibrate.create(DoublePoint(x,y),DoublePoint(x,y));
end;
procedure TCalibrate.draw(DEngine: TPCDrawEngine; isGrayed: Boolean);
var xp1,xp2,xp3,xp4: TDoublePoint;
u: string;
begin
//CalibrateUnit: Byte = 0; // 0=nm 1=mm 2=cm 3=dm 4=m 5=km
case calibrateUnit of
0: u := 'nm';
1: u := 'mm';
2: u := 'cm';
3: u := 'dm';
4: u := 'm';
5: u := 'km';
end;
DEngine.Canvas.pen.mode := pmXor;
DEngine.drawline(ap1.x,ap1.y,ap2.x,ap2.y,clLime,1,ord(psSolid),0);
GetParallelPoints(ap1,ap2,xp1,xp2,4);
GetParallelPoints(ap1,ap2,xp3,xp4,-4);
DEngine.drawline(xp1.x,xp1.y,xp3.x,xp3.y,clLime,1,ord(psSolid),0);
DEngine.drawline(xp2.x,xp2.y,xp4.x,xp4.y,clLime,1,ord(psSolid),0);
if not EQDP(ap1,ap2) then begin
Dengine.TraceText(Mpoint(ap1,ap2),clLime,'1 '+u,'Tahoma',8);
end;
end;
procedure TBMPObject.RelocatePoints;
var xp:TDoublePOint;
begin
if (ap1.x > ap2.x) then begin
xp := ap1;
actualpoints[1] := ap2;
actualpoints[2] := xp;
xp := ap3;
actualpoints[3] := ap4;
actualpoints[4] := xp;
ImageEdited := True; // Tolik 20/04/2018 --
end;
if (ap1.y > ap4.y) then begin
xp := ap1;
actualpoints[1] := ap4;
actualpoints[4] := xp;
xp := ap2;
actualpoints[2] := ap3;
actualpoints[3] := xp;
ImageEdited := True; // Tolik 20/04/2018 --
end;
end;
procedure TPolyline.RoundCornerByArc(SeqNbr: Integer; Rad: Double);
var xp1,xp2: TDoublePoint;
np1,np2: TDoublePoint;
begin
if (rad > 0) and (PointCOunt > 2) then begin
xp1 := ActualPoints[SeqNbr];
if SeqNbr = PointCount then
xp2 := ActualPoints[1]
else
xp2 := ActualPoints[SeqNbr+1];
np1 := MPoint(xp1,xp2,rad);
if SeqNbr = 1 then
xp2 := ActualPoints[PointCount]
else
xp2 := ActualPoints[SeqNbr-1];
np2 := MPoint(xp1,xp2,rad);
InsertKnot(SeqNbr,np1);
ActualPoints[SeqNbr] := np2;
ArrangeSegment(SeqNbr,sArc);
end;
end;
function TBMPObject.DoMagicWand(x, y: Double): TFigure;
var points: TDoublePointArr;
pLine: TPolyline;
Closed: Boolean;
begin
result := nil;
if isPointIn(x,y) then begin
CreateMWPath(x,y,0.3,points,Closed);
if Length(Points) > 0 then begin
pLine := TPolyline.create(points,2,ord(psSOlid),clBlack,ord(bsClear),clWhite,0,True,LayerHandle,mydsNormal,Owner);
result := pLine;
end;
end;
end;
function TFigure.ShadowKeyStroke(var ClickIndex,KeyCode: Integer;
Shift: TShiftState;var Fnished: Boolean): Boolean;
begin
result := false;
Fnished := False;
end;
function TPolyline.ShadowKeyStroke(var ClickIndex, KeyCode: Integer;
Shift: TShiftState; var Fnished: Boolean): Boolean;
var lx,ly,dx,dy: Double;
xp1,xp2: TDoublePoint;
horz: Boolean;
Procedure NewPoint;
begin
if not EQD(lx,ly) then begin
PointCount := PointCount+1;
ClickIndex := ClickIndex+1;
actualPoints[PointCount] := actualPoints[PointCount-1];
end;
end;
begin
dx := 0;
dy := 0;
xp1 := ActualPoints[PointCount-1];
xp2 := ActualPoints[PointCount];
lx := xp2.x-xp1.x;
ly := xp2.y-xp1.y;
horz := abs(lx) > abs(ly);
if KeyCode = VK_LEFT then begin
result := true;
dx := -1;
if (not horz) then begin
NewPoint;
end;
end else if KeyCode = VK_RIGHT then begin
result := true;
dx := 1;
if not horz then begin
NewPoint;
end;
end else if KeyCode = VK_UP then begin
result := true;
dy := -1;
if horz then begin
NewPoint;
end;
end else if KeyCode = VK_DOWN then begin
result := true;
dy := 1;
if horz then begin
NewPoint;
end;
end else if (KeyCode = VK_RETURN) then begin
NewPoint;
if (ssCtrl in Shift) and (PointCount > 3) then begin
ActualPoints[PointCount-1] := ap1;
dx := ActualPoints[PointCount-1].x- ActualPoints[PointCount-2].x;
dy := ActualPoints[PointCount-1].y- ActualPoints[PointCount-2].y;
xp1 := ActualPoints[PointCount-2];
if abs(dx) > abs(dy) then begin
ActualPoints[PointCount-2] := DoublePOint(xp1.x,ap1.y);
end else begin
ActualPoints[PointCount-2] := DoublePOint(ap1.x,xp1.y);
end;
end;
PointCount := PointCount+1;
result := true;
fnished := True;
exit;
end;
ActualPoints[PointCount] := DoublePoint(ActualPoints[PointCount].x+dx,ActualPoints[PointCount].y+dy);
end;
procedure TFigure.SetModified;
begin
Modified := True;
end;
procedure TPolyline.HatchBySegment(SegIdx: Integer; Distance: Double);
var xp1,xp2,lp1,lp2: TDoublePoint;
xRect: TDoubleRect;
dist,mlen: Double;
cnt : Integer;
begin
SetLength(HatchLines,0);
if not closed then exit;
HatchSeg := SegIdx;
HatchDist := Distance;
xRect := Self.GetBoundRect;
mLen := GetLineLength(DoublePoint(xRect.left,xRect.top),DoublePoint(xRect.right,xRect.bottom));
xp1 := ActualPoints[SegIdx];
xp2 := ActualPoints[SegIdx+1];
ExtendLine(xp1,xp2,mLen);
cnt := 2;
SetLength(HatchLines,cnt);
HatchLines[cnt-2] := xp1;
HatchLines[cnt-1] := ActualPoints[SegIdx];
cnt := cnt+2;
SetLength(HatchLines,cnt);
HatchLines[cnt-2] := xp2;
HatchLines[cnt-1] := ActualPoints[SegIdx+1];
repeat
dist := dist+distance;
GetParallelPoints(xp1,xp2,lp1,lp2,dist);
cnt := cnt+2;
SetLength(HatchLines,cnt);
HatchLines[cnt-2] := lp1;
HatchLines[cnt-1] := lp2;
until abs(dist) > mLen;
dist := 0;
distance := -distance;
repeat
dist := dist+distance;
GetParallelPoints(xp1,xp2,lp1,lp2,dist);
cnt := cnt+2;
SetLength(HatchLines,cnt);
HatchLines[cnt-2] := lp1;
HatchLines[cnt-1] := lp2;
until abs(dist) > mLen;
end;
procedure TPolyline.RemoveHatch;
begin
SetLength(HatchLines,0);
HatchSeg := -1;
end;
procedure TFigure.Scale(px, py: Double);
begin
Scale(px,py,CenterPoint);
end;
procedure TFigure.Unfilled;
begin
brs := ord(bsClear);
end;
function TFigure.DuplicateAsStroke: TFigure;
var
Layer: TLayer;
acolor : TColor;
a,i,k : integer;
TestX,TestY1,TestY2,Z: Double;
TopY : boolean;
lMult: integer;
points: TDoublePointArr;
xlen: Double;
nLen,nH: Integer;
pt: TPoint;
typ: Byte;
PointArr:array of TPoint;
TypeArr: array of Byte;
Dengine: TPCDrawEngine;
pCnt,kCnt: Integer;
fCnt: Integer;
fClosed: Boolean;
pArr: TDoublePointArr;
Segments: TList;
plSegment,dSegment: TPLSegment;
x,y: Double;
dp: TDoublePOint;
bezIndex: Integer;
grp: TFigureGrp;
pl: TPolyline;
begin
if assigned(owner) then begin
Dengine := TPCDrawing(Owner).Dengine;
end else exit;
Segments := TList.Create;
BeginPath(DEngine.Canvas.Handle);
Draw(Dengine,false);
EndPath(DEngine.Canvas.Handle);
WidenPath(DEngine.Canvas.Handle);
SetLength(PointArr,1000);
SetLength(TypeArr,1000);
pCnt := GetPath(DEngine.Canvas.Handle,PointArr,TypeArr,0);
SetLength(PointArr,pCnt);
SetLength(TypeArr,pCnt);
pCnt := GetPath(DEngine.Canvas.Handle,PointArr[0],TypeArr[0],pcnt);
fCnt := 0;
kCnt := 0;
bezIndex := 0;
grp := TFigureGrp.create(LayerHandle,Owner);
for i:= 0 to pcnt-1 do
begin
pt := PointArr[i];
x := pt.x;
y := pt.y;
z := 0;
Dengine.DeConvertPoint(x,y,z);
dp := DoublePOint(x,y);
typ := TypeArr[i];
Case typ of
PT_LINETO or PT_CLOSEFIGURE:
begin
fClosed := True;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
plSegment := TPlSegment.Create(0,sLine,dp,dp);
Segments.Add(plSegment);
end;
PT_BEZIERTO or PT_CLOSEFIGURE:
begin
fClosed := True;
bezIndex := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
PT_LINETO:
begin
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
plSegment := TPlSegment.Create(0,sLine,dp,dp);
Segments.Add(plSegment);
end;
PT_BEZIERTO:
begin
bezIndex := BezIndex+1;
if bezIndex = 1 then begin
plSegment := TPlSegment.Create(0,sCurve,dp,dp);
Segments.Add(plSegment);
end else if bezIndex = 2 then begin
plSegment.Cpoint2 := dp;
end else if BezIndex = 3 then begin
bezIndex := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
end;
PT_MOVETO: begin
fcnt := fcnt+1;
if fcnt > 1 then begin
pl := TPolyline.create(parr,width,ord(psSolid),color,ord(bsClear),color,
0,fClosed,LayerHandle,mydsNormal,owner);
grp.AddFigure(pl);
try
for k := 0 to Segments.Count-1 do
begin
plSegment := TPLSegment(Segments[k]);
if plSegment.SType = sCurve then begin
dSegment := TPLSegment(pl.Segments[k]);
dSegment.SType := sCurve;
dSegment.CPoint1 := plSegment.CPoint1;
dSegment.CPoint2 := plSegment.CPoint2;
end;
plSegment.free;
end;
Segments.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.DuplicateAsStroke' + E.Message);
end;
end;
fClosed := false;
kCnt := 0;
kCnt := kCnt+1;
SetLength(pArr,kCnt);
pArr[kCnt-1] := dp;
end;
end;
end;
if kcnt > 0 then begin
pl := TPolyline.create(parr,width,ord(psSolid),color,ord(bsClear),color,
0,fClosed,LayerHandle,mydsNormal,owner);
grp.AddFigure(pl);
try
for k := 0 to Segments.Count-1 do
begin
plSegment := TPLSegment(Segments[k]);
if plSegment.SType = sCurve then begin
dSegment := TPLSegment(pl.Segments[k]);
dSegment.SType := sCurve;
dSegment.CPoint1 := plSegment.CPoint1;
dSegment.CPoint2 := plSegment.CPoint2;
end;
plSegment.free;
end;
Segments.Clear;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TFigure.DuplicateAsStroke' + E.Message);
end;
end;
Segments.Free;
if assigned(pl) then result := grp else begin
grp.DestroyInFigures;
grp.Destroy;
end;
end;
{ TFigureFill }
procedure TFigureFill.BuildGradient;
var xColor: TColor;
begin
GradBmp := Tbitmap.Create;
GradBmp.PixelFormat := pf24bit;
xColor := clWhite;
if BackColor <> clNone then xColor := BackColor;
MakeGradBitmap(xColor,Color,GradStyle,GradBmp);
end;
procedure TFigureFill.BuildHatch;
var rect: TDoubleRect;
done: Boolean;
rp1,rp2,rp3,rp4: TDoublePoint;
p1,p2,p3,p4: TDoublePoint;
op1,op2,op3,op4: TDoublePoint;
maxVal1: Double;
maxVal2: Double;
maxField1: PDouble;
maxField2: PDouble;
Line: TFigure;
FRect: TRectangle;
dx1,dy1: Double;
dx2,dy2: Double;
xStep,bStep: Double;
xp1,xp2,xp3,xp4,tp1,tp2,tp3,tp4: TDoublePoint;
ccnt,i,row: Integer;
Style: THatchStyle;
begin
Style := HatchStyle;
if Style = hsNone then exit;
Grp := TfigureGrp.create(Owner.LayerHandle,owner.owner);
rect := Owner.GetBoundRect;
done := false;
rp1 := DoublePoint(rect.Left,rect.top);
rp2 := DoublePoint(rect.Right,rect.top);
rp3 := DoublePoint(rect.Right,rect.bottom);
rp4 := DoublePoint(rect.Left,rect.bottom);
rp2 := MPoint(rp2,rp1,-Step*2);
rp3 := MPoint(rp3,rp4,-Step*2);
rp3 := MPoint(rp3,rp2,-Step*2);
rp4 := MPoint(rp4,rp1,-Step*2);
xStep := Step;
if Style in [hsLDiagonal,hsRDiagonal,hsDCross,hsDCheckered,hsDBricks] then
begin
xStep := Sqrt(2)*Step;
end;
case Style of
hsHorizontal:
begin
p1 := rp1;
p2 := rp2;
maxVal1 := rp3.y;
maxField1 := @(p1.y);
dx1 := 0;
dy1 := xStep;
end;
hsHBricks:
begin
p1 := MovePoint(rp1,0,-Step);
p2 := MovePoint(rp2,0,-Step);;
maxVal1 := rp3.y;
maxField1 := @(p1.y);
dx1 := 0;
dy1 := xStep;
end;
hsVertical,hsVBricks:
begin
p1 := rp1;
p2 := rp4;
maxVal1 := rp3.x;
maxField1 := @(p1.x);
dx1 := xStep;
dy1 := 0;
end;
hsCross:
begin
p1 := rp1;
p2 := rp2;
p3 := rp1;
p4 := rp4;
maxVal1 := rp3.y;
maxField1 := @(p1.y);
maxVal2 := rp3.x;
maxField2 := @(p3.x);
dx1 := 0;
dy1 := xStep;
dx2 := xStep;
dy2 := 0;
end;
hsRDiagonal:
begin
p1 := rp1;
p2 := MovePoint(rp4,-1*abs(rp1.y-rp4.y),0);
maxVal1 := rp3.x;
maxField1 := @(p2.x);
dx1 := xStep;
dy1 := 0;
end;
hsLDiagonal:
begin
p1 := MovePoint(rp1,-1*abs(rp1.y-rp4.y),0);
p2 := rp4;
maxVal1 := rp3.x;
maxField1 := @(p1.x);
dx1 := xStep;
dy1 := 0;
end;
hsDCross:
begin
p1 := rp1;
p2 := MovePoint(rp4,-1*abs(rp1.y-rp4.y),0);
p3 := MovePoint(rp1,-1*abs(rp1.y-rp4.y),0);
p4 := rp4;
maxVal1 := rp3.x;
maxField1 := @(p2.x);
maxVal2 := rp3.x;
maxField2 := @(p3.x);
dx1 := xStep;
dy1 := 0;
dx2 := xStep;
dy2 := 0;
end;
hsCheckered:
begin
p1 := rp1;
p2 := rp4;
maxVal1 := rp3.x;
maxField1 := @(p1.x);
dx1 := xStep;
dy1 := 0;
end;
hsDCheckered,hsDBricks:
begin
p1 := rp1;
p2 := MovePoint(rp4,-1*abs(rp1.y-rp4.y),0);
maxVal1 := rp3.x;
maxField1 := @(p2.x);
dx1 := xStep;
dy1 := 0;
end;
end;
op1 := p1;
op2 := p2;
op3 := p3;
op4 := p4;
row := 0;
repeat
p1 := MovePoint(p1,dx1,dy1);
p2 := MovePoint(p2,dx1,dy1);
if Style in [hsCheckered,hsDCheckered] then begin
ccnt := Trunc(GetLineLength(p1,p2) / Step) + 2;
row := row+1;
for i := 1 to cCnt do
begin
if (odd(i) and odd(row)) then begin
tp1 := MPoint(p1,p2,Step*(i-1));
tp2 := MPoint(p1,p2,Step*(i));
GetParallelPoints(tp1,tp2,tp4,tp3,Step);
FRect := TRectangle.create(0,0,0,0,1,ord(psClear),Color,ord(bsSolid),color,0,mydsNormal,Owner.Owner);
FRect.ActualPoints[1] := tp1;
FRect.ActualPoints[2] := tp2;
FRect.ActualPoints[3] := tp3;
FRect.ActualPoints[4] := tp4;
FRect.NativeFill := True;
grp.AddToGrp(FRect);//28.04.2011 grp.InFigures.Add(FRect);
tp1 := tp2;
tp2 := MPoint(p1,p2,Step*(i+1));
GetParallelPoints(tp1,tp2,tp1,tp2,Step);
GetParallelPoints(tp1,tp2,tp4,tp3,Step);
FRect := TRectangle.create(0,0,0,0,1,ord(psClear),Color,ord(bsSolid),color,0,mydsNormal,Owner.Owner);
FRect.ActualPoints[1] := tp1;
FRect.ActualPoints[2] := tp2;
FRect.ActualPoints[3] := tp3;
FRect.ActualPoints[4] := tp4;
FRect.NativeFill := True;
grp.AddToGrp(FRect); //28.04.2011 grp.InFigures.Add(FRect);
end;
end;
end else if Style in [hsHBricks,hsVBricks,hsDBricks] then begin
bStep := Step*1.9;
ccnt := Trunc(GetLineLength(p1,p2) / bStep) + 2;
row := row+1;
for i := 1 to cCnt do
begin
if (odd(i) and odd(row)) then begin
tp1 := MPoint(p1,p2,bStep*(i-1));
tp2 := MPoint(p1,p2,bStep*(i));
GetParallelPoints(tp1,tp2,tp4,tp3,Step);
Line := TLine.Create(tp2.x,tp2.y,tp3.x,tp3.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
Line := TLine.Create(tp4.x,tp4.y,tp1.x,tp1.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
tp1 := MPoint(tp2,tp1,bStep/2);
tp2 := MPoint(tp1,p2,bStep);
GetParallelPoints(tp1,tp2,tp1,tp2,Step);
GetParallelPoints(tp1,tp2,tp4,tp3,Step);
Line := TLine.Create(tp2.x,tp2.y,tp3.x,tp3.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
Line := TLine.Create(tp4.x,tp4.y,tp1.x,tp1.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
end;
Line := TLine.Create(p1.x,p1.y,p2.x,p2.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
end;
end else begin
Line := TLine.Create(p1.x,p1.y,p2.x,p2.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
end;
done := maxfield1^ > (maxval1+(2*xStep));
if Style in [hsCross,hsDCross] then begin
p3 := MovePoint(p3,dx2,dy2);
p4 := MovePoint(p4,dx2,dy2);
Line := TLine.Create(p3.x,p3.y,p4.x,p4.y,1,ord(psSolid),Color,0,0,mydsNormal,Owner.Owner);
grp.AddToGrp(Line); //28.04.2011 grp.InFigures.Add(Line);
done := done and (maxfield2^ > (maxval2+(2*xStep)));
end;
until done;
end;
procedure TFigureFill.BuildTexture;
var xBmp: TBitmap;
rect: TDoubleRect;
w,h: Double;
c,r,i,k,x,y: Integer;
rt: Integer;
begin
xBmp := GetTextureBitmap(ord(TextureStyle));
TxtBmp := TBitmap.Create;
rect := Owner.GetBoundRect;
w := abs(rect.right-rect.left);
h := abs(rect.bottom-rect.top);
if TxtSize <= 1 then begin
rt := 6;
end else if TxtSize = 2 then begin
rt := 4;
end else if TxtSize >= 3 then begin
rt := 3;
end;
TxtBmp.Width := Round(w*rt);
TxtBmp.Height := Round(h*rt);
c := (TxtBmp.Width div xBmp.Width)+1;
r := (TxtBmp.Height div xBmp.Height)+1;
for i := 0 to r-1 do begin
for k := 0 to c-1 do begin
x := k*(xbmp.Width);
y := i*(xbmp.Height);
TxtBmp.Canvas.Draw(x,y,xBmp);
end;
end;
xBmp.Free;
end;
procedure TFigureFill.Clear;
begin
Empty := True;
if assigned(grp) then begin
grp.Free;
grp := nil;
end;
if assigned(GradBmp) then begin
GradBmp.Free;
GradBmp := nil;
end;
if assigned(TxtBmp) then begin
TxtBmp.Free;
TxtBmp := nil;
end;
end;
constructor TFigureFill.Create(AOwner:TFigure;FStep:Double;FType:TFillType;Data:Integer);
begin
inherited Create;
Owner := AOwner;
Step := FStep;
TxtSize := Round(FStep);
FillType := FType;
Grp := nil;
GradBmp := nil;
//Tolik
TxtBmp:= nil;
//
Color := AOwner.Brc;
PenStyle := psSolid;
PenWidth := 1;
SetSubData(data);
Empty := True;
BackColor := clNone;
end;
destructor TFigureFill.Destroy;
begin
//Tolik
if GradBmp <> nil then
GradBmp.Free;
if TxtBmp <> nil then
TxtBmp.Free;
//
if GRP <> nil then
Grp.Free;
inherited Destroy;
end;
procedure TFigureFill.Draw(DEngine: TPCDrawEngine;isGrayed:Boolean);
var Rect: TDoubleRect;
p1,p2,p3,p4: TDoublePoint;
begin
if Empty then ReGenerate;
if FillType = fsHatch then
begin
rect := Owner.GetBoundRect;
if BackColor <> clNone then
Dengine.FillRect(Rect,BackColor,ord(bsSolid));
if assigned(grp) then grp.draw(Dengine,isGrayed);
end
else
if FillType = fsSolid then
begin
rect := Owner.GetBoundRect;
// Tolik 03/09/2019 --
if GCadForm <> nil then
begin
if GCadForm.tbShowTransparency.Down then
Dengine.FillRect(Rect,Color,ord(bsSolid), Owner.Transparency)
else
Dengine.FillRect(Rect,Color,ord(bsSolid), 0);
end
else
Dengine.FillRect(Rect,Color,ord(bsSolid), 0);
// Tolik 26/06/2017
{if GCadForm.tbShowTransparency.Down then
Dengine.FillRect(Rect,Color,ord(bsSolid), Owner.Transparency)
else
Dengine.FillRect(Rect,Color,ord(bsSolid), 0);}
//
end
else
if FillType = fsGradient then
begin
rect := Owner.GetBoundRect;
p1 := DoublePoint(rect.Left,rect.top);
p2 := DoublePoint(rect.right,rect.top);
p3 := DoublePoint(rect.right,rect.bottom);
p4 := DoublePoint(rect.Left,rect.bottom);
if assigned(GradBmp) then
DEngine.DrawBitmap(p1,p2,p3,p4,clWhite,1,ord(psClear),False,GradBmp);
end
else
if FillType = fsTexture then
begin
rect := Owner.GetBoundRect;
p1 := DoublePoint(rect.Left,rect.top);
p2 := DoublePoint(rect.right,rect.top);
p3 := DoublePoint(rect.right,rect.bottom);
p4 := DoublePoint(rect.Left,rect.bottom);
if assigned(TxtBmp) then DEngine.DrawBitmap(p1,p2,p3,p4,clWhite,1,ord(psClear),False,TxtBmp);
end;
end;
procedure TFigureFill.Move(dx, dy: Double);
begin
if assigned(grp) then begin
grp.move(dx,dy);
end;
end;
procedure TFigureFill.ReGenerate;
begin
if assigned(grp) then begin
grp.Free;
grp := nil;
end;
if assigned(GradBmp) then begin
GradBmp.Free;
GradBmp := nil;
end;
if assigned(TxtBmp) then begin
TxtBmp.Free;
TxtBmp := nil;
end;
Empty := True;
if FillType in [fsNone,fsSolid] then begin
Empty := False;
exit;
end;
if FillType = fsHatch then begin
Empty := False;
BuildHatch;
end else if FillType = fsGradient then begin
Empty := False;
BuildGradient;
end else if FillType = fsTexture then begin
Empty := False;
BuildTexture;
end;
end;
procedure TFigure.RefreshHatch;
begin
if assigned(Fill) then Fill.ReGenerate;
end;
procedure TFigureFill.Rotate(Angle: Double; cPoint: TDoublePoint);
begin
end;
procedure TFigureFill.Scale(px, py: Double; rPoint: TDoublePoint);
begin
end;
procedure TFigureFill.SetBackColor(BColor: TColor);
begin
if BackColor <> BColor then begin
BackColor := BColor;
if FillType = fsGradient then begin
Clear;
end;
end;
end;
procedure TFigureFill.SetColor(FColor: TColor);
begin
if Color <> FColor then begin
Color := FColor;
if assigned(Grp) then Grp.ModifySelection(mmPenColor,Color);
if assigned(Grp) then Grp.ModifySelection(mmBrushColor,Color);
if FillType = fsGradient then begin
Clear;
end;
end;
end;
procedure TFigureFill.SetHatchStep(FStep: Double);
begin
if (FillType = fsHatch) and (FStep <> Step) then Clear;
Step := FStep;
end;
procedure TFigureFill.SetPen(pStyle: TPenStyle; pWidth: Integer);
begin
if (PenStyle <> pStyle) or (PenWidth <> pWidth) then begin
PenStyle := PStyle;
PenWidth := PWidth;
if assigned(Grp) then Grp.ModifySelection(mmPenStyle,ord(PenStyle));
if assigned(Grp) then Grp.ModifySelection(mmPenWidth,ord(PenWidth));
end;
end;
procedure TFigureFill.SetStyle(FType: TFillType;Data:Integer);
begin
if FillType <> FType then begin
FillType := FType;
SetSubData(Data);
Clear;
end else if FillType = fsHatch then begin
if HatchStyle <> THatchStyle(Data) then begin
SetSubData(Data);
Clear;
end;
end else if FillType = fsGradient then begin
if GradStyle <> TGradStyle(Data) then begin
SetSubData(Data);
Clear;
end;
end else if FillType = fsTexture then begin
if TextureStyle <> TTextureStyle(Data) then begin
SetSubData(Data);
Clear;
end;
end;
end;
procedure TFigure.DrawFill(DEngine: TPCDrawEngine; isGrayed: Boolean);
var fType: TFillType;
hStyle:THatchStyle;
gStyle: TGradStyle;
sData: Integer;
abrc: integer;
begin
// if assigned(owner) and (TPCdrawing(Owner).NativeFill = false) and (NativeFill = False) and (brs <> ord(bsClear)) and (RegHandle <> 0) and (DrawStyle = mydsNormal) then begin
if assigned(owner) and (TPCdrawing(Owner).NativeFill = false) and (NativeFill = False) and (brs <> ord(bsClear)) {and (RegHandle <> 0)} and (DrawStyle = mydsNormal) then
begin
if RegHandle = 0 then
begin
if RegObject <> nil then
if RegObject.RegObjData <> nil then
begin
RegHandle := ExtCreateRegion(nil,RegObject.RegObjDataLength, RegObject.RegObjData^);
end;
end;
if RegHandle <> 0 then
begin
FType := GetFillType(brs);
SData := 0;
if fType = fsHatch then begin
if brs = bsExHatch then
SData := ord(ExHatchStyle)
else
SData := ord(GetHatchStyle(brs));
end else if fType = fsGradient then begin
if brs = bsExGrad then
SData := ord(ExGradStyle)
else
SData := ord(GetGradStyle(brs));
end else if fType = fsTexture then begin
if brs = bsExTexture then
SData := ord(ExTextureStyle)
else
SData := ord(GetTextureStyle(brs));
end;
if not assigned(Fill) then begin
Fill := TFigureFill.Create(Self,ExHatchStepSize,fType,SData);
end;
Fill.SetStyle(fType,SData);
//Tolik 02/11/2021 --
abrc := brc;
if isGrayed then
abrc := GCadForm.PCad.FGrayedColor;
//Fill.SetColor(brc);
Fill.SetColor(abrc);
//
Fill.SetHatchStep(ExHatchStepSize);
Fill.SetTextSize(ExTextureSize);
Fill.SetBackColor(ExFillBackColor);
Fill.SetPen(psSolid,1);
//Tolik
if RegHandle = 0 then
begin
if RegObject <> nil then
begin
if RegObject.RegObjData <> nil then
begin
RegHandle := ExtCreateRegion(nil,RegObject.RegObjDataLength, RegObject.RegObjData^);
if RegHandle <> 0 then
begin
if RegObject.RegObjData <> nil then
begin
GlobalFreePtr(RegObject.RegObjData);
RegObject.RegObjData := nil;
end;
end;
RegObject.Free;
end;
end;
end;
Dengine.ClipAnd(RegHandle);
//
Fill.Draw(Dengine,isGrayed);
Dengine.ClipBack;
GetRegObject;
if RegObject <> nil then
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := true;
DeleteObject(RegHandle);
RegHandle := 0;
end;
end;
end;
function TFigure.GdiBrs: Integer;
begin
if (not assigned(owner)) or NativeFill or (TPCdrawing(Owner).NativeFill) then begin
result := brs;
end else begin
result := ord(bsClear);
end;
end;
procedure TFigure.ClearClipFigures;
var a:Integer;
Figure:TFigure;
begin
for a := 0 to ClipFigures.Count-1 do begin
TFigure(ClipFigures[a]).InClip := False;
end;
ClipFigures.Clear;
end;
//!!!!!!!!
// Âîò òóò õåð åãî çíàåò ... ìîæ íå ñðàçó õåíäëû êèëÿòü, à ïîñëå îòðèñîâêè âñåõ êëèïîâ...? ïîêà õç...
procedure TFigure.DrawClipFigures(DEngine: TPCDrawEngine;
isGrayed: Boolean);
var i: Integer;
begin
{
if (ClipFigures.Count > 0) and (RegHandle <> 0) then begin
For i := 0 to ClipFigures.Count - 1 do
begin
if TPowercad(Owner).Figures.IndexOf(ClipFigures[i]) = -1 then begin
end
else
begin
Dengine.Clip(RegHandle);
if TFigure(ClipFigures[i]) is TBmpObject then begin
//TBmpObject(ClipFigures[i]).ClpRgn := RegHandle;
end;
TFigure(ClipFigures[i]).Draw(Dengine,isGrayed);
Dengine.Clip(0);
end;
end;
end; }
if (ClipFigures.Count > 0) then
begin
if RegHandle = 0 then
begin
if RegObject <> nil then
if RegObject.RegObjData <> nil then
begin
RegHandle := ExtCreateRegion(nil, RegObject.RegObjDataLength, RegObject.RegObjData^);
end;
end;
if RegHandle <> 0 then
begin
For i := 0 to ClipFigures.Count - 1 do
begin
if TPowercad(Owner).Figures.IndexOf(ClipFigures[i]) = -1 then begin
end
else
begin
Dengine.Clip(RegHandle);
if TFigure(ClipFigures[i]) is TBmpObject then begin
//TBmpObject(ClipFigures[i]).ClpRgn := RegHandle;
end;
TFigure(ClipFigures[i]).Draw(Dengine,isGrayed);
Dengine.Clip(0);
end;
end;
GetRegObject;
if TBrushStyle(brs) <> bsClear then
RegObject.CheckPointByRects := True
else
RegObject.CheckPointByRects := False;
DeleteObject(Reghandle);
RegHandle := 0;
end;
end;
end;
procedure TFigure.MoveClipFigures(deltax, deltaY: Double);
var i:Integer;
begin
For i := 0 to ClipFigures.Count-1 do
TFigure(ClipFigures[i]).Move(deltaX,deltaY);
end;
function TFigure.NeedRegion: Boolean;
begin
result := (regHandle = 0) and (DrawStyle = mydsNormal) and (NativeFill = False) and
assigned(owner) and (TPCdrawing(Owner).NativeFill = false) and
((ClipFigures.Count > 0) or (brs <> ord(bsClear)));
end;
procedure TFigureFill.SetSubData(Data: Integer);
begin
if FillType = fsHatch then
begin
HatchStyle := THatchStyle(Data);
end
else
if FillType = fsGradient then
begin
GradStyle := TGradStyle(Data);
end
else
if FillType = fsTexture then
begin
TexturesTYLE := TTextureStyle(Data);
end;
end;
procedure TFigure.SetGradient(GStyle: TGradStyle; ForeColor,
BackColor: TColor);
begin
brs := bsExGrad;
ExGradStyle := GStyle;
brc := ForeColor;
ExFillbackColor := BackColor;
end;
procedure TFigure.SetHatch(HStyle: THatchStyle; ForeColor,
BackColor: TColor; StepSize: Double);
begin
brs := bsExHatch;
ExHatchStyle := HStyle;
brc := ForeColor;
ExFillbackColor := BackColor;
ExHatchStepSize := StepSize;
end;
procedure TFigure.SetTexture(TStyle: TTextureStyle; TexSize: Integer);
begin
brs := bsExTexture;
ExTextureStyle := TStyle;
ExTextureSize := TexSize;
end;
procedure TFigureFill.SetTextSize(TxSize: Integer);
begin
if (FillType = fsTexture) and (TxSize <> TxtSize) then Clear;
TxtSize := TxSize;
end;
procedure TArc.Scale(percentx, percenty: Double; rPoint: TDoublePoint);
var
p1,p2:TDoublePoint;
cp: TDoublePOint;
Begin
// cp := ap1;
Inherited;
// p1 := DoublePoint(cp.x+Alen,cp.y);
// p2 := DoublePoint(cp.x,cp.y+Blen);
// p1 := RotatePoint(cp,p1,Angle);
// p2 := RotatePoint(cp,p2,Angle);
// p1 := ScalePoint(rPoint,p1,percentx,percenty);
// p2 := ScalePoint(rPoint,p2,percentx,percenty);
// ALen := GetLineLenght(ap1,p1);
// Blen := GetLineLenght(ap1,p2);
end;
{ TPrintRect }
class function TPrintRect.CreateFromShadow(aOwner: TComponent;
LHandle: Integer; Shadow: TFigure): TFigure;
begin
Result := nil;
TPCDrawing(aOwner).Settool(toSelect,'',0);
{cad := TPCDrawing(aOwner);
Result := TRectangle.create(Shadow.ap1.x,Shadow.ap1.y,
Shadow.ap3.x,Shadow.ap3.y,
cad.DefaultPenWidth,
ord(cad.DefaultPenStyle),
cad.DefaultPenColor,
ord(cad.DefaultBrushStyle),
cad.DefaultBrushColor,
LHandle,
mydsNormal,aOwner);}
if Shadow.ap1.x < Shadow.ap3.x then
begin
if Shadow.ap1.y < Shadow.ap3.y then
TPCDrawing(aOwner).PrintRectPreview(DoubleRect(Shadow.ap1.x, Shadow.ap1.y, Shadow.ap3.x, Shadow.ap3.y))
else
TPCDrawing(aOwner).PrintRectPreview(DoubleRect(Shadow.ap1.x, Shadow.ap3.y, Shadow.ap3.x, Shadow.ap1.y));
end
else
begin
if Shadow.ap1.y < Shadow.ap3.y then
TPCDrawing(aOwner).PrintRectPreview(DoubleRect(Shadow.ap3.x, Shadow.ap1.y, Shadow.ap1.x, Shadow.ap3.y))
else
TPCDrawing(aOwner).PrintRectPreview(DoubleRect(Shadow.ap3.x, Shadow.ap3.y, Shadow.ap1.x, Shadow.ap1.y));
end;
end;
{procedure TFigure.getboundsWithoutGrpSize(var figMaxX, figMaxY, figMinX,
figMinY: Double);
begin
end; }
initialization
plps0 := ord(psCorner);
plps1 := ord(psCurve);
plps2 := ord(psCurveCorner);
{$ifdef demo}
if not delphiloaded then application.terminate;
{$endif demo}
ClassIndexes := TStringList.Create;
ClassIndexes.Sorted := true;
ClassIndexes.AddObject('TOrthoLine', TObject(01));
ClassIndexes.AddObject('TConnectorObject', TObject(02));
ClassIndexes.AddObject('TTextMod', TObject(03));
ClassIndexes.AddObject('TFigureGrpMod', TObject(04));
ClassIndexes.AddObject('TFigureGrpNotMod', TObject(05));
ClassIndexes.AddObject('TFrame', TObject(06));
ClassIndexes.AddObject('TSCSHDimLine', TObject(07));
ClassIndexes.AddObject('TSCSVDimLine', TObject(08));
ClassIndexes.AddObject('TRichTextMod', TObject(09));
ClassIndexes.AddObject('TCabinet', TObject(10));
ClassIndexes.AddObject('TCabinetExt', TObject(11));
ClassIndexes.AddObject('TCabinetNumber', TObject(12));
ClassIndexes.AddObject('TPlanObject', TObject(13));
ClassIndexes.AddObject('TPlanConnector', TObject(14));
ClassIndexes.AddObject('TPlanTrace', TObject(15));
ClassIndexes.AddObject('TCadNorms', TObject(16));
ClassIndexes.AddObject('TSCSFigureGrp', TObject(17));
ClassIndexes.AddObject('THouse', TObject(18));
ClassIndexes.AddObject('TApproach', TObject(19));
ClassIndexes.AddObject('TFigureGrp', TObject(20));
finalization
ClassIndexes.Free;
end.
Reference in New Issue View Git Blame Copy Permalink