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

5054 lines
138 KiB
ObjectPascal
Raw Blame History

unit PCDrawBox;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
U_Common_Classes, ExtCtrls, PCPanel,PCScrollbar,math,PCTypesUtils,PaintBoxExt,StdCtrls,DrawEngine,DrawObjects;
type
TGuideLine = class(TMyObject)
gType : TGuideType;
coord : Double;
fautoCr: boolean;
constructor create(aType: TGuideType; aCoord: Double; autoCr: boolean = False);
destructor destroy;
Procedure WriteToStream(Stream: TStream);
Class Function CreateFromStream(Stream: TStream): TGuideLine;
end;
TScrollValuesEvent = Procedure (Sender:TObject;ScHorzMAx,scVertMax,scHorzPos,scVertPos,scHorzPage,scVertPage,sChange,lChange:Integer) of Object;
TCursorEvent = Procedure (Sender:TObject;Cursor:TCursor) of Object;
TCustomTraceEvent = Procedure (Sender:TObject;x,y:Integer;dx,dy:Double;xCanvas:TCanvas) of Object;
TCustomTraceEventVB = Procedure (Sender:TObject;x,y:Integer;dx,dy:Double;Dc:Integer) of Object;
(*vbclassexport begin*)
TPCDrawBox = class(TPCPanel)
private
{ Private declarations }
SOnMouseTrace : TMouseTraceEvent;
SOnMousePush : TMousePushEvent;
SOnMousePull : TMousePullEvent;
SOnMouseLeave : TNotifyEvent;
SOnMouseClick : TNotifyEvent;
SOnMouseDblClick : TNotifyEvent;
SOnDropDrag : TDropDragEvent;
SOnDragTrace : TDragTraceEvent;
SOnDragEnd : TDragEndEvent;
SOnDragStart: TDragStartEvent;
SOnScale: TNotifyEvent;
FBeforePaint: TNotifyEvent;
FScrollBars: Boolean;
FSurfaceMArgin: Integer;
FRulerSystem : TRulerSystem;
FActiveLayer : integer;
yold,xold,GuidexOld,GuideYold: integer;
SnapX,SnapY: Integer;
SnapXold,SnapYold: Integer;
FVertBarVisible,FHorzBarVisible: Boolean;
FWorkHeight,FWorkWidth : Double;
FScale : integer;
FDpmOrig : Double;
OldCursor: TCursor;
PageLeft,PageTop,PageWidth,PageHeight: integer;
FGuides,Fgrids,FCenterGuide: Boolean;
FBackGround,FGridColor,FGuideColor : TColor;
FGridStep: Double;
FGridType: TGridType;
FOrient : TPageOrient;
FLayout : TPageLayout;
FguideTrace: TGuideTraces;
FSnapToGuides: boolean;
FSnapToNPoint: boolean;
FSnapToGrids : Boolean;
FCustomGuideTrace: TCustomTraceEvent;
FCustomGuideTraceVB: TCustomTraceEventVB;
FPageColor: TColor;
FbarsLocked: Boolean;
FScrollValues: TScrollValuesEvent;
FCursorChange: TCursorEvent;
ScHorzMAx,scVertMax,scHorzPos,scVertPos,scHorzPage,scVertPage: Integer;
scHorzWidth,scVertHeight:Integer;
vsRgn,hsRgn: HRGN;
rVRgn,rHRgn: HRGN;
FShadow: Boolean;
RulerMode: Integer;
RulerMapScale: Double;
FRulerColor: TColor;
FCoordZ: Double;
FDetailStyle: TDetailStyle;
FIsometric: Boolean;
FDrawPageBorder: Boolean;
FdrawInCursor: Boolean;
FPageGuide: Boolean;
Procedure setSnapToNPoint(value: boolean);
Procedure setSnapToGuides(value: boolean);
Procedure setSnapToGrids(value: boolean);
Procedure setHorzBarVisible(value: Boolean);
Procedure setVertBarVisible(value: Boolean);
Procedure LostFocus(sender:Tobject);
Procedure SetScrollBars(value: Boolean);
Procedure DrawToCanvas(Canvas:TCanvas);
Procedure ZoomCenter;
Procedure SetScrolls(SHorzMAx,SVertMax,SHorzPos,SVertPos,SHorzPage,SVertPage:Integer);
procedure setCenterGuide(const Value: Boolean);
procedure setRulerColor(const Value: TColor);
procedure setCoordZ(const Value: Double);
procedure SetRulerSytem(const Value: TRulerSystem);
procedure SetDetailStyle(const Value: TDetailStyle);
Procedure CalculateDetailMargins(ReScale:Boolean=False);
Procedure CalculateIsometricmargins;
procedure setIsometric(const Value: Boolean);
procedure setPageborder(const Value: Boolean);
procedure SetDrawInCursor(const Value: Boolean);
procedure setPageGuide(const Value: Boolean);
procedure SetDpmOrig(const Value: Double);
function GetToolData: Integer;
protected
{ Protected declarations }
ZoomPointFlag :Boolean;
ZoomPoint :TDoublePoint;
BaseBitmap: TBitmap;
TempBitmap :TBitmap;
FToolIdx : TPCTool;
FToolInfo: String;
FToolData:LongInt;
FBlockDrop:String;
// IsDragging: Boolean;
cRgn: HRGN;
FDetail: Boolean;
FDetailWidth: Integer;
FDetailHeight: Integer;
FDetailScale: Integer;
FDetailTop : Double;
FDetailLeft: Double;
FDetailPosX: Integer;
FDeTailPosY: Integer;
FDetMarX,FDetMarY:Double;
FIsoMarX,FIsoMarY:Double;
CurrentZ: Double;
CurrentModPoint: TModPoint;
CurrentIsoFigure: TFigure;
ZoomDp: TDoublePoint;
scHorzPosSave :Integer;
scVertPosSave :Integer;
Procedure DrawTrace;virtual;
Procedure SetActiveLayer(value: integer);virtual;
Function GetLayerCount:integer;virtual;
Procedure DrawGrids(Canvas:TCanvas);
Procedure DrawGuides(Canvas:TCanvas);
procedure DrawGuidesTop(Canvas: TCanvas);
procedure DrawCenterGuide(Canvas:TCanvas);
procedure SetEngine(xCanvas: TCanvas; CPoint,DeCPoint:ConvertXYProc; CDim,DeCDim:ConvertDimProc;isPrinting: Boolean; prBmp: TBitmap);
Procedure SetDefaultEngine;
Procedure SetForceDefaultEngine;
Procedure SetDetailEngine;
Procedure SetBufferEngine;
Procedure SetForceBufferEngine;
Procedure SetBufferDetailEngine;
Procedure KillTraceFigure;virtual;
Procedure ClipToActiveRegion(xCanvas:TCanvas=nil);
Procedure ClipToUnScrollRegion(xCanvas:TCanvas=nil);
Procedure ClipToDetailRegion(xCanvas:TCanvas=nil);
Procedure unClip(xCanvas:TCanvas=nil);
Procedure DrawRulersToCanvas(Canvas:TCanvas);
Procedure DrawScrollsToCanvas(Canvas: TCanvas; DoubleBuffered: Boolean; hpressed, vpressed: Boolean);
Procedure DoPageLocate;
Procedure SurfaceResize(sender: TObject);
Procedure SetScale(value: integer);virtual;
Procedure DoZoomDelta(Delta:Integer);
Procedure DoZoomIn;override;
Procedure DoZoomOut;override;
Procedure DoZoomArea;override;
Procedure DoZoomActualSize;override;
Procedure DoZoomFitToWindow;override;
Function DoKeyEvents(Message: TWMKey): Boolean;override;
Function GetBackColor:TColor;override;
Procedure setBg(value: Tcolor);
procedure setShadow(const Value: Boolean);
procedure setPageColor(Value: TColor);
Procedure setGuides(value: Boolean);
Procedure setGrids(value: Boolean);
Procedure SetGridType(value:TGridType);
Procedure setGColor(value: TColor);
Procedure setGuideColor(value: TColor);
Procedure setGStep(value: Double);
Procedure setlayout(value : TPageLayout);
Procedure setwHeight(value: Double);
Procedure setwWidth(value: Double);
Procedure setorient(Value : TPageOrient);
Procedure setGTrace(value: TGuideTraces);
// Procedure CheckToSnap(var X,Y:Double);virtual;
// Procedure CalculateSnapPoint(var X,Y:Double);virtual;
Procedure SurfaceMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
Procedure SurfaceMouseMove(Sender: TObject;Shift: TShiftState; X, Y: Integer);
Procedure SurfaceClick(Sender:TObject);
Procedure SurfaceDblClick(Sender:TObject);
Procedure SurfaceLeave(Sender: TObject);
Procedure SurfaceDragDrop(Sender, Source: TObject; X,Y: Integer);
Procedure SurfaceDragEnd(Sender, Target: TObject; X,Y: Integer);
Procedure SurfaceDragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
Procedure SurfaceDragStart(Sender: TObject;var DragObject: TDragObject);
Procedure SurfacePull(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Procedure SurfacePush(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
Procedure DragMove(x,y:Integer);
Procedure DragDropped(x,y:Integer);
Procedure SurfaceMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
Procedure CadMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
Procedure MSPush(sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Double);virtual;
procedure MSTrace(Sender: TObject; Shift: TShiftState; X,Y: Double);virtual;
procedure MSPull(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double);virtual;
procedure MSDropDrag(Sender:Tobject; Source: Integer; X, Y: Double);virtual;
procedure MSDragOver(Sender:TObject; Source: Integer; X, Y: Double;State: TDragState; var Accept: Boolean);virtual;
procedure MSEndDrag(Sender, Target: TObject; X, Y: Double);virtual;
procedure MSStartDrag(Sender: TObject;var DragObject: TDragObject);virtual;
procedure MSClick(Sender: TObject);virtual;
procedure MSDblClick(Sender: TObject);virtual;
Procedure MSLeave(Sender: TObject);virtual;
Procedure DoSurfacePaint(Sender: TObject); virtual;
Procedure DrawguideTrace(x,y: integer);
Procedure Refresh;override;
Procedure SyncEnv;override;
Procedure ResetActions;virtual;
Procedure ResetRegions;virtual;
Function SnapToFigures(var x,y: Double):Boolean;virtual;
// Procedure DrawGuideOnSurface(x,y:Integer;guType:TGuideType);
Procedure SetRulerValues(MapScale: Double; Mode: Integer);
procedure SetDetail(const Value: Boolean);
procedure setDetailHeight(const Value: Integer);
procedure setDetailWidth(const Value: Integer);
procedure SetDetailScale( Value: Integer);
Procedure GotFocus(Sender:TObject);virtual;
Function GetZAvg(dRect:TDoubleRect):Double;virtual;
Procedure GetIsometricBounds(var MinX,MinY,MaxX,MaxY: Double);virtual;
Property HorzBarVisible: Boolean read FHorzBarVisible write setHorzBarVisible;
Property VertBarVisible: Boolean read FVertBarVisible write setVertBarVisible;
public
{ Public declarations }
IsDragging: Boolean;
DrawBars:Boolean;
CurrentUserClass: String;
evGrids : TEventEngine;
evGridType : TEventEngine;
evGuides : TEventEngine;
evCenterGuide: TEventEngine;
evSnapGrids : TEventEngine;
evSnapGuides : TEventEngine;
evSnapObject : TEventEngine;
evGridColor : TEventEngine;
evGuideColor : TEventEngine;
evBackColor : TEventEngine;
evPageColor : TEventEngine;
evGuideTrace : TeventEngine;
evPageLo : TeventEngine;
evPageOr : TeventEngine;
SurfaceHandle: HWND;
Surface: TPaintBoxExt;
DEngine: TPCDrawEngine;
SnapLocked: Boolean;
DetailHit: Boolean;
DetailHitPoint:Tpoint;
SnapInfo: String;
DetailActive: Boolean;
IsoAngle : Double;
IsoType : Byte;
Guides: TList;
GuidesCreatedOnDropCompon: TList;
MaxScale: Integer; //16.12.2011
FGrayedColor: TColor; //06.08.2012 - <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
FResetRegionsOnZoomScroll: Boolean; //07.08.2012 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> ResetRegions <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
Procedure DrawGuideOnSurface(x,y:Integer;guType:TGuideType; needDraw: boolean = True);
Procedure SurfaceMiddleDblClick(Sender:TObject);
Procedure SaveScroll;(*vb*)
Procedure RestoreScroll;(*vb*)
Function GetActiveCanvas:TCanvas;
Procedure ReLocate;(*vb*)
Procedure SetCustomSurface(CWindow:HWnD; CDC:HDC);override;(*vb*)
Procedure DoSurfaceMove(Shift:Integer; X,Y: Integer);(*vb*)
Procedure DoSurfaceClick;(*vb*)
Procedure DoSurfaceDblClick;(*vb*)
Procedure DoSurfaceLeave;(*vb*)
Procedure DoSurfaceDragDrop(Source:Integer; X,Y: Integer);(*vb*)
Procedure DoSurfaceDragEnd(X,Y: Integer);
Procedure DoSurfaceDragOver(Source:Integer; X,Y: Integer; State: Integer; var Accept: Boolean);
Procedure DoSurfaceDragStart(Sender: TObject;var DragObject: TDragObject);
Procedure DoSurfacePull(Button: Integer; Shift: Integer; X, Y: Integer);(*vb*)
Procedure DoSurfacePush(Button: Integer; Shift: Integer; X, Y: Integer);(*vb*)
Procedure DoSurfaceWheel(Shift: Integer; WheelDelta: Integer;X,Y:Integer);(*vb*)
Procedure DoSurfaceWheelPull(Shift: Integer; X, Y: Integer);
Procedure DoSurfaceWheelPush(Shift: Integer; X, Y: Integer);
Procedure SurfaceWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint);
Procedure SurfaceWheelPull(Shift: TShiftState; X, Y: Integer);
Procedure SurfaceWheelPush(Shift: TShiftState; X, Y: Integer);
//<2F><><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> U_CAD <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> PCad <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>
Procedure CheckToSnap(var X,Y:Double);virtual;
// Procedure CalculateSnapPoint(var X,Y:Double);virtual;
Function CalculateSnapPoint(var X,Y:Double): Boolean;virtual;
Function DoKeyStroke(ChCode:Integer;Shift:Integer):Boolean;virtual;(*vb*)
Function CheckForGuideDrop(X,Y: Integer; autoCr: boolean = False):Boolean;(*vb*)
Function CheckAndGetGuideDrop(X,Y: Integer; var GuideLine: TGuideLine; autoCr: boolean = False): Boolean;
Procedure DragStarted;virtual;(*vb*)
Function GetSelectionRect:TDoubleRect;virtual;(*vb*)
Function GetDrawingRect:TDoubleRect;virtual;(*vb*)
Function GetVisibleRect:TDoubleRect;virtual;(*vb*)
Procedure DeConvertXY(var X,Y,Z: Double); (*vb*)
Procedure DeConvertDim(var Dime: Double);(*vb*)
Procedure ConvertXY(var X,Y,Z: double); (*vb*)
Procedure ConvertDim(var Dime: double); (*vb*)
Procedure DetDeConvertXY(var X,Y,Z: Double);
Procedure DetDeConvertDim(var Dim: Double);
Procedure DetConvertXY(var X,Y,Z: double);
Procedure DetConvertDim(var Dim: double);
Procedure IsoDeConvertXY(var X,Y,Z: Double);
Procedure IsoDeConvertDim(var Dim: Double);
Procedure IsoConvertXY(var X,Y,Z: double);
Procedure IsoConvertDim(var Dim: double);
Procedure IsoTo2D(var x,y,z: Double);
Procedure ZoomArea(ZoomRect:TDoubleRect);(*vb*)
Procedure FitToWindow;(*vb*)
Procedure ActualSize;(*vb*)
Procedure ZoomOut;(*vb*)
Procedure ZoomIn;(*vb*)
Constructor Create(AOwner: TComponent);override;
Destructor Destroy;override;
Procedure ClearGuides;(*vb*)
Procedure SetTool(aToolIndex: TPCTool;aToolInfo:String;aToolData:Integer);virtual;(*vb*)
Procedure SetCursor(cr:TCursor);virtual;(*vb*)
Procedure SetDragCursor(cr:TCursor); (*vb*)
Function CheckGuideLine(x,y:Double):Boolean;(*vb*)
Function CheckForExistGuide(x,y: double; guType:TGuideType): Boolean;
Procedure BeginHRulerDrag;(*vb*)
Procedure BeginVRulerDrag;(*vb*)
Function SurfaceWidth:Integer;(*vb*)
Function SurfaceHeight: Integer;(*vb*)
Function GetPageRect:TRect;overload;
Procedure GetPageRect(var left,top,right,bottom:Integer);overload;(*vb*)
Procedure SetSurfaceMargin(Value:Integer);(*vb*)
Procedure SetScrollPositions(hPos,vPos:Integer)(*vb*);
Procedure SetHScrollPosition(hPos: Integer;Update: Boolean); (*vb*)
Procedure SetVScrollPosition(vPos: Integer;Update:Boolean);(*vb*)
Procedure SetHScrollDelta(hDelta:Double;Update: Boolean);(*vb*)
Procedure SetVScrollDelta(hDelta:Double;Update: Boolean); (*vb*)
Function HSCBarPosition: Integer; (*vb*)
Function VSCBarPosition: Integer;(*vb*)
Function PointInHScroll(x,y:Double):Boolean; (*vb*)
Function PointInVScroll(x,y:Double):Boolean;(*vb*)
Function PointInHRuler(x,y:Double):Boolean;(*vb*)
Function PointInVRuler(x,y:Double):Boolean;(*vb*)
Function PointInDetail(x,y:Double):Boolean;
Procedure CenterLocation(x,y:Double);(*vb*)
Function PointInView(x,y:Double):Boolean;(*vb*)
Procedure ZoomDetailArea(ZoomRect:TDoubleRect);
Procedure ZoomDetailPoint(ZoomCenter:TDoublePoint);(*vb*)
Procedure MoveDetailArea(dx,dy: Double);
Function HitTestModPoint(x,y:Double):TModPoint;virtual;
Function HitTestModPointInt(x,y:Double):Integer;virtual;(*vb*)
Function HitTestModPointIntVal(x,y:Integer):TModPoint;virtual;
Function HitTestModPointDetVal(x,y:Integer):TModPoint;virtual;
Function CheckByPointInt(LayerNbr:Integer;x,y:Integer):TFigure;virtual;
Procedure CollectFaces;virtual;
Procedure SimulateTrace(x,y:Double);(*vb*)
Procedure SimulateDown(x,y:Double);(*vb*)
Procedure SimulateUp(x,y:Double);(*vb*)
Procedure SimulateRightClick(x,y:Double);(*vb*)
Procedure SnapToGrid(var X,Y:Double); //01.10.2013
procedure SurfacePaint; //07.08.2012
Property ToolIdx : TPCTool read FToolIdx;(*vb*)
Property ToolInfo : string read FToolInfo;(*vb*)
Property ToolData: Integer read GetToolData;(*vb*)
Property DotsPerMilOrig: Double read FDpmOrig write SetDpmOrig;(*vb*)
Property ActiveLayer : Integer read FActiveLayer write setActiveLayer;(*vb*)
property Color; //07.08.2012 - <20><> TCustomPanel
property OnMouseWheel;
Procedure DestroyCreatedOnDropGuides;
published
{ Published declarations }
Property ZoomScale: integer read FScale write setscale;(*vb*)
Property GuidesVisible : Boolean read FGuides write setGuides; (*vb*)
Property BackGround :Tcolor read FBackGround write setBg;(*vb*)
Property PageColor :TColor read FPageColor write setPageColor;(*vb*)
Property Grids: Boolean read FGrids write setGrids;(*vb*)
Property GridType: TGridType read FGridType write SetGridType;(*vb*)
Property CenterGuide:Boolean read FCenterGuide write setCenterGuide; (*vb*)
Property PageGuide:Boolean read FPageGuide write setPageGuide;(*vb*)
Property DrawShadow: Boolean read FShadow write setShadow;(*vb*)
Property DrawPageBorder: Boolean read FDrawPageBorder write setPageborder;(*vb*)
Property GridColor: TColor read FGridColor write setGcolor;(*vb*)
Property GuideColor: TColor read FGuideColor write setGuidecolor;(*vb*)
Property RulerColor:TColor read FRulerColor write setRulerColor;(*vb*)
Property GridStep: Double read FGridStep write setGstep;(*vb*)
Property WorkHeight: Double read FWorkHeight write setWHeight;(*vb*)
Property WorkWidth: Double read FWorkWidth write setWWidth;(*vb*)
Property PageLayout: TPageLayOut read FLayout write setLayOut; (*vb*)
Property PageOrient: TPageOrient read FOrient write setOrient;(*vb*)
Property GuideTrace: TGuideTraces read FGuideTrace write setGTrace;(*vb*)
Property SnapToGuides: Boolean read FSnapToGuides write setSnapToGuides;(*vb*)
Property SnapToNearPoint: Boolean read FSnapToNPoint write setSnapToNPoint;(*vb*)
Property SnapToGrids: Boolean read FSnapToGrids write setSnaptoGrids;(*vb*)
Property ScrollBars : Boolean read FScrollBars write setScrollBars;(*vb*)
Property IsoCoordZ: Double read FCoordZ write setCoordZ;
Property RulerSystem: TRulerSystem read FRulerSystem write SetRulerSytem;(*vb*)
Property DrawInCursor:Boolean read FdrawInCursor write SetDrawInCursor;(*vb*)
Property DetailWindow:Boolean read FDetail write SetDetail;
Property DetailWidth:Integer read FDetailWidth write setDetailWidth;
Property DetailHeight:Integer read FDetailHeight write setDetailHeight;
Property DetailScale: Integer read FDetailScale write SetDetailScale;
Property DetailStyle:TDetailStyle read FDetailStyle write SetDetailStyle;
Property Isometric:Boolean read FIsometric write setIsometric;
property OnSurfaceMove : TMouseTraceEvent read SOnMouseTrace write SOnMouseTrace;(*vb*)
property OnSurfaceMouseDown : TMousePushEvent read SOnMousePush write SOnMousePush; (*vb*)
property OnSurfaceMouseUp : TMousePullEvent read SOnMousePull write SOnMousePull;(*vb*)
property OnSurfaceLeave : TNotifyEvent read SOnMouseLeave write SOnMouseLeave;(*vb*)
property OnSurfaceClick : TNotifyEvent read SOnMouseClick write SOnMouseClick;(*vb*)
property OnSurfaceDblClick: TNotifyEvent read SOnMouseDblClick write SOnMouseDblClick;(*vb*)
Property OnSurfaceDragDrop: TDropDragEvent read SOnDropDrag write SOnDropDrag; (*vb*)
Property OnSurfaceDragOver: TDragTraceEvent read SOnDragTrace write SOnDragTrace;(*vb*)
Property OnSurfaceEndDrag: TDragEndEvent read SOnDragEnd write SOnDragEnd;
Property OnSurfaceStartDrag: TDragStartEvent read SOnDragStart write SOnDragStart;
Property OnScaleChanged: TNotifyEvent read SOnScale write SOnScale;(*vb*)
Property OnScrollValues:TScrollValuesEvent read FScrollValues write FScrollValues;(*vb*)
Property OnCursorChange:TCursorEvent read FCursorChange write FCursorChange;(*vb*)(*vbprivate*)
Property OnBeforePaint: TNotifyEvent read FBeforePaint write FBeforePaint;(*vb*)
Property OnCustomGuideTrace: TCustomTraceEvent read FCustomGuideTrace write FCustomGuideTrace;
Property OnCustomGuideTraceVB: TCustomTraceEventVB read FCustomGuideTraceVB write FCustomGuideTraceVB;(*vb*)
end;
(*vbclassexport end*)
const crZoom = crDefault + 30;
const crLocate = crDefault + 31;
const crPan = crDefault + 32;
const crDelete = crDefault + 33;
implementation
uses U_Common, U_BaseCommon, USCS_Main, U_CAD{Tolik -- 29/03/2017 -- }, U_Master_compl;
{$R *.RES}
{$R *.DCR}
var oldPosX,oldPosY:Integer;
//******************************************************************************
// TGU<47>DEL<45>NE IMPLEMENTATION
//******************************************************************************
Constructor TGuideline.create(aType: TGuideType; aCoord: Double; autoCr: boolean = False);
begin
inherited create;
// Tolik 14/04/2021 --
if GAutoCreatedGuide then
begin
fautoCr := GAutoCreatedGuide;
GAutoCreatedGuide := False;
end
else
//
fautoCr := autoCr;
gType := aType;
coord := aCoord;
end;
destructor TGuideline.destroy;
begin
inherited;
end;
///////////////////////////////////////////////////
//******************************************************************************
// TPCDRAWBOX IMPLEMENTATION
//******************************************************************************
Constructor TPCDrawBox.Create(AOwner: TComponent);
Begin
inherited create(AOwner);
FDrawInCursor := False;
ZoomPointFlag := False;
SnapLocked := False;
CurrentModPoint := nil;
DEngine := TPCDrawEngine.create;
RulerMode := 0; //rmPage
RulerMapScale := 1;
IsDragging := False;
CustomSurface := nil;
Guides := TList.Create;
GuidesCreatedOnDropCompon := TList.Create;
FScrollBars := True;
FDetailStyle:= dsZoom;
FIsometric := False;
vsRgn := 0;
HSRgn := 0;
rVRgn := 0;
rHRgn := 0;
FBarsLocked := False;
DrawBars := True;
FDetail := False;
FDetailWidth := 100;
FDetailHeight := 100;
FDetailTop := 0;
FDetailLeft := 0;
CurrentZ := 0;
FActiveLayer := 0;
Surface:= TPaintboxExt.Create(self);
Surface.Parent := Container;
Surface.Align := alClient;
Surface.Visible := true;
Surface.OnPaint := DoSurfacePaint;
Container.OnResize := SurfaceResize;
FDetailPosX := SurfaceWidth-FDetailWidth-20;
FDetailPosY := 20;
FVertBarVisible := False;
FHorzBarVisible := False;
FWorkHeight:= 100;
FWorkWidth := 100;
FScale := 100;
FDpmOrig := 4;
SetDpm((FScale / 100) * FDpmOrig);
FSurfaceMargin := 0;
FBackGround := clWhite;
FRulerColor := clSilver;
FPageColor := clWhite;
FOrient:= poPortrait;
FLayout := plCustom;
FGridStep := 5;
FGridColor := clSilver;
FGrids := true;
FGridType := grtLine;
FShadow := True;
FDrawPageBorder := True;
FGuideColor := clGreen;
FGuides := True;
FguideTrace := gtNone;
FSnapToGrids := False;
FSnapToGuides := False;
FSnapToNPoint := False;
IsoAngle := pi/4;
IsoType := 0;
MaxScale := 3000; //16.12.2011
FGrayedColor := DefGrayedColor; //06.08.2012
FResetRegionsOnZoomScroll := true; //07.08.2012
//Surface.OnMouseMove := SurfaceMove;
Surface.OnMouseMove := SurfaceMouseMove;
Surface.OnClick := SurfaceClick ;
Surface.OnDblClick := SurfaceDblClick;
Surface.OnMouseLeave := SurfaceLeave;
Surface.OnDragDrop := SurfaceDragDrop;
Surface.OnEndDrag := SurfaceDragEnd;
Surface.OnDragOver := SurfaceDragOver;
Surface.OnStartDrag := SurfaceDragStart;
Surface.OnMouseUp := SurfacePull;
Surface.OnMouseDown := SurfacePush;
Surface.Visible := True;
OnMouseWheel := CadMouseWheel;
Surface.OnMouseWheel := SurfaceMouseWheel;
Surface.OnMiddleDblClick := SurfaceMiddleDblClick;
Self.OnEnter := GotFocus;
yold := - 50000;
xold := - 50000;
Guideyold := - 50000;
Guidexold := - 50000;
SnapX := - 50000;
SnapY := - 50000;
SnapXold := - 50000;
SnapYold := - 50000;
screen.Cursors[crZoom] := LoadCursor(HInstance,'ZOOM');
screen.Cursors[crLocate] := LoadCursor(HInstance,'LOCATE');
screen.Cursors[crPan] := LoadCursor(HInstance,'PAN');
screen.Cursors[crDelete] := LoadCursor(HInstance,'DELETE');
TempBitmap := TBitmap.Create;
BaseBitmap := TBitmap.Create;
evGrids := EventEngine(cGrids,1,'',0);
evGridType := EventEngine(cGridType,0,'',0);
evCenterGuide := EventEngine(cCenterGuides,1,'',0);
evGuides := EventEngine(cGuides,1,'',0);
evSnapGrids := EventEngine(cSnapGrid,0,'',0);
evSnapGuides := EventEngine(cSnapGuides,0,'',0);
evSnapObject := EventEngine(cSnapObject,0,'',0);
evGridColor := EventEngine(cGridColor,FGridColor,'',0);
evGuideColor := EventEngine(cGuideColor,FGuideColor,'',0);
evBackColor := EventEngine(cBackColor,FBackground,'',0);
evPageColor := EventEngine(cPageColor,FPageColor,'',0);
evGuideTrace := EventEngine(cAngularGuides,0,'',0);
evPageLo := EventEngine(cPageLo,ord(FLayout),'',0);
evPageOr := EventEngine(cPageOr,ord(FOrient),'',0);
evRulerSys := EventEngine(cRulerSystem,ord(FRulerSystem),'',0);
FcoordZ := 0;
DetailActive := False;
end;
Procedure TPCDrawBox.setScrollBars(value: Boolean);
Begin
if value = FScrollBars then exit;
FScrollBars := value;
DoPageLocate;
if autorefresh then
DoSurfacePaint(Surface);
SyncEnv;
End;
Procedure TPCDrawBox.setHorzBarVisible(value: Boolean);
Begin
FHorzBarVisible := value;
//SyncEnv;
End;
Procedure TPCDrawBox.setVertBarVisible(value: Boolean);
Begin
FVertBarVisible := value;
//SyncEnv;
End;
Procedure TPCDrawBox.SurfaceResize(sender: TObject);
Begin
FDetailPosX := SurfaceWidth-FDetailWidth-20;
FDetailPosY := 20;
DoPageLocate;
ZoomCenter;
DrawGuideTrace(-25000,-25000);
End;
Procedure TPCDrawBox.SetScale(value: integer);
var
i, stCnt: Integer;
st: Integer;
Begin
If (value < 1) or (value > MaxScale) then
exit;
if FScale <> Value then //07.08.2012
begin
FScale := Value;
SetDpm(FDpmOrig * (FScale / 100));
ZoomCenter;
end
else
ResetRegions;
End;
Procedure TPCDrawBox.DoPageLocate;
var
rt: TrulerType;
inch: real;
SWidth, SHeight: Integer;
Begin
if Locked then
exit;
if FResetRegionsOnZoomScroll then //07.08.2012
ResetRegions;
FBarsLocked := True;
try
if rulerVisible then
begin
// PageLeft := 35;
// PageTop := 35;
SWidth := SurfaceWidth-30;
SHeight := SurfaceHeight - 30;
end
else
begin
PageLeft := 5;
PageTop := 5;
SWidth := SurfaceWidth;
SHeight := SurfaceHeight;
end;
PageWidth:= Round((FWorkWidth ) * DotsPerMil );
PageHeight:= Round((FWorkHeight) * DotsPerMil );
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
If PageWidth < swidth then
begin
if rulerVisible then
begin
PageLeft := (swidth - PageWidth) div 2 + 30;
end
else
begin
PageLeft := (swidth - PageWidth) div 2;
end;
HorzBarVisible := False;
SCHorzMax := 0;
scHorzPos := 0;
end
else if FScrollbars then
begin
HorzBarVisible := True;
SCHorzMax := PageWidth + 25;
scHorzPage := swidth;
scHorzPos := 0;
end
else
begin
HorzBarVisible := False;
SCHorzMax := 0;
SCHorzPos := 0;
end;
{
else
begin
HorzBarVisible := False;
SCHorzMax := PageWidth + 25;
scHorzPage := swidth;
scHorzPos := 0;
end;
}
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
If PageHeight < sHeight then
begin
if rulerVisible then
begin
PageTop := (SHeight -PageHeight) div 2 + 30;
end
else
begin
PageTop := (SHeight - PageHeight) div 2;
end;
VertBarVisible := False;
SCVertMax := 0;
ScvertPos := 0;
end
else
if FScrollbars then
begin
VertBarVisible := True;
scVertMax := PageHeight + 25;
scVertPage := SHeight;
scvertPos := 0;
end
else
begin
VertBarVisible := False;
scVertMax := 0;
scvertPos := 0;
end;
{
else
begin
VertBarVisible := False;
scVertMax := PageHeight + 25;
scVertPage := SHeight;
scvertPos := 0;
end;
}
inch := 2.54;
if RulerSystem = rsMetric then
begin
if Dotspermil > 40 then
rt := rtDeciMilim
else
if Dotspermil > 24 then
rt := rtHalfMilim
else
if Dotspermil > 12 then
rt := rtMilim
else
if Dotspermil > 2.4 then
rt := rtHalfCMeter
else
if Dotspermil > 1.2 then
rt := rtCentiMeter
else
rt := rtDecimeter;
end
else
begin
if (Dotspermil * inch * 10 / 128) > 12 then
rt := rtDeciMilim // 1/128 inch
else
if (Dotspermil * inch * 10 / 32) > 12 then
rt := rtHalfMilim // 1/32 inch
else
if (Dotspermil * inch * 10 / 16) > 12 then
rt := rtMilim // 1/16 inch
else
if (Dotspermil * inch * 5) > 12 then
rt := rtHalfCMeter // 1/2 inch
else
if (Dotspermil * inch * 10) > 12 then
rt := rtCentiMeter // inch
else
rt := rtDecimeter; // 10 x inch
end;
RulerType := rt;
except
end;
FbarsLocked := False;
End;
Procedure TPCDrawBox.DoSurfacePaint(sender: TObject);
var
sx, sy: integer;
pnt: Tpoint;
Begin
try
if Locked then
exit;
if rulerVisible then
begin
If HorzBarVisible then
PageLeft := 35 - HSCBarPosition;
If VertBarVisible then
PageTop := 35 - VSCBarPosition;
end
else
begin
If HorzBarVisible then
PageLeft := 5 - HSCBarPosition;
If VertBarVisible then
PageTop := 5 - VSCBarPosition;
end;
if VerticalZero = vzBottom then
sy := PageTop + PageHeight
else
sy := PageTop;
if HorizontalZero = vzRight then
sx := PageLeft + PageWidth
else
sx := PageLeft;
RulerStart := Point(sx, sy);
if assigned(TempBitmap) then
begin
TempBitmap.FreeImage;
TempBitmap.Free;
end;
if Assigned(GCadForm) then
if GCanRefreshCad then
DrawShadowCrossPoints; // Tolik 17/01/2022
TempBitmap := TBitmap.Create;
TempBitmap.Width := SurfaceWidth;
TempBitmap.Height := SurfaceHeight;
TempBitmap.Canvas.Brush.Color := Background;
TempBitmap.Canvas.Brush.Style := bsSolid;
TempBitmap.Canvas.FillRect(Rect(0, 0, TempBitmap.Width, TempBitmap.Height));
DrawGuideTrace(-25000, -25000);
SnapXold := -50000;
SnapYold := -50000;
SetForceBufferEngine;
DrawToCanvas(TempBitmap.canvas);
SetBufferEngine;
if FIsometric then
CalculateIsometricMargins;
except
//On E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawBox.DoSurfacePaint' + E.Message);
On E: Exception do AddExceptionToLog('TPCDrawBox.DoSurfacePaint' + E.Message);
end;
End;
Procedure TPCDrawBox.ZoomCenter;
var
xrect: TDoubleRect;
FRefresh: Boolean;
lMar: Integer;
event: TScrollValuesEvent;
Begin
FbarsLocked := True;
if ZoomPointFlag then
begin
xRect := DoubleRect(ZoomPoint.X - 10, ZoomPoint.Y - 10, ZoomPoint.X + 10, ZoomPoint.Y + 10);
end
else
begin
xRect := GetSelectionRect;
if (xrect.left = 0) and (xrect.right =0) and (xrect.top = 0) and (xrect.bottom = 0) then
begin
xRect := GetDrawingRect;
end;
if (xrect.left = 0) and (xrect.right =0) and (xrect.top = 0) and (xrect.bottom = 0) then
begin
XRect := DoubleRect(0, 0, WorkWidth, WorkHeight);
end;
end;
SetDpm(FDpmOrig * (FScale / 100));
FRefresh := AutoRefresh;
AutoRefresh := False;
event := FScrollValues;
FScrollValues := nil;
DoPageLocate;
FScrollValues := event;
FbarsLocked := True;
If HorzBarVisible then
begin
lmar := Round(SurfaceWidth - abs(xRect.Right - xRect.Left) * DotsPermil) div 2;
if HorizontalZero = vzRight then
scHorzPos := round(((FWorkWidth - xRect.right)) * DotsPerMil - lmar)
else
scHorzPos := round((xRect.Left) * DotsPerMil - lmar);
end;
If VertBarVisible then
begin
lmar := Round(SurfaceHeight - abs(xRect.Top - xRect.Bottom) * DotsPermil) div 2;
if VerticalZero = vzBottom then
scVertPos := round(((FWorkHeight - xRect.Bottom)) * DotsPerMil - lmar)
else
scVertPos := round(((xRect.Top)) * DotsPerMil - lmar);
end;
AutoRefresh := Frefresh;
if AutoRefresh then
DoSurfacePaint(Surface);
If assigned(SOnScale) then
SOnScale(self);
SyncEnv;
FbarsLocked := False;
end;
Procedure TPCDrawBox.DoZoomIn;
Begin
ZoomScale := ZoomScale + 10;
inherited;
End;
Procedure TPCDrawBox.DoZoomOut;
Begin
ZoomScale := ZoomScale - 10;
inherited;
End;
Procedure TPCDrawBox.DoZoomArea;
Begin
inherited;
End;
procedure TPCDrawBox.ZoomArea(ZoomRect:TDoubleRect);
var sc1,sc2 : double;
rw,rh: real;
w,h : double;
tval: double;
lmar: Integer;
begin
if zoomrect.bottom > zoomrect.top then
begin
tVal := zoomrect.bottom;
zoomrect.bottom := zoomrect.top;
zoomrect.top := tval;
end;
if zoomrect.left > zoomrect.right then
begin
tVal := zoomrect.left;
zoomrect.left := zoomrect.right;
zoomrect.right := tval;
end;
w := Abs(ZoomRect.Left - ZoomRect.Right);
h := Abs(ZoomRect.Top - ZoomRect.Bottom);
rW := (w)*Fdpmorig;
sc1 := (surfacewidth-35)/rw;
rH := (h)*Fdpmorig;
sc2 := (surfaceheight-35)/rH;
if not((rw > 30) and (rh > 30)) then exit;
FbarsLocked := True;
AutoRefresh := False;
if Sc1 > sc2 then ZoomScale := Round(sc2*100) else ZoomScale := Round(sc1*100);
If HorzBarVisible then begin
lmar := Round(SurfaceWidth - abs(ZoomRect.Right-ZoomRect.Left)*DotsPermil) div 2;
if HorizontalZero = vzRight then
scHorzPos := round(((FWorkWidth-ZoomRect.right))*DotsPerMil-lmar)
else
scHorzPos := round((ZoomRect.Left)*DotsPerMil-lmar);
end;
If VertBarVisible then begin
lmar := Round(SurfaceHeight - abs(ZoomRect.Top-ZoomRect.Bottom)*DotsPermil) div 2;
if VerticalZero = vzBottom then
scVertPos := round(((FWorkHeight - ZoomRect.Top))*DotsPerMil-lmar)
else
scVertPos := round(((ZoomRect.Bottom))*DotsPerMil-lmar);
end;
AutoRefresh := True;
Refresh;
FbarsLocked := False;
DoZoomArea;
end;
Procedure TPCDrawBox.DoZoomActualSize;
Begin
ZoomScale := 100;
inherited;
End;
Procedure TPCDrawBox.ActualSize;
begin
DoZoomActualSize;
end;
Procedure TPCDrawBox.DoZoomFitToWindow;
var scx,scy,SWidth,SHeight: integer;
Begin
if rulerVisible then begin
SWidth := SurfaceWidth-30;
SHeight := SurfaceHeight - 30;
end else begin
SWidth := SurfaceWidth;
SHeight := SurfaceHeight;
end;
scx := round((Swidth / ((FWorkWidth ) * FDpmOrig )) * 100)-1;
scy := round((SHeight / ((FWorkHeight ) * FDpmOrig )) * 100)-1;
// Tolik 20/03/2019
//ZoomScae := Round(MinValue([scx,scy]));
if scx < scy then
ZoomScale := scx
else
ZoomScale := scy;
inherited;
End;
Procedure TPCDrawBox.FitToWindow;
Begin
DoZoomFitToWindow;
end;
procedure TPCDrawBox.setbg(value: Tcolor);
begin
FBackGround := value;
if autorefresh then DoSurfacePaint(Surface);
evBackColor.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
procedure TPCDrawBox.SetGuides(value: Boolean);
begin
FGuides := value;
if autorefresh then DoSurfacePaint(Surface);
evGuides.RaiseEvent(value);
Updated := True;
SyncEnv;
end;
procedure TPCDrawBox.setgrids(value: boolean);
begin
FGrids := value;
if autorefresh then DoSurfacePaint(Surface);
evGrids.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.SetGridType(value:TGridType);
begin
FGridType := value;
if autorefresh then DoSurfacePaint(Surface);
evGridType.RaiseEvent(ord(Value));
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setGcolor(value:Tcolor);
begin
FGridColor := value;
if autorefresh then DoSurfacePaint(Surface);
evGridColor.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setGstep(value: Double);
begin
FGridStep := value;
if autorefresh then DoSurfacePaint(Surface);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setGTrace(value: TGuideTraces);
begin
FGuideTrace := value;
if autorefresh then DoSurfacePaint(Surface);
evGuideTrace.RaiseEvent(ord(value));
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setGuidecolor(value:Tcolor);
begin
FGuideColor := value;
if autorefresh then DoSurfacePaint(Surface);
evGuideColor.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setlayout(value : TPageLayout);
begin
Flayout := value;
case Flayout of
plA0 : begin
if forient = poPortrait then
begin
fWorkHeight := 1189; fWorkWidth := 841;
end
else
begin
fWorkHeight := 841; fWorkWidth := 1189;
end;
end;
plA1 : begin
if forient = poPortrait then
begin
fWorkHeight := 841; fWorkWidth := 594;
end
else
begin
fWorkHeight := 594; fWorkWidth := 841;
end;
end;
plA2 : begin
if forient = poPortrait then
begin
fWorkHeight := 594; fWorkWidth := 421;
end
else
begin
fWorkHeight := 421; fWorkWidth := 594;
end;
end;
plA3 : begin
if forient = poPortrait then
begin
fWorkHeight := 421; fWorkWidth := 297;
end
else
begin
fWorkHeight := 297; fWorkWidth := 421;
end;
end;
plA4 : begin
if forient = poPortrait then
begin
fWorkHeight := 297; fWorkWidth := 210;
end
else
begin
fWorkHeight := 210; fWorkWidth := 297;
end;
end;
plA5 : begin
if forient = poPortrait then
begin
fWorkHeight := 210; fWorkWidth := 148;
end
else
begin
fWorkHeight := 148; fWorkWidth := 210;
end;
end;
plA6 : begin
if forient = poPortrait then
begin
fWorkHeight := 105; fWorkWidth := 74;
end
else
begin
fWorkHeight := 74; fWorkWidth := 105;
end;
end;
plB4 : begin
if forient = poPortrait then
begin
fWorkHeight := 353; fWorkWidth := 250;
end
else
begin
fWorkHeight := 250; fWorkWidth := 353;
end;
end;
plB5 : begin
if forient = poPortrait then
begin
fWorkHeight := 250; fWorkWidth := 176;
end
else
begin
fWorkHeight := 176; fWorkWidth := 250;
end;
end;
plTabloid : begin
if forient = poPortrait then
begin
fWorkHeight := 431; fWorkWidth := 279;
end
else
begin
fWorkHeight := 279; fWorkWidth := 431;
end;
end;
plLetter : begin
if forient = poPortrait then
begin
fWorkHeight := 279; fWorkWidth := 215;
end
else
begin
fWorkHeight := 215; fWorkWidth := 279;
end;
end;
plCustom : begin
end;
end;
DoPageLocate;
if autorefresh then DoSurfacePaint(Surface);
evPageLo.RaiseEvent(ord(FLayOut));
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setwHeight(value: Double);
begin
FWorkHeight := value;
flayout := plCustom;
// if fworkheight > fworkwidth then
// fOrient := poPortrait
// else
// fOrient := poLandscape;
DoPageLocate;
if autorefresh then
DoSurfacePaint(Surface);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setwWidth(value: Double);
Begin
FWorkWidth := value;
flayout := plCustom;
// if fworkheight > fworkwidth then
// fOrient := poPortrait
// else
// fOrient := poLandscape;
DoPageLocate;
if autorefresh then
DoSurfacePaint(Surface);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setorient(Value : TPageOrient);
var
buffer1, buffer2: Double;
begin
FOrient := value;
{
If FOrient = poPortrait then
begin
if fWorkWidth > fWorkHeight then
begin
end;
end
else
begin
if fWorkWidth < fWorkHeight then
begin
end;
end;
}
DoPageLocate;
if autorefresh then
DoSurfacePaint(Surface);
evPageOr.RaiseEvent(ord(FOrient));
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setSnapToNPoint(value: boolean);
begin
SnapLocked := False;
FSnapToNPoint := value;
evSnapObject.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setSnapToGuides(value: boolean);
begin
SnapLocked := False;
FSnapToGuides := value;
evSnapGuides.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.setSnapToGrids(value: boolean);
begin
SnapLocked := False;
FSnapToGrids := value;
evSnapGrids.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
Procedure TPCDrawBox.DeConvertXY(var X,Y,Z: double);
Begin
if HorizontalZero = vzRight then
x := (PageLeft + PageWidth) - x
else
x := x - PageLeft;
if VerticalZero = vzBottom then
y := (PageTop + PageHeight) - y
else
y := y - PageTop;
DeConvertDim(x);
DeConvertDim(y);
End;
Procedure TPCDrawBox.DeConvertDim(var Dime: Double);
Begin
Dime := Dime / (DotsPerMil * ConvertRatio);
End;
Procedure TPCDrawBox.ConvertXY(var X,Y,Z: double);
Begin
ConvertDim(x);
ConvertDim(y);
if HorizontalZero = vzRight then
x := (PageLeft + PageWidth) - x
else
x := x + PageLeft;
if VerticalZero = vzBottom then
y := (PageTop + PageHeight) - y
else
y := PageTop + y;
x := x + ConvertDx;
y := y + ConvertDy;
End;
Procedure TPCDrawBox.ConvertDim(var Dime: Double);
Begin
Dime := Dime * (DotsPerMil * ConvertRatio);
End;
Procedure TPCDrawBox.SurfaceMove(Sender: TObject;Shift: TShiftState;
X, Y: Integer);
var xd,yd,z,dx,dy: Double;
Begin
//Self.SetFocus;
if xold <> -25000 then
begin
DrawGuideTrace(x,y);
end
else
begin
xold := -50000;
yold := -50000;
end;
dx := abs(dragStartxInt-x);
dy := abs(dragStartyInt-y);
if DragReadyInt and ((dx > 3) or (dy > 3)) then
begin
DragReadyInt := false;
OldCursor := Surface.Cursor;
if dragState = dsVScroll then
begin
SetCursor(crDefault);
end
else
if dragState = dsHScroll then
begin
SetCursor(crDefault);
end
else
if dragState = dsPan then
begin
SetCursor(crPan);
Screen.Cursor := crPan;
end
else
if dragState = dsDetPan then
begin
SetCursor(crPan);
Screen.Cursor := crPan;
end
else
if dragState = dsHRuler then
begin
SetCursor(crVSplit);
Screen.Cursor := crVSplit;
end
else
if dragState = dsVRuler then
begin
SetCursor(crHSplit);
Screen.Cursor := crVSplit;
end;
if (dragState = dsMod) or (dragState = dsMove) then
KillTraceFigure;
DragStarted;
Exit;
end
else
if isDragging then
begin
DragMove(x,y);
end;
if not (isDragging and (DragState in [dsPan])) then
begin
if (FDetailStyle = dsZoom) and PointInDetail(x,y) then
begin
z := CurrentZ;
xd := x;yd := y;
DetDeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnMouseTrace) then
SOnMouseTrace(Self,Shift,Xd,Yd);
MSTrace(Self,Shift,Xd,Yd);
end
else
begin
z := 0;
xd := x;yd := y;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnMouseTrace) then
SOnMouseTrace(Self,Shift,Xd,Yd);
MSTrace(Self,Shift,Xd,Yd);
//Tolik 20/01/2021
if Assigned(GCadForm) then
begin
if GArchLineH <> nil then
begin
GArchLineH.Move(0, y - GArchLineH.aP1.y);
GArchLineV.Move(x - GArchLineV.Ap1.x, 0);
if GCadForm.PCad.TraceFigure = nil then
begin
DrawShadowCrossPoints;
if GCadForm.cbMagnetWalls.Down then
DefineShadowCrossPoints(GCurrMousePos.x, GCurrMousePos.y);
end;
end;
end;
end;
end;
End;
Procedure TPCDrawBox.SurfaceClick(Sender:TObject);
Begin
If assigned(SOnMouseClick) then SOnMouseClick(Self);
MSClick(Self);
End;
Procedure TPCDrawBox.SurfaceDblClick(Sender:TObject);
Begin
If assigned(SOnMouseDblClick) then SOnMouseDblClick(Self);
MSDblClick(Self);
End;
Procedure TPCDrawBox.SurfaceLeave(Sender: TObject);
Begin
DrawGuideTrace(-50000,-50000);
If assigned(SOnMouseLeave) then SOnMouseLeave(Self);
MSLeave(Self);
End;
Procedure TPCDrawBox.SurfaceDragDrop(Sender, Source: TObject; X,Y: Integer);
var guType: TGuideType;
GuideX,GuideY: Double;
xd,yd,z: double;
xSource: Integer;
BBOx: TPaintBox;
Dist: Integer;
Begin
xSource := 0;
if Source = Surface then begin
xSource := oleds_Surface;
end else if Source is TPaintBox then begin
BBox := Source as TPaintBox;
if BBox.Name = 'BlockBox' then FBlockDrop := BBox.Hint;
xSource := oleDS_BlockBox;
end;
xd := x;
yd := y;
z := CurrentZ;
if (FDetailStyle = dsZoom) and PointInDetail(x,y) then
DetDeConvertXY(Xd,Yd,z)
else
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnDropDrag) then SOnDropDrag(Self,Source,Xd,Yd);
MSDropDrag(Self, xSource, Xd, Yd);
DragState := 0;
End;
Procedure TPCDrawBox.SurfaceDragEnd(Sender, Target: TObject; X,Y: Integer);
var xd,yd,z:Double;
Begin
xd := x;
yd := y;
z := CurrentZ;
if (FDetailStyle = dsZoom) and PointInDetail(x,y) then
DetDeConvertXY(Xd,Yd,z)
else
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnDragEnd) then SOnDragEnd(Self,Target,Xd,Yd);
MSEndDrag(Self, Target, X, Y);
DragState := 0;
End;
Procedure TPCDrawBox.SurfaceDragOver(Sender, Source: TObject; X,Y: Integer; State: TDragState; var Accept: Boolean);
var xd,yd,z: Double;
xSource: Integer;
Begin
xSource := 0;
if Source = Surface then
xSource := oleDS_Surface
else
if Source is TPaintBox then
xSource := oleDS_BlockBox;
SurfaceMove(Sender,[],X,Y);
xd := x; yd := y;z := CurrentZ;
if (FDetailStyle = dsZoom) and PointInDetail(x,y) then
DetDeConvertXY(Xd,Yd,z)
else
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnDragTrace) then
SOnDragTrace(Self,Source,Xd,Yd,State,Accept);
MSDragOver(Self, xSource, Xd, Yd, State, Accept);
End;
Procedure TPCDrawBox.SurfaceDragStart(Sender: TObject;var DragObject: TDragObject);
Begin
If assigned(SOnDragStart) then SOnDragStart(Self,DragObject);
IsDragging := True;
MSStartDrag(Sender,DragObject);
End;
Procedure TPCDrawBox.SurfacePull(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var xd,yd,z: Double;
Begin
if (ToolIdx = TPCTool(toFigure)) and (Button = mbMiddle) then
exit;
if (isDragging or DragReadyInt) and (DragState in [dsHScroll,dsVScroll,dsPan,dsDetPan,dsHRuler,dsVRuler]) then
begin
// if GCadForm.PCad.GuidesVisible then
DragDropped(x,y);
end
else
if (FDetailStyle = dsZoom) and PointInDetail(x,y) then
begin
DetailHit := True;
DetailHitPoint:= Point(x,y);
xd := x;
yd := y;
z := CurrentZ;
DetDeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnMousePull) then SOnMousePull(Self,Button,Shift,Xd,Yd);
MSPull(Self,Button,Shift,Xd,Yd);
end
else
begin
DetailHit := False;
xd := x;
yd := y;
z := 0;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnMousePull) then SOnMousePull(Self,Button,Shift,Xd,Yd);
MSPull(Self,Button,Shift,Xd,Yd);
end;
End;
Procedure TPCDrawBox.SurfacePush(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var xd,yd,z: Double;
xCanvas:TCanvas;
fig: TFigure;
odactive: Boolean;
Begin
if GArchLineH <> nil then
begin
//GArchLineH.Move(0, y - GArchLineH.aP1.y);
//GArchLineV.Move(x - GArchLineV.Ap1.x, 0);
if GCadForm.PCad.TraceFigure = nil then
begin
//if GCadForm.cbMagnetWalls.Down then
// DrawShadowCrossPoints;
//if GCadForm.cbMagnetWalls.Down then
// DefineShadowCrossPoints(GCurrMousePos.x, GCurrMousePos.y);
end;
end;
GotFocus(Self);
odactive := DetailActive;
DetailActive := False;
CurrentModPoint := nil;
if PointInHScroll(x,y) then
begin
DragStartXInt := x;
OldPosX := HSCBarPosition;
DragState := dsHScroll;
DragReadyInt := True;
xCanvas :=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,True,False);
end
else
if PointInVScroll(x,y) then
begin
DragStartYInt := y;
OldPosY := VSCBarPosition;
DragState := dsVScroll;
DragReadyInt := True;
xCanvas :=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,False,True);
end
else
if PointInHRuler(x,y) then
begin
DragStartYInt := y;
DragStartXInt := x;
DragOldx := x;
DragOldY := y;
DragState := dsHRuler;
DragReadyInt := True;
end
else
if PointInVRuler(x,y) then
begin
DragStartYInt := y;
DragStartXInt := x;
DragOldx := x;
DragOldY := y;
DragState := dsVRuler;
DragReadyInt := True;
end
else
if (Button = mbMiddle) and (PointInDetail(x,y)) then
begin
DetailActive := True;
DragStartXInt := x;
DragStartYInt := y;
//OldPosY := VSCBarPosition;
//OldPosX := HSCBarPosition;
DragState := dsDetPan;
DragReadyInt := True;
//xCanvas :=GetActiveCanvas;
//DrawScrollsToCanvas(xCanvas,True,False,True);
end
else if PointInDetail(x,y) then
begin
DetailActive := True;
xd := x;
yd := y;
z := 0;
CurrentZ := 0;
DetailHit := True;
DetailHitPoint := Point(x,y);
If assigned(SOnMousePush) then SOnMousePush(Self,Button,Shift,Xd,Yd);
if ToolIdx = toSelect then begin
CurrentModPoint := HitTestModPointDetVal(x,y);
if assigned(CurrentModPoint) then
begin
z := CurrentModPoint.CoordZ;
CurrentZ := z;
end else if FDetailStyle = dsIsometry then begin
CurrentIsoFigure := nil;
fig := nil;
fig := CheckByPointInt(ActiveLayer,x,y);
if assigned(fig) then begin
CurrentIsoFigure := fig;
end;
end;
end;
DetDeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
MSPush(Self,Button,Shift,Xd,Yd);
CurrentIsoFigure := nil;
if FDetailStyle = dsIsometry then begin
MSPull(Self,Button,Shift,Xd,Yd);
end;
CurrentModPoint := nil;
end
else
if (Button = mbMiddle) and (not PointInDetail(x,y)) then
begin
if ToolIdx <> TPCTool(toFigure) then
begin
DragStartXInt := x;
DragStartYInt := y;
OldPosY := VSCBarPosition;
OldPosX := HSCBarPosition;
DragState := dsPan;
DragReadyInt := True;
xCanvas :=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,False,True);
end;
end
else
if FIsometric then
begin
DetailHit := False;
xd := x;
yd := y;
z := 0;
CurrentZ := 0;
If assigned(SOnMousePush) then SOnMousePush(Self,Button,Shift,Xd,Yd);
if ToolIdx = toSelect then begin
CurrentModPoint := HitTestModPointIntVal(x,y);
if assigned(CurrentModPoint) then
begin
z := CurrentModPoint.CoordZ;
CurrentZ := z;
end else begin
CurrentIsoFigure := nil;
fig := nil;
fig := CheckByPointInt(ActiveLayer,x,y);
if assigned(fig) then begin
CurrentIsoFigure := fig;
end;
end;
end;
IsoDeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
MSPush(Self,Button,Shift,Xd,Yd);
CurrentIsoFigure := nil;
CurrentModPoint := nil;
end
else
begin
xd := x;
yd := y;
z := 0;
DetailHit := False;
CurrentModPoint := nil;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
MSPush(Self,Button,Shift,Xd,Yd);
If assigned(SOnMousePush) then SOnMousePush(Self,Button,Shift,Xd,Yd);
end;
if detailActive <> odActive then Refresh;
End;
Procedure TPCDrawBox.LostFocus(sender:Tobject);
Begin
Container.SetFocus;
End;
Procedure TPCDrawBox.drawguideTrace(x,y: integer);
var alfa : extended;
xCanvas: TCanvas;
z,xd,yd: Double;
begin
if Locked then
exit;
if (csDesigning in self.ComponentState) then
exit;
xCanvas := GetActiveCanvas;
ClipToUnScrollRegion;
try
with xCanvas do
begin
pen.color := clRed xor clWhite;
pen.width := 1;
pen.style := psSolid;
pen.mode := pmXor;
brush.style := bsSolid;
brush.Color := clRed xor clWhite;;
if (SnapXOld <> -50000) then
begin
Ellipse(SnapXOld-4,SnapYOld-4,SnapXOld+4,SnapYOld+4);
end;
if (SnapX <> -50000) then
begin
Ellipse(SnapX-4,SnapY-4,SnapX+4,SnapY+4);
end;
pen.color := clBlue xor clWhite;
pen.style := psDot;
brush.style := bsClear;
if FDrawInCursor then
begin
pen.style := psSolid;
if (xold <> - 50000) then
begin
moveto(xold-8,yold);
lineto(xold+8,yold);
moveto(xold,yold-8);
lineto(xold,yold+8);
end;
if x <> - 50000 then
begin
moveto(x-8,y);
lineto(x+8,y);
moveto(x,y-8);
lineto(x,y+8);
end;
pen.style := psDot;
end;
case (FGuideTrace) of
gtNone: begin
if RulerVisible then begin
if (xold <> - 50000) then
begin
moveto(0,yold);lineto(30,yold);
moveto(xold,0);lineto(xold,30);
end;
if x <> - 50000 then
begin
moveto(0,y);lineto(30,y);
moveto(x,0);lineto(x,30);
end;
end;
end;
gtNinty: begin
if xold <> - 50000 then
begin
moveto(0,yold);lineto(SurfaceWidth,yold);
moveto(xold,0);lineto(xold,SurfaceHeight);
end;
if x <> - 50000 then
begin
moveto(0,y);lineto(SurfaceWidth,y);
moveto(x,0);lineto(x,SurfaceHeight);
end;
end;
gtFortyFive: begin
alfa := (2*pi)/8;
if xold <> - 50000 then
begin
moveto(0,yold-round(tan(alfa)*xold));lineto(SurfaceWidth,yold+round(tan(alfa)*(SurfaceWidth-xold)));
moveto(0,yold+round(tan(alfa)*xold));lineto(SurfaceWidth,yold-round(tan(alfa)*(SurfaceWidth-xold)));
end;
if x <> - 50000 then
begin
moveto(0,y-round(tan(alfa)*x));lineto(SurfaceWidth,y+round(tan(alfa)*(SurfaceWidth-x)));
moveto(0,y+round(tan(alfa)*x));lineto(SurfaceWidth,y-round(tan(alfa)*(SurfaceWidth-x)));
end;
end;
gtThirty: begin
alfa := (2*pi)/12;
if xold <> - 50000 then
begin
moveto(0,yold-round(tan(alfa)*xold));lineto(SurfaceWidth,yold+round(tan(alfa)*(SurfaceWidth-xold)));
moveto(0,yold+round(tan(alfa)*xold));lineto(SurfaceWidth,yold-round(tan(alfa)*(SurfaceWidth-xold)));
end;
if x <> - 50000 then
begin
moveto(0,y-round(tan(alfa)*x));lineto(SurfaceWidth,y+round(tan(alfa)*(SurfaceWidth-x)));
moveto(0,y+round(tan(alfa)*x));lineto(SurfaceWidth,y-round(tan(alfa)*(SurfaceWidth-x)));
end;
end;
gtsixty: begin
alfa := (2*pi)/6;
if xold <> - 50000 then
begin
moveto(0,yold-round(tan(alfa)*xold));lineto(SurfaceWidth,yold+round(tan(alfa)*(SurfaceWidth-xold)));
moveto(0,yold+round(tan(alfa)*xold));lineto(SurfaceWidth,yold-round(tan(alfa)*(SurfaceWidth-xold)));
end;
if x <> - 50000 then
begin
moveto(0,y-round(tan(alfa)*x));lineto(SurfaceWidth,y+round(tan(alfa)*(SurfaceWidth-x)));
moveto(0,y+round(tan(alfa)*x));lineto(SurfaceWidth,y-round(tan(alfa)*(SurfaceWidth-x)));
end;
end;
gtCustom: begin
if assigned(FCustomGuideTrace) then
begin
if xold <> - 50000 then
begin
z := 0;
xd := xold;yd := yold;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
FCustomGuideTrace(Self,xold,yold,xd,yd,xCanvas);
end;
if x <> - 50000 then
begin
z := 0;
xd := x;yd := y;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
FCustomGuideTrace(Self,x,y,xd,yd,xCanvas);
end;
end;
if assigned(FCustomGuideTraceVB) then
begin
if xold <> - 50000 then
begin
z := 0;
xd := xold;yd := yold;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
FCustomGuideTraceVB(Self,xold,yold,xd,yd,xCanvas.Handle);
end;
if x <> - 50000 then
begin
z := 0;
xd := x;yd := y;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
FCustomGuideTraceVB(Self,x,y,xd,yd,xCanvas.Handle);
end;
end;
end;
end;
yold := y;
xold := x;
SnapXOld := SnapX;
SnapYOld := SnapY;
end;
except
end;
UnClip;
end;
Procedure TPCDrawBox.checktoSnap(var x,y : Double);
var xx,yy,z: Double;
begin
SnapX := -50000;
SnapY := -50000;
if (ToolIdx = toZoom) or (ToolIdx = toDetailZoom) then exit;
if (ToolIdx = toSelect) then
begin
if not IsDragging then exit;
end;
xx := x;
yy := y;
CalculateSnapPoint(x,y);
if (xx<> x) or (yy <> y) then begin
xx := x;
yy := y;
Dengine.ConvertCoord(xx,yy,z);
SnapX := Round(xx);
SnapY := Round(yy);
end;
end;
//Procedure TPCDrawBox.CalculateSnapPoint(var x,y : Double);
Function TPCDrawBox.CalculateSnapPoint(var x,y : Double): Boolean;
Type DistRec = Record
Dist : Double;
Coord : Double;
end;
Var SnapDistance : Double;
Coord: Double;
gnumberv,gnumberh,a: integer;
DistGridx,DistGridy : DistRec;
DistGuideX,DistGuideY : Distrec;
DistNearx,DistNeary : DistRec;
NearX,NearY: Double;
Guide: TGuideLine;
grStep : double;
mx: Integer;
mval: Double;
workw,workh: Double;
dpm: double;
distx, disty: Double;
Begin
result := false;
if SnapLocked then exit;
snapDistance := 12/dotspermil; // 12 pixel
distGridx.dist := SnapDistance;
distGridy.dist := SnapDistance;
distGridx.coord := x;
distGridy.coord := y;
distGuidex.dist := SnapDistance;
distGuidey.dist := SnapDistance;
distGuidex.coord := x;
distGuidey.coord := y;
distNearx.dist := SnapDistance;
distNeary.dist := SnapDistance;
distNearx.coord := x;
distNeary.coord := y;
{
if GCadForm.cbMagnetWalls.Down then
begin
DefineShadowCrossPoints(x ,y);
if ((GWallPathPointX <> nil) or (GWallPathPointY <> nil)) then
begin
//Tolik 20/01/2022 --
if GWallPathPointX <> nil then
begin
X := GWallPathPointX.x;
distx := RoundN(Sqrt(sqr(GWallPathPointX.x - x) + sqr(GWallPathPointX.y - y)), 6);
if distx <= 1 then
Y := GWallPathPointX.y;
end;
if GWallPathPointY <> nil then
begin
if GWallPathPointX = nil then
begin
disty := RoundN(Sqrt(sqr(GWallPathPointY.x - x) + sqr(GWallPathPointY.y - y)), 6);
Y := GWallPathPointY.y;
if disty <= 1 then
X := GWallPathPointY.x;
end
else
begin
if Distx > 1 then
begin
if Disty <= 1 then
Y := GWallPathPointY.y;
end;
end;
end;
exit;
end;
end
else
begin
DrawGuideTrace(Round(x),Round(y));
exit;
end;
}
//
If FSnapToNPoint then
begin
NearX := X;
NearY := Y;
if SnapToFigures(NearX,NearY) then
begin
x := NearX;
y := NearY;
exit;
end;
end;
if FsnaptoGrids then
begin
if RulerSystem = rsMetric then
begin
WorkW := FWorkWidth;
WorkH := FWorkHeight;
dpm := DotsPerMil;
grStep := FGridStep;
end
else
begin
WorkW := ((FWorkWidth)/25.4)*16;
WorkH := ((FWorkHeight)/25.4)*16;
dpm := DotsPerMil;
grStep := (FGridStep/16)*25.4;
end;
gnumberv := trunc(workw / FGridStep) ;
if Fworkwidth = gnumberv*FGridStep then
gnumberv := gnumberv - 1;
gnumberh := trunc(workh / FGridStep) ;
if Fworkheight = gnumberh*FGridStep then
gnumberh := gnumberh - 1;
for a := 1 to gnumberv do
begin
if HorizontalZero = vzRight then
coord := FWorkWidth-a*grStep
else
coord := a*grStep;
if abs(coord - x) < DistGridx.dist then
begin
distGridx.dist := abs(coord - x);
distGridx.coord := coord;
end;
end;
for a := 1 to gnumberh do
begin
if VerticalZero = vzBottom then
coord := FWorkHeight-(a*GrStep)
else
coord := a*grStep;
if abs(coord - y) < DistGridy.dist then
begin
distGridy.dist := abs(coord - y);
distGridy.coord := coord;
end;
end;
end;
If FSnapToGuides then
begin
for a := 0 to guides.count-1 do
begin
Guide := TGuideline(guides[a]);
If guide.gType = gtHorz then
begin
If abs(guide.coord - y) < distguidey.dist then
begin
distGuidey.dist := abs(guide.coord - y);
distGuidey.coord := guide.coord;
Result := true
end;
end
else
begin
If abs(guide.coord - x) < distguidex.dist then
begin
distGuidex.dist := abs(guide.coord - x);
distGuidex.coord := guide.coord;
result := true;
end;
end;
end;
end;
mx := 0; mval := DistGridx.dist;
if DistGuidex.dist < mval then
begin
mVal := DistGuidex.dist;
mx := 1;
end;
if DistNearx.dist < mval then
begin
mVal := DistGuidex.dist;
mx := 2;
end;
if mx = 0 then x := DistGridx.coord
else if mx = 1 then x := DistGuidex.coord
else if mx = 2 then x := DistNearX.coord;
mx := 0; mval := DistGridy.dist;
if DistGuidey.dist < mval then
begin
mVal := DistGuidey.dist;
mx := 1;
end;
if DistNeary.dist < mval then
begin
mVal := DistGuidey.dist;
mx := 2;
end;
if mx = 0 then y := DistGridy.coord
else if mx = 1 then y := DistGuidey.coord
else if mx = 2 then y := DistNeary.coord;
end;
Procedure TPCDrawBox.MSPush(sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Double);begin end;
procedure TPCDrawBox.MSTrace(Sender: TObject; Shift: TShiftState; X,Y: Double);begin end;
procedure TPCDrawBox.MSPull(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double);begin end;
procedure TPCDrawBox.MSDropDrag(Sender: TObject;Source:Integer; X, Y: Double);begin end;
procedure TPCDrawBox.MSDragOver(Sender: TObject;Source:Integer; X, Y: Double;State: TDragState; var Accept: Boolean);begin end;
procedure TPCDrawBox.MSEndDrag(Sender, Target: TObject; X, Y: Double);begin end;
procedure TPCDrawBox.MSStartDrag(Sender: TObject; var DragObject: TDragObject);
begin end;
procedure TPCDrawBox.MSClick(Sender: TObject);begin end;
procedure TPCDrawBox.MSDblClick(Sender: TObject);begin end;
Procedure TPCDrawBox.MSLeave(Sender: TObject);begin end;
Procedure TPCDrawBox.SyncEnv;
begin
end;
Procedure TPCDrawBox.Refresh;
begin
end;
Procedure TPCDrawBox.ResetActions;
Begin
End;
Procedure TPCDrawBox.ResetRegions;
Begin
End;
procedure TPCDrawBox.DrawToCanvas(Canvas: TCanvas);
var
a4H: Double;
Begin
with canvas do
begin
Brush.Color := FPageColor;
Brush.Style := bsSolid;
Pen.Mode:= pmCopy;
Pen.Style:= psSolid;
if BackGround = clBlack then
Pen.Color:= ClWhite
else
Pen.Color:= ClBlack;
Pen.Width := 1;
if FDrawPageBorder then
Rectangle(PageLeft, PageTop, PageLeft + PageWidth, PageTop + PageHeight);
If assigned(FBeforePaint) then
FBeforePaint(self);
Brush.Color := clWhite;
Brush.Style := bsClear;
if FShadow then
begin
Pen.Width := 2;
MoveTo(PageLeft + PageWidth + 1, PageTop + round(2 * DotsPerMil));
LineTo(PageLeft + PageWidth + 1, PageTop + PageHeight);
MoveTo(PageLeft + round(2 * DotsPerMil), PageTop + PageHeight + 1);
LineTo(PageLeft + PageWidth, PageTop + PageHeight + 1);
end;
if FGrids then
begin
DrawGrids(Canvas);
end;
{Mityai} //D0000006303
//if Assigned(GCadForm) then
if (FGuides)and(GuidesVisible) then
begin
DrawGuides(Canvas);
end;
if FCenterGuide then
begin
Pen.Style := psDot;
Pen.Color := clGreen;
Pen.width := 1;
Pen.mode := pmCopy;
Brush.Style := bsClear;
moveto(PageLeft + PageWidth div 2, PageTop + 1);
lineto(PageLeft + PageWidth div 2, PageTop + PageHeight - 1);
moveto(PageLeft + 1, PageTop + PageHeight div 2);
lineto(PageLeft+PageWidth - 1, PageTop + PageHeight div 2);
end;
if FPageGuide then
begin
Pen.Style := psDot;
Pen.Color := clGreen;
Pen.width := 1;
Pen.mode := pmCopy;
Brush.Style := bsClear;
a4H := 300;
Dengine.ConvertDim(a4H);
moveto(PageLeft, PageTop + PageHeight - round(a4H));
lineto(PageLeft + PageWidth - 1, PageTop + PageHeight - round(a4H));
a4H := 450;
Dengine.ConvertDim(a4H);
moveto(PageLeft, PageTop + PageHeight - round(a4H));
lineto(PageLeft + PageWidth - 1, PageTop + PageHeight - round(a4H));
a4H := 900;
Dengine.ConvertDim(a4H);
moveto(PageLeft, PageTop + PageHeight - round(a4H));
lineto(PageLeft + PageWidth - 1, PageTop + PageHeight - round(a4H));
end;
end;
end;
procedure TPCDrawBox.DrawGrids(Canvas: TCanvas);
var
gnumberv, gnumberh, a, b: integer;
z: double;
grx, gry: Double;
grStep: double;
workw, workh: Double;
dpm: double;
begin
if RulerSystem = rsMetric then
begin
WorkW := FWorkWidth;
WorkH := FWorkHeight;
dpm := DotsPerMil;
grStep := FGridStep;
end
else
begin
WorkW := ((FWorkWidth) / 25.4) * 16;
WorkH := ((FWorkHeight) / 25.4) * 16;
dpm := DotsPerMil;
grStep := (FGridStep / 16) * 25.4;
end;
with Canvas do
begin
Pen.Style := pssolid;
Pen.Color := FgridColor;
Pen.width := 1;
Pen.mode := pmCopy;
Brush.Style := bsClear;
gnumberv := trunc(workw / FGridStep) ;
if Fworkwidth * dotspermil <= gnumberv * FGridStep * dotspermil + 2 then
gnumberv := gnumberv - 1;
gnumberh := trunc(workh / FGridStep) ;
if Fworkheight * dotspermil <= gnumberh * FGridStep * dotspermil + 2 then
gnumberh := gnumberh - 1;
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if FGridType = grtLine then
begin
for a := 1 to gnumberv do
begin
if HorizontalZero = vzRight then
Dengine.drawline(FWorkWidth - a * grStep,(1 / dotspermil), FWorkWidth - a * grStep, FWorkHeight - (1 / dotspermil), FGridColor, 1, ord(psSolid), 0)
else
Dengine.drawline(a*grStep,(1/dotspermil),a*grStep,FWorkHeight-(1/dotspermil),FGridColor,1,ord(psSolid),0);
end;
for a := 1 to gnumberh do
begin
if VerticalZero = vzBottom then
Dengine.drawline((1/dotspermil),FWorkHeight-(a*GrStep),FWorkWidth-(1/dotspermil),FWorkHeight-(a*GrStep),FGridColor,1,ord(psSolid),0)
else
Dengine.drawline((1/dotspermil),(a*GrStep),FWorkWidth-(1/dotspermil),(a*GrStep),FGridColor,1,ord(psSolid),0);
end;
end
else
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if FGridType = grtPoint then
begin
for a := 1 to gnumberv do
begin
for b := 1 to gnumberh do
begin
if HorizontalZero = vzRight then
grx := FWorkWidth-(a * GrStep)
else
grx := (a*GrStep);
if VerticalZero = vzBottom then
gry := FWorkHeight-(b * grStep)
else
gry := (b*grStep);
DEngine.DrawPoint(DoublePOint(grx,gry),FGridColor);
end;
end;
end
else
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
for a := 1 to gnumberv do
begin
for b := 1 to gnumberh do
begin
if HorizontalZero = vzRight then
grx := FWorkWidth - (a * GrStep)
else
grx := (a * GrStep);
if VerticalZero = vzBottom then
gry := FWorkHeight - (b * grStep)
else
gry := (b * grStep);
Dengine.DrawCross(DoublePoint(grx,gry),FGridColor,1,ord(psSolid),2,False);
end;
end;
end;
end;
end;
procedure TPCDrawBox.DrawGuides(Canvas: TCanvas);
var a: integer;
g: TGuideLine;
gx,gy,z: double;
x1,x2,y1,y2: Double;
begin
DEngine.Canvas.Pen.mode := pmXor;
For a := 0 to Guides.Count -1 do
begin
g := TGuideLine(Guides[a]);
if ((not g.fautoCr) or GShowAutoCreatedGuides) then
begin
gx := g.coord;
gy := g.coord;
x1 := 0;
y1 := 0;
z := 0;
x2 := SurfaceWidth;
y2 := SurfaceHeight;
DEngine.DeConvertCoord(x1, y1, z);
DEngine.DeConvertCoord(x2, y2, z);
if g.gType = gtHorz then
begin
DEngine.drawline(x1, gy, x2, gy, FGuideColor xor FbackGround, 1, ord(psSolid), 0);
end
else
begin
DEngine.drawline(gx, y1, gx, y2, FGuideColor xor FbackGround, 1, ord(psSolid), 0);
end;
end;
end;
DEngine.Canvas.Pen.mode := pmCopy;
end;
procedure TPCDrawBox.DrawCenterGuide(Canvas: TCanvas);
begin
with canvas do
begin
if FCenterGuide then
begin
Pen.Style := psDot;
Pen.Color := clGreen;
Pen.width := 1;
Pen.mode := pmCopy;
Brush.Style := bsClear;
moveto(PageLeft + PageWidth div 2, PageTop + 1);
lineto(PageLeft + PageWidth div 2, PageTop + PageHeight - 1);
moveto(PageLeft + 1, PageTop + PageHeight div 2);
lineto(PageLeft+PageWidth - 1, PageTop + PageHeight div 2);
end;
end;
end;
procedure TPCDrawBox.DrawGuidesTop(Canvas: TCanvas);
var a: integer;
g: TGuideLine;
gx,gy,z: double;
x1,x2,y1,y2: Double;
begin
DEngine.Canvas.Pen.mode := pmCopy;
For a := 0 to Guides.Count -1 do
begin
g := TGuideLine(Guides[a]);
if ((not g.fautoCr) or GShowAutoCreatedGuides) then
begin
gx := g.coord;
gy := g.coord;
x1 := 0;
y1 := 0;
z := 0;
x2 := SurfaceWidth;
y2 := SurfaceHeight;
DEngine.DeConvertCoord(x1, y1, z);
DEngine.DeConvertCoord(x2, y2, z);
if g.gType = gtHorz then
begin
DEngine.drawline(x1, gy, x2, gy, FbackGround or FbackGround, 1, ord(psSolid), 0);
end
else
begin
DEngine.drawline(gx, y1, gx, y2, FbackGround or FbackGround, 1, ord(psSolid), 0);
end;
end;
end;
// DEngine.Canvas.Pen.mode := pmXor;
end;
Function TPCDrawBox.SnapToFigures(var x, y: double):Boolean;
begin
result := false;
end;
procedure TPCDrawBox.SetTool(aToolIndex: TPCTool; aToolInfo: String;aToolData:Integer);
var sub:string;
p: Integer;
begin
if aToolIndex = toFigure then begin
p := Pos('>',aToolInfo);
if p > 0 then begin
sub := Copy(aToolInfo,p+1,Length(aToolInfo)-p);
aToolInfo := Copy(aToolInfo,1,p-1);
CurrentUserClass := Sub;
end;
end;
fToolInfo := aToolInfo;
fToolIdx := aToolIndex;
fToolData := aToolData;
case fToolIdx of
toSelect : SetCursor(crDefault);
toZoom,toDetailZoom : SetCursor(crZoom);
toLocate:SetCursor(crLocate);
toDelete:SetCursor(crDelete);
toMWAnd:SetCursor(crUpArrow);
else SetCursor(crCross);
end;
SyncEnv;
end;
// Tolik 14/04/2021 --
function TPCDrawBox.CheckGuideLine(x, y: Double): Boolean;
var g : TGuideLine;
gx,gy,z : Double;
a : Integer;
Begin
result := False;
if TF_CAD(parent).FCreateObjectOnClick then
exit;
if not GuidesVisible then // <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
exit;
z := 0;
Convertxy(x,y,z);
try
For a := 0 to Guides.Count -1 do
begin
g := TGuideLine(Guides[a]);
if ((not g.fautoCr) or GShowAutoCreatedGuides) then // <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
gx := g.coord;
gy := g.coord;
z := 0;
ConvertXY(gx,gy,z);
if (g.gType = gtHorz) and (abs(y-gy) < 3) then
begin
GuideYold := Round(gy);
BeginHRulerDrag;
Guides.Remove(g);
GAutoCreatedGuide := g.fautoCr;
g.Free;
result := true;
exit;
end;
if (g.gType = gtVert) and (abs(x - gx) < 3) then
begin
GuideXold := Round(gx);
BeginVRulerDrag;
Guides.Remove(g);
GAutoCreatedGuide := g.fautoCr;
g.Free;
result := true;
exit;
end;
end;
end;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawBox.CheckGuideLine' + E.Message);
end;
end;
(*
function TPCDrawBox.CheckGuideLine(x, y: Double): Boolean;
var g : TGuideLine;
gx,gy,z : Double;
a : Integer;
Begin
result := False;
if TF_CAD(parent).FCreateObjectOnClick then
exit;
z := 0;
Convertxy(x,y,z);
try
For a := 0 to Guides.Count -1 do
begin
g := TGuideLine(Guides[a]);
gx := g.coord;
gy := g.coord;
z := 0;
ConvertXY(gx,gy,z);
if (g.gType = gtHorz) and (abs(y-gy) < 3) then
begin
GuideYold := Round(gy);
BeginHRulerDrag;
Guides.Remove(g);
g.Free;
result := true;
exit;
end;
if (g.gType = gtVert) and (abs(x - gx) < 3) then
begin
GuideXold := Round(gx);
BeginVRulerDrag;
Guides.Remove(g);
g.Free;
result := true;
exit;
end;
end;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawBox.CheckGuideLine' + E.Message);
end;
end;
*)
procedure TPCDrawBox.setPageColor(Value: TColor);
begin
FPageColor := Value;
if autorefresh then DoSurfacePaint(Surface);
evPageColor.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
destructor TPCDrawBox.Destroy;
begin
// Tolik
if Self.rVRgn <> 0 then
DeleteObject(Self.rVRgn);
if Self.HsRgn <> 0 then
DeleteObject(Self.HsRgn);
if Self.rHRgn <> 0 then
DeleteObject(Self.rHRgn);
if Self.VsRgn <> 0 then
DeleteObject(Self.VsRgn);
if Self.TempBitmap <> nil then
begin
// TempBitmap.FreeImage;
FreeAndNil(TempBitmap);
end;
if Self.BaseBitmap <> nil then
//Self.BaseBitmap.FreeImage;
FreeAndNil(BaseBitmap);
//
ClearGuides;
Guides.Free;
GuidesCreatedOnDropCompon.Free;
DEngine.Free;
//Tolik
{ Container.OnResize := nil;
Surface.Visible := False;
Surface.Parent := nil;
Surface.OnPaint := nil;
Surface.OnMouseMove := nil;
Surface.OnClick := nil;
Surface.OnDblClick := nil;
Surface.OnMouseLeave := nil;
Surface.OnDragDrop := nil;
Surface.OnEndDrag := nil;
Surface.OnDragOver := nil;
Surface.OnStartDrag := nil;
Surface.OnMouseUp := nil;
Surface.OnMouseDown := nil;
Surface.OnMouseWheel := nil;
Surface.OnMiddleDblClick := nil;
FreeAndNil(Surface);}
//
inherited destroy;
end;
function TPCDrawBox.GetSelectionRect: TDoubleRect;
begin
//***
end;
function TPCDrawBox.GetDrawingRect: TDoubleRect;
begin
//***
end;
procedure TPCDrawBox.SetCursor(cr: TCursor);
begin
Surface.Cursor := cr;
if assigned(FCursorChange) then FCursorChange(Self,cr);
end;
function TPCDrawBox.SurfaceHeight: Integer;
var wndRect:Trect;
begin
if CustomWnd <> 0 then
begin
if Windows.GetWindowRect(CustomWnd,wndRect) then
Result := Abs(wndRect.top-wndrect.bottom)-FSurfaceMargin
else
Result := 300;
end
else
begin
result:= Surface.Height;
end;
end;
function TPCDrawBox.SurfaceWidth: Integer;
var wndRect:Trect;
begin
if CustomWnd <> 0 then
begin
if Windows.GetWindowRect(CustomWnd,wndRect) then
Result := Abs(wndRect.left-wndrect.right)-FSurfaceMargin
else
result := 300;
end
else
begin
result:= Surface.Width;
end;
end;
procedure TPCDrawBox.SetScrollPositions(hPos, vPos: Integer);
begin
scHorzPos := hPos;
scVertPos := vPos;
ScHorzPos := hPos;
ScVertPos := vPos;
if FResetRegionsOnZoomScroll then //07.08.2012
ResetRegions;
if autorefresh then
DoSurfacePaint(Surface);
end;
function TPCDrawBox.HSCBarPosition: Integer;
begin
result := scHorzPos;
end;
function TPCDrawBox.VSCBarPosition: Integer;
begin
result := scVertPos;
end;
procedure TPCDrawBox.DrawGuideOnSurface(x,y:Integer;guType:TGuideType; needDraw: boolean = True);
var xCanvas:TCanvas;
begin
if (needDraw or GShowAutoCreatedGuides) then
begin
xCanvas:= GetActiveCanvas;
ClipToUnScrollRegion;
with xCanvas do
begin
Pen.Mode := pmXor;
Pen.Style := psSolid;
pen.Color := FBackGround xor FGuideColor;
Brush.Style := bsClear;
if guType = gtHorz then
begin
if abs(guideYold - Y)> 3 then
begin
MoveTo(0,guideYold);
LineTo(SurfaceWidth,guideYold);
MoveTo(0,Y);
LineTo(SurfaceWidth,Y);
guideYold := y;
end;
end
else
begin
if abs(guideXold - X) > 3 then
begin
MoveTo(guideXold,0);
LineTo(guideXold,SurfaceHeight);
MoveTo(X,0);
LineTo(X,SurfaceHeight);
guideXold := x;
end;
end;
end;
UnClip;
end;
end;
procedure TPCDrawBox.DoSurfaceClick;
begin
SurfaceClick(nil);
end;
procedure TPCDrawBox.DoSurfaceDblClick;
begin
SurfaceDblClick(nil);
end;
procedure TPCDrawBox.DoSurfaceDragDrop(Source, X, Y: Integer);
var guType: TGuideType;
GuideX,GuideY: Double;
xd,yd,z: double;
Dist: Integer;
Begin
xd := x;
yd := y;
z := 0;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnDropDrag) then SOnDropDrag(Self,nil,Xd,Yd);
MSDropDrag(Self,Source, Xd, Yd);
DragState := 0;
end;
procedure TPCDrawBox.DoSurfaceDragEnd(X, Y: Integer);
begin
SurfaceDragEnd(nil,nil,x,y);
DragState := 0;
end;
Procedure TPCDrawBox.DoSurfaceDragStart(Sender: TObject;var DragObject: TDragObject);
begin
SurfaceDragStart(Sender,DragObject);
end;
procedure TPCDrawBox.DoSurfaceDragOver(Source, X, Y, State: Integer;
var Accept: Boolean);
var xd,yd,z: Double;
guType:TGuideType;
dist: Integer;
xCanvas: TCanvas;
Begin
if (source = oleDS_Surface) then
begin
Accept := True;
if DragState = dsHScroll then
begin
Dist := x-round(DragStartXInt);
SetHScrollDelta(Dist,False);
xCanvas:=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,True,False);
exit;
end
else
if DragState = dsVScroll then
begin
Dist := y-round(DragStartYInt);
SetVScrollDelta(Dist,False);
xCanvas:=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,False,True);
exit;
end
else
if DragState = dsPan then
begin
Dist := x-round(DragStartXInt);
SetHScrollDelta(Dist,False);
Dist := y-round(DragStartYInt);
SetVScrollDelta(Dist,False);
xCanvas:=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,False,True);
exit;
end
else
if DragState = dsDetPan then
begin
Dist := x-round(DragStartXInt);
FDetailLeft := FDetailLeft-dist;
Dist := y-round(DragStartYInt);
FDetailTop := FDetailTop-dist;
exit;
end
else
if DragState = dsHRuler then
begin
guType := gtHorz;
DrawGuideOnSurface(x,y,guType);
exit;
end
else
if DragState = dsVRuler then
begin
guType := gtVert;
DrawGuideOnSurface(x,y,guType);
exit;
end;
end;
SurfaceMove(nil,[],X,Y);
xd := x; yd := y; z := 0;
DeConvertXY(Xd,Yd,z);
CheckToSnap(Xd,Yd);
If assigned(SOnDragTrace) then SOnDragTrace(Self,nil,Xd,Yd,TDragState(State),Accept);
MSDragOver(Self, Source, Xd, Yd, TDragState(State), Accept);
end;
procedure TPCDrawBox.DragStarted;
begin
isDragging := True;
end;
procedure TPCDrawBox.DoSurfaceLeave;
begin
SurfaceLeave(nil);
end;
procedure TPCDrawBox.DoSurfaceMove(Shift, X, Y: Integer);
var dShift:TShiftState;
begin
dShift := OleShiftToDelphiSet(shift);
SurfaceMove(nil,dShift,x,y);
end;
procedure TPCDrawBox.DoSurfacePull(Button: Integer; Shift, X, Y: Integer);
begin
SurfacePull(nil,TMouseButton(Button),OleShiftToDelphiSet(shift),x,y);
end;
procedure TPCDrawBox.DoSurfacePush(Button, Shift, X, Y: Integer);
begin
SurfacePush(nil,TMouseButton(Button),OleShiftToDelphiSet(shift),x,y);
end;
procedure TPCDrawBox.BeginHRulerDrag;
begin
{Mityai} //D0000006303
if GuidesVisible then
DragState := dsHRuler;
SetCursor(crVSplit);
DragStarted;
KillTraceFigure;
end;
procedure TPCDrawBox.BeginVRulerDrag;
begin
{Mityai} //D0000006303
if GuidesVisible then
DragState := dsVRuler;
SetCursor(crHSplit);
DragStarted;
KillTraceFigure;
end;
procedure TPCDrawBox.SetCustomSurface(CWindow: HWnD; CDC:HDC);
begin
inherited;
DoPageLocate;
end;
function TPCDrawBox.GetBackColor: TColor;
begin
result := FBackGround;
end;
procedure TPCDrawBox.DrawRulersToCanvas(Canvas: TCanvas);
var cPoint: TPoint;
dmm,hmm,mm,hcm,cm,dm,m,dam: extended;
steps : array [1..3] of Extended;
step : Extended;
textcounter,len,number,a,coord,text: integer;
inch : real;
factor : double;
rCanvas: TCanvas;
rH,rW:INteger;
rRect:Trect;
Hstart:Integer;
FRulerSystem: TRulerSystem;
FDpm: Double;
FRtype: TrulerType;
VStart: Integer;
clpRgn: HRGn;
begin
If not rulerVisible then exit;
rCanvas:= Canvas;
rw := SurfaceWidth;
rh := 30;
cPoint := RulerStart;
Hstart := cpoint.x;
inch := 2.54;
factor := 1;
FrulerSystem := RulerSystem;
Fdpm := DotsPerMil;
FRtype:= RulerType;
//RulerMode := 0;
//RulerMapScale:=500;
if FRulerSystem = rsMetric then
begin
dmm := Fdpm / 10;
hmm := Fdpm / 2;
mm := Fdpm;
hcm := mm*5;
cm := mm*10;
dm := cm*10;
end else begin
mm := Fdpm*inch*10/16;
dmm := mm / 8;
hmm := mm / 2;
hcm := Fdpm*inch*10/2;
cm := Fdpm*inch*10;
dm := cm*10;
end;
SetBkMode(rCanvas.Handle,transparent);
rcanvas.font.name := 'Tahoma';
rcanvas.font.size := 7;
rcanvas.Font.Color := clBlack;
rCanvas.Font.Style := [];
rCanvas.Brush.Color := FRulerColor;
rCanvas.Brush.Style := bsSolid;
rCanvas.FillRect(Rect(0,0,rw,rh));
rCanvas.Brush.Style := bsClear;
rCanvas.Pen.Color := clBlack;
rCanvas.Pen.Width := 1;
rCanvas.Pen.Style := psSolid;
rCanvas.Pen.Mode:= pmCopy;
rCanvas.MoveTo(30,rh);
//Tolik 08/09/2021 -- commented Line draw
//rCanvas.LineTo(rw,rh);
//
case FRtype of
rtDeciMilim :begin
if FRulerSystem = rsMetric then
begin
steps[1] := dmm;
steps[2] := 10;
steps[3] := 100;
factor := 1;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'mm');
factor := 1;
end else begin
if RulerMapScale < 500 then begin
rCanvas.TextOut( 10,2,'cm');
Factor := RulerMapScale/10;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/1000;
end;
end;
end else begin
steps[1] := dmm;
steps[2] := 8;
steps[3] := 128;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'Inch/16');
factor := 1;
end else begin
if RulerMapScale < 500 then begin
rCanvas.TextOut( 10,2,'Inch');
Factor := RulerMapScale/16;
end else begin
rCanvas.TextOut( 10,2,'Feet');
Factor := RulerMapScale/(16*12);
end;
end;
end;
end;
rtHalfMilim : begin
if FRulerSystem = rsMetric then
begin
steps[1] := hmm;
steps[2] := 2;
steps[3] := 20;
text := 3;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/100;
end;
end else begin
steps[1] := hmm;
steps[2] := 2;
steps[3] := 32;
factor := 1;
text := 3;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'Inch');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'Feet');
Factor := RulerMapScale/12;
end;
end;
end;
rtMilim : begin
if FRulerSystem = rsMetric then
begin
steps[1] := mm;
steps[2] := 5;
steps[3] := 10;
text := 3;
factor := 1;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/100;
end;
end else begin
steps[1] := mm;
steps[2] := 8;
steps[3] := 16;
text := 3;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'Inch');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'Feet');
Factor := (RulerMapScale/12);
end;
end;
end;
rtHalfCMeter : begin
if FRulerSystem = rsMetric then
begin
steps[1] := hcm;
steps[2] := 2;
steps[3] := 20;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/100;
end;
end else begin
steps[1] := hcm;
steps[2] := 2;
steps[3] := 20;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'inch');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'feet');
Factor := RulerMapScale/12;
end;
end;
end;
rtCentiMeter : begin
if FRulerSystem = rsMetric then
begin
steps[1] := cm;
steps[2] := 10;
steps[3] := 100;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := 10*(RulerMapScale/100);
end;
end else begin
steps[1] := cm;
steps[2] := 10;
steps[3] := 100;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'inch');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'feet');
Factor := 10*(RulerMapScale/12);
end;
end;
end;
rtDeciMeter : begin
if FRulerSystem = rsMetric then
begin
steps[1] := dm;
steps[2] := 1;
steps[3] := 10;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := 10*(RulerMapScale/100);
end;
end else begin
steps[1] := dm;
steps[2] := 1;
steps[3] := 10;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'inch');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'feet');
Factor := 10*(RulerMapScale/12);
end;
end;
end;
end;
SelectClipRgn(rcanvas.Handle,0);
clpRgn := CreateRectRgn(30,0,rw,rh);
SelectClipRgn(rcanvas.Handle,clpRgn);
if RHRgn <> 0 then DeleteObject(RHRgn);
RHRgn := CreateRectRgn(30,0,rw,rh);
step := steps[1];
textcounter := 0;
if step < 4 then exit;
number := round((rw - HStart) / step) + 1;
rcanvas.MoveTo(HStart,rh);
rcanvas.LineTo(HStart,rh-20);
rCanvas.TextOut(HStart+2,rh-20,'0');
For a := 1 to number do
begin
coord := round(Hstart + (a*step));
if (a mod round(steps[3])) = 0 then len := 20
else if (a mod round(steps[2])) = 0 then len := 10
else len := 5;
if coord > 30 then rcanvas.MoveTo(coord,rh);
if coord > 30 then rcanvas.LineTo(coord,rh-len);
if text = 1 then
begin
if coord > 30 then rCanvas.TextOut(coord+2,rh-len,floattostrf(a*factor,ffFixed,8,1));
end
else if text = 2 then
begin
if len <> 5 then
begin
inc(textcounter);
if len = 10 then len := 15;
if coord > 30 then rCanvas.TextOut(coord+2,rh-len,floattostrf(textcounter*factor,ffFixed,8,1));
end;
end
else if text = 3 then
begin
if len = 20 then
begin
inc(textcounter);
if coord > 30 then rCanvas.TextOut(coord+2,rh-len,floattostrf(textcounter*factor,ffFixed,8,1));
end;
end;
end;
TextCOunter := 0;
if HStart > 30 then begin
number := round(HStart / step) + 1;
For a := 1 to number do
begin
coord := round(Hstart - (a*step));
if (a mod round(steps[3])) = 0 then len := 20
else if (a mod round(steps[2])) = 0 then len := 10
else len := 5;
if coord > 30 then rcanvas.MoveTo(coord,rh);
if coord > 30 then rcanvas.LineTo(coord,rh-len);
if text = 1 then
begin
if coord > 30 then rCanvas.TextOut(coord+2,rh-len,floattostrf(a*factor,ffFixed,8,1));
end
else if text = 2 then
begin
if len <> 5 then
begin
inc(textcounter);
if len = 10 then len := 15;
if coord > 30 then rCanvas.TextOut(coord+2,rh-len,floattostrf(textcounter*factor,ffFixed,8,1));
end;
end
else if text = 3 then
begin
if len = 20 then
begin
inc(textcounter);
if coord > 30 then rCanvas.TextOut(coord+2,rh-len,floattostrf(textcounter*factor,ffFixed,8,1));
end;
end;
end;
end;
rw := 30;
rh := SurfaceHeight;
SelectClipRgn(rcanvas.Handle,0);
DeleteObJect(clpRgn);
clpRgn := CreateRectRgn(0,30,rw+1,rh);
SelectClipRgn(rcanvas.Handle,clpRgn);
if RVRgn <> 0 then DeleteObject(RVRgn);
RVRgn := CreateRectRgn(0,30,rw+1,rh);
SetBkMode(rCanvas.Handle,transparent);
rcanvas.font.name := 'Tahoma';
rcanvas.font.size := 7;
rcanvas.Font.Color := clBlack;
rCanvas.Font.Style := [];
rCanvas.Brush.Color := FRulerColor;
rCanvas.Brush.Style := bsSolid;
rCanvas.FillRect(Rect(0,30,rw,rh));
rCanvas.Brush.Style := bsClear;
rCanvas.Pen.Color := clBlack;
rCanvas.MoveTo(rw,30);
//Tolik 08/09/2021 -- commented Line draw
//rCanvas.LineTo(rw,rh);
//
factor := 1;
Vstart := cpoint.y;
inch := 2.54;
if FRulerSystem = rsMetric then
begin
dmm := Fdpm / 10;
hmm := Fdpm / 2;
mm := Fdpm;
hcm := mm*5;
cm := mm*10;
dm := cm*10;
end else begin
mm := Fdpm*inch*10/16;
dmm := mm / 8;
hmm := mm / 2;
hcm := Fdpm*inch*10/2;
cm := Fdpm*inch*10;
dm := cm*10;
end;
case FRtype of
rtDeciMilim :begin
if FRulerSystem = rsMetric then
begin
steps[1] := dmm;
steps[2] := 10;
steps[3] := 100;
factor := 1;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'mm');
factor := 1;
end else begin
if RulerMapScale < 500 then begin
rCanvas.TextOut( 10,2,'cm');
Factor := RulerMapScale/10;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/1000;
end;
end;
end else begin
steps[1] := dmm;
steps[2] := 8;
steps[3] := 128;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'Inch/16');
factor := 1;
end else begin
if RulerMapScale < 500 then begin
rCanvas.TextOut( 10,2,'Inch');
Factor := RulerMapScale/16;
end else begin
rCanvas.TextOut( 10,2,'Feet');
Factor := RulerMapScale/(16*12);
end;
end;
end;
end;
rtHalfMilim : begin
if FRulerSystem = rsMetric then
begin
steps[1] := hmm;
steps[2] := 2;
steps[3] := 20;
text := 3;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/100;
end;
end else begin
steps[1] := hmm;
steps[2] := 2;
steps[3] := 32;
factor := 1;
text := 3;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'Inch');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'Feet');
Factor := RulerMapScale/12;
end;
end;
end;
rtMilim : begin
if FRulerSystem = rsMetric then
begin
steps[1] := mm;
steps[2] := 5;
steps[3] := 10;
text := 3;
factor := 1;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/100;
end;
end else begin
steps[1] := mm;
steps[2] := 8;
steps[3] := 16;
text := 3;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'Inch');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'Feet');
Factor := (RulerMapScale/12);
end;
end;
end;
rtHalfCMeter : begin
if FRulerSystem = rsMetric then
begin
steps[1] := hcm;
steps[2] := 2;
steps[3] := 20;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := RulerMapScale/100;
end;
end else begin
steps[1] := hcm;
steps[2] := 2;
steps[3] := 20;
text := 2;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'inch');
factor := 1;
end else begin
rCanvas.TextOut( 10,2,'feet');
Factor := RulerMapScale/12;
end;
end;
end;
rtCentiMeter : begin
if FRulerSystem = rsMetric then
begin
steps[1] := cm;
steps[2] := 10;
steps[3] := 100;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := 10*(RulerMapScale/100);
end;
end else begin
steps[1] := cm;
steps[2] := 10;
steps[3] := 100;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'inch');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'feet');
Factor := 10*(RulerMapScale/12);
end;
end;
end;
rtDeciMeter : begin
if FRulerSystem = rsMetric then
begin
steps[1] := dm;
steps[2] := 1;
steps[3] := 10;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'cm');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'M');
Factor := 10*(RulerMapScale/100);
end;
end else begin
steps[1] := dm;
steps[2] := 1;
steps[3] := 10;
text := 2;
factor := 10;
if RulerMode = 0 then begin
rCanvas.TextOut( 10,2,'inch');
factor := 10;
end else begin
rCanvas.TextOut( 10,2,'feet');
Factor := 10*(RulerMapScale/12);
end;
end;
end;
end;
step := steps[1];
if step < 4 then exit;
number := round((VStart) / step) + 1;
rcanvas.MoveTo(rw,VStart);
Rcanvas.LineTo(rw-20,VStart);
TextCounter := 0;
RCanvas.TextOut(rw-20,Vstart+2,'0');
For a := 1 to number do
begin
coord := round(Vstart - (a*step));
if (a mod round(steps[3])) = 0 then len := 20
else if (a mod round(steps[2])) = 0 then len := 10
else len := 5;
rcanvas.MoveTo(rw,coord);
rcanvas.LineTo(rw-len,coord);
if text = 1 then
begin
rCanvas.TextOut(rw-len-2,coord+2,floattostrf(a*factor,fffixed,8,1));
end
else if text = 2 then
begin
if len <> 5 then
begin
inc(textcounter);
if len = 10 then len := 20;
rCanvas.TextOut(rw-len-2,coord+2,floattostrf(textcounter*factor,fffixed,8,1));
end;
end
else if text = 3 then
begin
if len = 20 then
begin
inc(textcounter);
rCanvas.TextOut(rw-len-2,coord+2,floattostrf(textcounter*factor,fffixed,8,1));
end;
end;
end;
TextCounter := 0;
if VStart < rh then begin
number := round( (rh - VStart) / step) + 1;
For a := 1 to number do
begin
coord := round(Vstart + (a*step));
if (a mod round(steps[3])) = 0 then len := 20
else if (a mod round(steps[2])) = 0 then len := 10
else len := 5;
rcanvas.MoveTo(rw,coord);
rcanvas.LineTo(rw-len,coord);
if text = 1 then
begin
rCanvas.TextOut(rw-len-2,coord+2,floattostrf(a*factor,fffixed,8,1));
end
else if text = 2 then
begin
if len <> 5 then
begin
inc(textcounter);
if len = 10 then len := 20;
rCanvas.TextOut(rw-len-2,coord+2,floattostrf(textcounter*factor,fffixed,8,1));
end;
end
else if text = 3 then
begin
if len = 20 then
begin
inc(textcounter);
rCanvas.TextOut(rw-len-2,coord+2,floattostrf(textcounter*factor,fffixed,8,1));
end;
end;
end;
end;
SelectClipRgn(rcanvas.Handle,0);
DeleteObJect(clpRgn);
end;
procedure TPCDrawBox.ReLocate;
begin
DoPageLocate;
DrawGuideTrace(-25000,-25000);
end;
procedure TPCDrawBox.DrawScrollsToCanvas(Canvas: TCanvas; DoubleBuffered: Boolean; hpressed, vpressed: Boolean);
var
edge, sWidth, sHeight, pWidth, pHeight, pos: Integer;
i: Integer;
sRect: Trect;
temp: Tbitmap;
xCanvas: TCanvas;
hRect,vRect: TRect;
begin
Exit;
if hsRgn <> 0 then
deleteObject(hsRgn);
if vsRgn <> 0 then
deleteObject(vsRgn);
hsRgn := 0;
vsRgn := 0;
if not DrawBars then
exit;
if DoubleBuffered then
begin
Temp := Tbitmap.Create;
xCanvas := Temp.Canvas;
end
else
xCanvas := canvas;
xCanvas.Brush.Color := clWhite;
xcanvas.Brush.Style := bsSolid;
xcanvas.Pen.Color := clBlack;
xCanvas.Pen.Mode := pmCopy;
xCanvas.Pen.Style := psSolid;
edge := 15;
if HorzBarVisible and (scHorzMax > 0) then
begin
sHeight := edge;
if vertbarvisible then
sWidth := SurfaceWidth - sHeight + 1
else
sWidth := SurfaceWidth;
scHorzWidth := sWidth;
pWidth := Round(sWidth * (ScHorzPage / ScHorzMax)) - 1;
pos := Round(sWidth * (scHorzPos / scHorzMax));
xCanvas.Brush.Color := clBtnFace;
xCanvas.Pen.Color := clGray;
if DoubleBuffered then
begin
hRect := Rect(0, 0, sWidth, sHeight);
Temp.Height := sHeight;
Temp.Width := SWidth;
end
else
begin
hRect := Rect(0, SurfaceHeight - sHeight, sWidth, SurfaceHeight);
end;
xcanvas.Rectangle(hRect);
xCanvas.Brush.Color := clBtnFace;
if DoubleBuffered then
begin
hRect := Rect(pos, 0, pos + pWidth, sHeight);
end
else
begin
hRect := Rect(pos, SurfaceHeight - sHeight, pos + pWidth, SurfaceHeight);
end;
xcanvas.Rectangle(hRect);
if hpressed then
DrawEdge(xCanvas.Handle, hRect, EDGE_SUNKEN, BF_RECT)
else
DrawEdge(xCanvas.Handle, hRect, EDGE_RAISED, BF_RECT);
hsRgn := CreateRectRgn(hRect.left, hRect.Top, hRect.right, hRect.Bottom);
if DoubleBuffered then
Canvas.Draw(0, SurfaceHeight - sHeight, temp);
end;
if VertBarVisible and (scVertmax > 0) then
begin
sWidth := edge;
if horzbarvisible then
sHeight := SurfaceHeight - sWidth + 1
else
sHeight := SurfaceHeight;
scVertHeight := sHeight;
pHeight := Round(sHeight * (ScVertPage / ScVertMax)) - 1;
pos := Round(sHeight * (scVertPos / scVertMax));
xCanvas.Pen.Color := clGray;
xCanvas.Brush.Color := clBtnFace;
if DoubleBuffered then
begin
vRect := Rect(0, 0, sWidth, sHeight);
Temp.Height := sHeight;
Temp.Width := SWidth;
end
else
begin
vRect := Rect(SurfaceWidth - sWidth, 0, SurfaceWidth, SHeight);
end;
xcanvas.Rectangle(vRect);
if DoubleBuffered then
begin
vRect := Rect(0, pos, sWidth, pos + pHeight);
Temp.Height := sHeight;
Temp.Width := SWidth;
end
else
begin
vRect := Rect(SurfaceWidth - sWidth, pos, SurfaceWidth, pos + pHeight);
end;
xcanvas.Rectangle(vRect);
if vpressed then
DrawEdge(xCanvas.Handle, vRect, EDGE_SUNKEN, BF_RECT)
else
DrawEdge(xCanvas.Handle, vRect, EDGE_RAISED, BF_RECT);
vsRgn := CreateRectRgn(vRect.Left, vRect.Top, vRect.Right, vRect.Bottom);
if DoubleBuffered then
Canvas.Draw(SurfaceWidth - sWidth, 0, temp);
end;
if HorzbarVisible and VertbarVisible then
begin
if DoubleBuffered then
begin
Temp.Height := edge;
Temp.Width := edge;
hRect := Rect(0, 0, edge, edge);
end
else
begin
hRect := Rect(SurfaceWidth - edge, SurfaceHeight - edge, SurfaceWidth, SurfaceHeight);
end;
xCanvas.Pen.Color := clGray;
xCanvas.Brush.Color := clBtnFace;
xcanvas.Rectangle(hRect);
if DoubleBuffered then
Canvas.Draw(SurfaceWidth - edge, SurfaceHeight - edge, temp);
end;
if DoubleBuffered then
begin
//Tolik
Temp.FreeImage;
//
Temp.Free;
end;
end;
procedure TPCDrawBox.SetScrolls(SHorzMAx, SVertMax, SHorzPos, SVertPos,
SHorzPage, SVertPage: Integer);
begin
if assigned(FScrollValues) then FScrollValues(Self,SHorzMAx,SVertMax,SHorzPos,
SVertPos,SHorzPage,SVertPage,round(5 * DotsPerMil),round(20 * DotsPerMil));
ScHorzMAx := SHorzMAx;
ScVertMax := SVertMax;
ScHorzPos := SHorzPos;
ScVertPos := SVertPos;
ScHorzPage := SHorzPage;
ScVertPage := SVertPage;
end;
procedure TPCDrawBox.SetHScrollPosition(hPos: Integer; Update:Boolean);
begin
if HPos > (scHorzMax - scHorzPage) then
HPos := (scHorzMax - scHorzPage);
if hPos < 0 then
hpos := 0;
ScHorzPos := hPos;
if Update then
begin
if FResetRegionsOnZoomScroll then //07.08.2012
ResetRegions;
if autorefresh then
DoSurfacePaint(Surface);
end;
end;
procedure TPCDrawBox.SetVScrollPosition(vPos: Integer;Update:Boolean);
begin
if vPos > (scVertMax - scVertPage) then
vPos := (scVertMax - scVertPage);
if vPos < 0 then
vPos := 0;
ScVertPos := vPos;
if Update then
begin
if FResetRegionsOnZoomScroll then //07.08.2012
ResetRegions;
if autorefresh then
DoSurfacePaint(Surface);
end;
end;
function TPCDrawBox.PointInHRuler(x, y: Double): Boolean;
begin
result := false;
{Mityai} //D0000006303
if (RulerVisible)and(GuidesVisible) then
result := PtInRegion(rHrgn,Round(x),Round(y));
end;
function TPCDrawBox.PointInHScroll(x, y: Double): Boolean;
begin
result := false;
result := PtInRegion(hsrgn,Round(x),Round(y));
end;
function TPCDrawBox.PointInVRuler(x, y: Double): Boolean;
begin
result := false;
{Mityai} //D0000006303
if (RulerVisible)and(GuidesVisible) then
result := PtInRegion(rVrgn,Round(x),Round(y));
end;
function TPCDrawBox.PointInVScroll(x, y: Double): Boolean;
begin
result := false;
result := PtInRegion(vsrgn,Round(x),Round(y));
end;
procedure TPCDrawBox.SetHScrollDelta(hDelta: Double;Update: Boolean);
var sgn: Integer;
begin
if hDelta = 0 then exit;
if hdelta <0 then begin
sgn := -1;
end;
sgn := 1;
if hDelta < 0 then sgn := -1;
hDelta := round(hDelta* (scHorzMax/scHorzWidth));
if (abs(hDelta) >= 0) and (abs(hDelta) < 1) then hDelta := sgn;
SetHScrollPosition(round(oldposX)+Round(hDelta),Update);
end;
procedure TPCDrawBox.SetVScrollDelta(hDelta: Double;Update: Boolean);
var sgn: Integer;
begin
if hDelta = 0 then exit;
sgn := 1;
if hDelta < 0 then sgn := -1;
hDelta := round(hDelta* (scVertMax/scVertHeight));
if (abs(hDelta) >= 0) and (abs(hDelta) < 1) then hDelta := sgn;
SetVScrollPosition(round(oldPosY)+Round(hDelta),Update);
end;
procedure TPCDrawBox.SetDragCursor(cr: TCursor);
begin
Surface.DragCursor := cr;
Surface.Cursor := cr;
if assigned(FCursorChange) then FCursorChange(Self,cr);
end;
Function TPCDrawBox.CheckForGuideDrop(X, Y: Integer; autoCr: boolean = False):Boolean;
var gutype: TGuideType;
guidex: Double;
guidey,z: Double;
begin
result := false;
if (DragState = dsHRuler) or (DragState = dsVRuler) then
begin
result := true;
if DragState = dsHRuler then
guType := gtHorz
else
guType := gtVert;
GuideX := x; GuideY:= y;z :=0;
DeConvertXY(GuideX,GuideY,z);
if guType = gtHorz then
begin
Guides.Add(TGuideLine.create(gtHorz,GuideY, autoCr));
guideYold := -5000;
end
else
begin
Guides.Add(TGuideLine.create(gtVert,GuideX, autoCr));
guideXold := - 5000;
end;
end;
end;
function TPCDrawBox.GetActiveCanvas: TCanvas;
begin
if CustomSurface <> nil then result := CustomSurface else result := Surface.Canvas;
end;
procedure TPCDrawBox.ClipToActiveRegion(xCanvas:TCanvas=nil);
var x1,y1,x2,y2: Integer;
dRgn: HRGN;
begin
x1 := 0;
if RulerVisible then x1 := x1+30;
y1 := 0;
if RulerVisible then y1 := y1+30;
x2 := SurfaceWidth;
y2 := SurfaceHeight;
if HorzBarVisible and (scHorzMax > 0) then y2 := y2 - 15;
if VertBarVisible and (scVertMax > 0) then x2 := x2 - 15;
if not assigned(xCanvas) then xCanvas := GetActiveCanvas;
SelectClipRgn(xCanvas.Handle,0);
if crgn <> 0 then DeleteObject(cRgn);
cRgn := CreateRectRgn(x1,y1,x2,y2);
if FDetail then begin
dRgn := CreateRectRgn(FdetailPosX,FDetailPosY,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
CombineRgn(cRgn,cRgn,dRgn,RGN_DIFF);
DeleteObject(dRgn);
end;
SelectClipRgn(xCanvas.Handle,cRgn);
Dengine.ClipRgn := crgn;
end;
procedure TPCDrawBox.unClip(xCanvas:TCanvas=nil);
begin
if not assigned(xCanvas) then xCanvas := GetActiveCanvas;
SelectClipRgn(xCanvas.Handle,0);
if crgn <> 0 then DeleteObject(cRgn);
cRgn := 0;
Dengine.ClipRgn := crgn;
end;
procedure TPCDrawBox.ClipToUnScrollRegion(xCanvas:TCanvas=nil);
var x1,y1,x2,y2: Integer;
xrgn: HRGN;
begin
x1 := 0;
y1 := 0;
x2 := SurfaceWidth;
y2 := SurfaceHeight;
if HorzBarVisible and (scHorzMax > 0) then y2 := y2 - 15;
if VertBarVisible and (scVertMax > 0) then x2 := x2 - 15;
if not assigned(xCanvas) then xCanvas := GetActiveCanvas;
SelectClipRgn(xCanvas.Handle,0);
if crgn <> 0 then DeleteObject(cRgn);
cRgn := CreateRectRgn(x1,y1,x2,y2);
xRgn := CreateRectRgn(0,0,30,30);
CombineRgn(cRgn,cRgn,xRgn,RGN_DIFF);
DeleteObject(xRgn);
SelectClipRgn(xCanvas.Handle,cRgn);
Dengine.ClipRgn := crgn;
end;
procedure TPCDrawBox.ClipToDetailRegion(xCanvas: TCanvas);
begin
if not assigned(xCanvas) then xCanvas := GetActiveCanvas;
SelectClipRgn(xCanvas.Handle,0);
if crgn <> 0 then DeleteObject(cRgn);
cRgn := CreateRectRgn(FdetailPosX,FDetailPosY,FdetailPosX+FDetailWidth,FDetailPosY+FDetailHeight);
SelectClipRgn(xCanvas.Handle,cRgn);
Dengine.ClipRgn := crgn;
end;
procedure TPCDrawBox.KillTraceFigure;
begin
// this is for killing the trace figure in TPowercad
end;
procedure TPCDrawBox.SetEngine(xCanvas: TCanvas; CPoint,DeCPoint:ConvertXYProc;
CDim,DeCdim:ConvertDimProc;isPrinting: Boolean; prBmp: TBitmap);
Begin
DEngine.Canvas := xCanvas;
DEngine.ConvertPoint := CPoint;
DEngine.ConvertLen := CDim;
DEngine.DeConvertPoint := DeCPoint;
DEngine.DeConvertLen := DeCDim;
DEngine.isPrinting := isPrinting;
DEngine.PrintBmp := prBmp;
Dengine.Isometric := FIsometric;
end;
Procedure TPCDrawBox.SetDefaultEngine;
begin
if CustomSurface <> nil then begin
if FIsometric then begin
SetEngine(CustomSurface,IsoConvertXY,IsoDeConvertXY,IsoConvertDim,IsoDeConvertDim,false,nil);
end else begin
SetEngine(CustomSurface,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
end;
end else begin
if FIsometric then begin
SetEngine(Surface.Canvas,IsoConvertXY,IsoDeConvertXY,IsoConvertDim,IsoDeConvertDim,false,nil);
end else begin
SetEngine(Surface.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
end;
end;
end;
procedure TPCDrawBox.SetDetailEngine;
begin
if CustomSurface <> nil then begin
SetEngine(CustomSurface,DetConvertXY,DetDeConvertXY,DetConvertDim,DetDeConvertDim,false,nil);
end else begin
SetEngine(Surface.Canvas,DetConvertXY,DetDeConvertXY,DetConvertDim,DetDeConvertDim,false,nil);
end;
end;
function TPCDrawBox.DoKeyEvents(Message: TWMKey): Boolean;
var
ShiftState: TShiftState;
chCode: Word;
shift: Integer;
scan_code: Byte;
const
AltMask = $20000000;
begin
shift := 0;
scan_code := (Message.KeyData shr 16) and $FF;
if GetKeyState(VK_SHIFT) < 0 then shift := shift or oleShift;
if GetKeyState(VK_CONTROL) < 0 then shift := shift or oleCtrl;
if Message.KeyData and AltMask <> 0 then shift := shift or oleAlt;
chCode := Message.CharCode;
if ((scan_code >= 59) and (scan_code <= 68)) or (scan_code = 87) or (scan_code >= 88) then
chCode := 0;
Result := DoKeyStroke(chCode,Shift);
end;
function TPCDrawBox.DoKeyStroke(ChCode, Shift: Integer): Boolean;
begin
//***
end;
procedure TPCDrawBox.setShadow(const Value: Boolean);
begin
FShadow := Value;
if autorefresh then DoSurfacePaint(Surface);
end;
procedure TPCDrawBox.DragMove(x, y: Integer);
var guType:TGuideType;
dist: Integer;
xCanvas: TCanvas;
ADeltaX, ADeltaY: double;
begin
// Tolik 29/03/2017 --
if (Self.Owner = nil) then
Exit;
//
if DragState = dsHScroll then
begin
Dist := x-Round(DragStartXInt);
SetHScrollDelta(Dist,False);
xCanvas:=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,True,False);
end
else
if DragState = dsVScroll then
begin
Dist := y-Round(DragStartYInt);
SetVScrollDelta(Dist,False);
xCanvas:=GetActiveCanvas;
DrawScrollsToCanvas(xCanvas,True,False,True);
end
else
if DragState = dsPan then
begin
{
Dist := y-Round(DragStartYInt);
SetVScrollDelta(-Dist,False);
Dist := x-Round(DragStartXInt);
SetHScrollDelta(-Dist,False);
xCanvas:=GetActiveCanvas;
ResetRegions;
Refresh;
}
ADeltaY := (y - Round(DragStartYInt)) / ZoomScale * 25;
DragStartYInt := y;
ADeltaX := (x - Round(DragStartXInt)) / ZoomScale * 25;
DragStartXInt := x;
// Tolik 29/03/2017 --
// TF_CAD(parent).MoveCADOnPan(ADeltaX, ADeltaY);
//
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
if Self.Owner.ClassName = 'TF_CAD' then
TF_CAD(Self.Owner).MoveCADOnPan(ADeltaX, ADeltaY)
else
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if Self.Owner.ClassName = 'TF_MasterCompl' then
TF_MasterCompl(Self.Owner).MoveCADOnPan(ADeltaX, ADeltaY)
else
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>...
exit;
//
end
else
if DragState = dsDetPan then
begin
Dist := x-round(DragStartXInt);
DragStartXInt := x;
FDetailLeft := FDetailLeft-dist;
Dist := y-round(DragStartYInt);
DragStartYInt := y;
FDetailTop := FDetailTop-dist;
ResetRegions;
Refresh;
end
else
{Mityai} //D0000006303
if (DragState = dsHRuler)and(GuidesVisible) then
begin
guType := gtHorz;
DrawGuideOnSurface(x,y,guType);
end
else
{Mityai} //D0000006303
if (DragState = dsVRuler)and(GuidesVisible) then
begin
guType := gtVert;
DrawGuideOnSurface(x,y,guType);
end;
end;
procedure TPCDrawBox.DragDropped(x, y: Integer);
begin
if CheckForGuideDrop(x,y) then
begin
isDragging := False;
dragState := dsNone;
Refresh;
end;
if (DragState = dsHScroll) or (DragState = dsVScroll) or (DragState = dsPan) or (DragState = dsDetPan) then
begin
ResetRegions;
dragState := dsNone;
isDragging := False;
DragReadyInt := False;
if autorefresh then DoSurfacePaint(Surface);
DrawTrace;
end;
SetCursor(oldCursor);
Screen.Cursor := crDefault;
end;
procedure TPCDrawBox.SetRulerValues(MapScale: Double; Mode: Integer);
begin
RulerMapScale := MapScale;
RulerMode := Mode;
refresh;
end;
function TPCDrawBox.GetPageRect: TRect;
begin
Result := Rect(PageLeft,PageTop,PageLeft+PageWidth,PageTop+PageHeight);
end;
procedure TPCDrawBox.setCenterGuide(const Value: Boolean);
begin
FCenterGuide := Value;
if autorefresh then DoSurfacePaint(Surface);
evCenterGuide.RaiseEvent(Value);
Updated := True;
SyncEnv;
end;
function TPCDrawBox.GetVisibleRect: TDoubleRect;
var SWidth,SHeight,z:Double;
p:TDoublePoint;
begin
SWidth := SurfaceWidth;
SHeight := SurfaceHeight;
p := DoublePoint(0,0);
z := 0;
DeConvertXY(p.x,p.y,z);
result.Left := p.x;
result.Top := p.y;
p := DoublePoint(SWidth,SHeight);
z := 0;
DeConvertXY(p.x,p.y,z);
result.Right := p.x;
result.Bottom := p.y;
end;
procedure TPCDrawBox.SetSurfaceMargin(Value: Integer);
begin
FsurfaceMargin := Value;
Relocate;
end;
procedure TPCDrawBox.ClearGuides;
var
i: Integer;
begin
try
for i := 0 to Guides.Count - 1 do
TGuideLine(Guides[i]).Free;
GuidesCreatedOnDropCompon.Clear;
Guides.Clear;
Refresh;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawBox.ClearGuides' + E.Message);
end;
end;
procedure TPCDrawBox.setRulerColor(const Value: TColor);
begin
FRulerColor := Value;
Refresh;
end;
procedure TPCDrawBox.setCoordZ(const Value: Double);
begin
FCoordZ := Value;
end;
procedure TPCDrawBox.CollectFaces;
begin
end;
procedure TPCDrawBox.SetDetail(const Value: Boolean);
begin
FDetail := Value;
CalculateDetailMargins;
Refresh;
end;
procedure TPCDrawBox.setDetailHeight(const Value: Integer);
begin
FDetailHeight := Value;
FDetailPosX := SurfaceWidth-FDetailWidth-20;
FDetailPosY := 20;
CalculateDetailMargins;
Refresh;
end;
procedure TPCDrawBox.setDetailWidth(const Value: Integer);
begin
FDetailWidth := Value;
FDetailPosX := SurfaceWidth-FDetailWidth-20;
FDetailPosY := 20;
CalculateDetailMargins;
Refresh;
end;
procedure TPCDrawBox.SetDetailScale(Value: Integer);
begin
if Value < 10 then Value := 10;
if Value > MaxScale then
Value := MaxScale;
FDetailScale := Value;
CalculateDetailMargins;
Refresh;
end;
procedure TPCDrawBox.CenterLocation(x,y:Double);
var xrect:TDoubleRect;
FRefresh:Boolean;
lMar: Integer;
event:TScrollValuesEvent;
Begin
FbarsLocked := True;
xRect := DoubleRect(x,y,x,y);
SetDpm(FDpmOrig * (FScale/100));
FRefresh := AutoRefresh;
AutoRefresh := False;
event := FScrollValues;
FScrollValues := nil;
DoPageLocate;
FScrollValues := event;
FbarsLocked := True;
If HorzBarVisible then begin
lmar := Round(SurfaceWidth - abs(xRect.Right-xRect.Left)*DotsPermil) div 2;
if HorizontalZero = vzRight then
scHorzPos := round(((FWorkWidth-xRect.right))*DotsPerMil-lmar)
else
scHorzPos := round((xRect.Left)*DotsPerMil-lmar);
end;
If VertBarVisible then begin
lmar := Round(SurfaceHeight - abs(xRect.Top-xRect.Bottom)*DotsPermil) div 2;
if VerticalZero = vzBottom then
scVertPos := round(((FWorkHeight - xRect.Top))*DotsPerMil-lmar)
else
scVertPos := round(((xRect.Bottom))*DotsPerMil-lmar);
end;
AutoRefresh := Frefresh;;
if AutoRefresh then DoSurfacePaint(Surface);
If assigned(SOnScale) then SOnScale(self);
SyncEnv;
FbarsLocked := False;
end;
function TPCDrawBox.PointInView(x, y: Double): Boolean;
var vrect: TDoubleRect;
pt : TPoint;
irect: Trect;
z: Double;
begin
z := 0;
ConvertXY(x,y,z);
pt := Point(round(x),round(y));
vrect := GetVisibleRect;
ConvertXY(vrect.left,vrect.top,z);
ConvertXY(vrect.right,vrect.bottom,z);
irect := Rect(round(vrect.left),round(vrect.top),round(vrect.Right),round(vrect.Bottom));
result := ptInrect(irect,pt);
end;
procedure TPCDrawBox.SetRulerSytem(const Value: TRulerSystem);
begin
if Value <> FrulerSystem then begin
if FrulerSystem = rsMetric then begin
GridStep := (GridStep/10)*8;
end else begin
GridStep := (GridStep/8)*10;
end;
end;
FRulerSystem := Value;
Refresh;
evRulerSys.RaiseEvent(ord(Value));
end;
procedure TPCDrawBox.DetConvertDim(var Dim: double);
begin
Dim := Round(Dim * DotsPerMilOrig * (FDetailScale/100));
end;
procedure TPCDrawBox.DetConvertXY(var X, Y,Z: double);
var dx,dy: Double;
p: TDoublePOint;
begin
if HorizontalZero = vzRight then x :=WorkWidth-x;
if VerticalZero = vzBottom then y :=WorkHeight-y;
if FDetailStyle = dsIsometry then
begin
p := Doublepoint(x,y,z);
p := ConvertIsometricPoint(p,FWorkHeight,isoAngle,isoType);
x := p.x-FDetMarX;
y := p.y-FDetMarY;
end;
dx := x-FDetailLeft;
dy := y-FDetailTop;
DetConvertDim(dx);
DetConvertDim(dy);
x := FDetailPosX+dx;
y := FdetailPosY+dy;
end;
procedure TPCDrawBox.DetDeConvertDim(var Dim: Double);
begin
Dim := Dim / (DotsPerMilOrig * (FDetailScale/100));
end;
procedure TPCDrawBox.DetDeConvertXY(var X, Y,Z: Double);
var dx,dy:Double;
p: TDoublePoint;
begin
dy := y-FdetailPosY;
dx := x-FDetailPosX;
DetDeConvertDim(dx);
DetDeConvertDim(dy);
x := FDetailLeft+dx;
y := FDetailTop+dy;
if FDetailStyle = dsIsometry then
begin
x := x+FDetMarX;
y := y+FDetMarY;
p := Doublepoint(x,y,z);
p := DeConvertIsometricPoint(p,FWorkHeight,isoAngle,isoType);
x := p.x;
y := p.y;
end;
if HorizontalZero = vzRight then x :=WorkWidth-x;
if VerticalZero = vzBottom then y :=WorkHeight-y;
end;
procedure TPCDrawBox.ZoomDetailArea(ZoomRect: TDoubleRect);
var zW,zH,scw,sch,dpw,dph:Double;
begin
zw := abs(ZoomRect.Left-ZoomRect.Right);
zh := abs(Zoomrect.top-ZoomRect.bottom);
dpW := FDetailWidth/zW;
scw := 100*(dpw/DotsPermilOrig);
dpH := FDetailHeight/zH;
sch := 100*(dph/DotsPermilOrig);
if scw < sch then FDetailScale := Round(scw) else FDetailScale := Round(sch);
FDetailLeft := ZoomRect.Left;
FDetailTop := ZoomRect.Top;
if HorizontalZero = vzRight then FDetailLeft :=WorkWidth-ZoomRect.Left;
if VerticalZero = vzBottom then FDetailTop :=WorkHeight-ZoomRect.Top;
if FDetailStyle = dsIsometry then CalculateDetailMargins(True);
Refresh;
end;
procedure TPCDrawBox.ZoomDetailPoint(ZoomCenter: TDoublePoint);
var cx,cy,cz: Double;
dw,dh: Double;
p:TDoublePoint;
begin
cx := ZoomCenter.x;
cy := ZoomCenter.y;
cz := ZoomCenter.z;
ZoomDp := ZoomCenter;
if HorizontalZero = vzRight then cx :=WorkWidth-cx;
if VerticalZero = vzBottom then cy :=WorkHeight-cy;
if FDetailStyle = dsIsometry then
begin
p := Doublepoint(cx,cy,cz);
p := ConvertIsometricPoint(p,FWorkHeight,isoAngle,isoType);
cx := p.x-FDetMarX;
cy := p.y-FDetMarY;
end;
dw := FDetailWidth/(DotsPermilOrig*(FDetailScale/100));
dh := FDetailHeight/(DotsPermilOrig*(FDetailScale/100));
FDetailLeft := cx-(dw/2);
FDetailTop := cy-(dh/2);
Refresh;
end;
function TPCDrawBox.PointInDetail(x, y: Double): Boolean;
var Drect:TDoubleRect;
begin
result := false;
if not Fdetail then exit;
if (FDetailStyle = dsIsometry) and (ToolIdx <> toSelect) then exit;
Drect := DoubleRect(SurfaceWidth-FDetailWidth-20,20,SurfaceWidth-20,FDetailHeight+20);
result := PointInRect(DoublePOint(x,y),dRect);
end;
procedure TPCDrawBox.SetBufferEngine;
begin
if FISometric then begin
SetEngine(TempBitmap.Canvas,IsoConvertXY,IsoDeConvertXY,IsoConvertDim,IsoDeConvertDim,false,nil);
end else begin
SetEngine(TempBitmap.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
end;
end;
procedure TPCDrawBox.SetBufferDetailEngine;
begin
SetEngine(TempBitmap.Canvas,DetConvertXY,DetDeConvertXY,DetConvertDim,DetDeConvertDim,false,nil);
end;
procedure TPCDrawBox.SetDetailStyle(const Value: TDetailStyle);
begin
FDetailStyle := Value;
CalculateDetailMargins;
Refresh;
end;
procedure TPCDrawBox.CalculateDetailMargins(ReScale:Boolean=False);
var p1,p2,p3,p4: TDoublePoint;
z,dw,dh: Double;
x,y: Double;
minx,miny,maxX,maxY,cx,cy,mx,my,scw,sch,dpW,dpH: Double;
dRect:TDoubleRect;
begin
dw := FDetailWidth/(DotsPermilOrig*(FDetailScale/100));
dh := FDetailHeight/(DotsPermilOrig*(FDetailScale/100));
dRect := DoubleRect(FDetailLeft,FDetailTop,FDetailLeft+dw,FDetailTop+dh);
z := GetZAvg(dRect);
p1 := DoublePoint(FDetailLeft,FDetailTop,z);
p2 := DoublePoint(FDetailLeft+dw,FDetailTop,z);
p3 := DoublePoint(FDetailLeft+dw,FDetailTop+dh,z);
p4 := DoublePoint(FDetailLeft,FDetailTop+dh,z);
p1 := ConvertIsometricPoint(p1,FWorkHeight,isoAngle,isoType);
p2 := ConvertIsometricPoint(p2,FWorkHeight,isoAngle,isoType);
p3 := ConvertIsometricPoint(p3,FWorkHeight,isoAngle,isoType);
p4 := ConvertIsometricPoint(p4,FWorkHeight,isoAngle,isoType);
minX := p1.x;
minY := p1.y;
maxX := p1.x;
maxY := p1.y;
if p2.x < minX then minx := p2.x;
if p3.x < minX then minx := p3.x;
if p4.x < minX then minx := p4.x;
if p2.y < minY then minY := p2.y;
if p3.y < minY then minY := p3.y;
if p4.y < minY then minY := p4.y;
if p2.x > maxX then maxX := p2.x;
if p3.x > maxX then maxX := p3.x;
if p4.x > maxX then maxX := p4.x;
if p2.y > maxY then maxY := p2.y;
if p3.y > maxY then maxY := p3.y;
if p4.y > maxY then maxY := p4.y;
cx := (minX+MaxX)/2;
cy := (minY+MaxY)/2;
if ReScale then begin
dpW := FDetailWidth/(maxX-minx);
scw := 100*(dpw/DotsPermilOrig);
dpH := FDetailHeight/(maxY-miny);
sch := 100*(dph/DotsPermilOrig);
if scw < sch then FDetailScale := Round(scw) else FDetailScale := Round(sch);
dw := FDetailWidth/(DotsPermilOrig*(FDetailScale/100));
dh := FDetailHeight/(DotsPermilOrig*(FDetailScale/100));
end;
mx := cx - (dw/2);
my := cy - (dh/2);
FDetMarX := mx-FDetailLeft;
FDetMarY := mY-FDetailTop;
end;
function TPCDrawBox.GetZAvg(dRect: TDoubleRect): Double;
begin
result := 0;
end;
function TPCDrawBox.HitTestModPoint(x, y: Double): TModPoint;
begin
result := nil;
end;
function TPCDrawBox.HitTestModPointDetVal(x, y: Integer): TModPoint;
begin
result := nil;
end;
function TPCDrawBox.HitTestModPointInt(x, y: Double): Integer;
begin
result := 0;
end;
function TPCDrawBox.HitTestModPointIntVal(x, y: Integer): TModPoint;
begin
result := nil;
end;
function TPCDrawBox.CheckByPointInt(LayerNbr, x, y: Integer): TFigure;
begin
result := nil;
end;
Procedure TPCDrawBox.setActiveLayer(value:integer);
Begin
if value > GetLayerCount - 1 then
messagedlg('Invalid Layer Number',mterror,[mbOK],0)
else begin
FActiveLayer := value;
Updated := True;
end;
end;
function TPCDrawBox.GetLayerCount: integer;
begin
result := 0;
end;
procedure TPCDrawBox.setIsometric(const Value: Boolean);
begin
FIsometric := Value;
Refresh;
end;
procedure TPCDrawBox.IsoConvertDim(var Dim: double);
begin
Dim := Round(Dim * DotsPerMil*ConvertRatio);
end;
procedure TPCDrawBox.IsoConvertXY(var X, Y, Z: double);
begin
IsoTo2D(x,y,z);
ConvertXY(x,y,z);
end;
procedure TPCDrawBox.IsoDeConvertDim(var Dim: Double);
begin
Dim := Dim / (DotsPerMil*ConvertRatio);
end;
procedure TPCDrawBox.IsoDeConvertXY(var X, Y, Z: Double);
begin
DeConvertXY(x,y,z);
end;
procedure TPCDrawBox.CalculateIsometricMargins;
var Minx,MinY,MaxX,MaxY:Double;
var dx,dy: Double;
begin
FIsoMarX := 0;
FIsoMarY := 0;
GetIsometricBounds(MinX,MinY,MaxX,MaxY);
dx := (FWorkWidth - (MaxX-MinX))/2;
dy := (FWorkHeight - (MaxY-MinY))/2;
FIsoMarx := dx-Minx;
FIsoMarY := dy-Miny;
end;
procedure TPCDrawBox.GetIsometricBounds(var MinX, MinY, MaxX,
MaxY: Double);
begin
end;
procedure TPCDrawBox.IsoTo2D(var x, y, z: Double);
var dx,dy: Double;
p: TDoublePOint;
begin
if HorizontalZero = vzRight then x :=WorkWidth-x;
if VerticalZero = vzBottom then y :=WorkHeight-y;
p := Doublepoint(x,y,z);
p := ConvertIsometricPoint(p,FWorkHeight,isoAngle,isoType);
if HorizontalZero = vzRight then x :=WorkWidth-x;
if VerticalZero = vzBottom then y :=WorkHeight-y;
p.x := p.x+FIsoMarX;
p.y := p.y+FIsoMarY;
x := p.x;
y := p.y;
end;
procedure TPCDrawBox.SetForceDefaultEngine;
begin
if CustomSurface <> nil then begin
SetEngine(CustomSurface,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
end else begin
SetEngine(Surface.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
end;
end;
procedure TPCDrawBox.SetForceBufferEngine;
begin
SetEngine(TempBitmap.Canvas,ConvertXY,DeConvertXY,ConvertDim,DeConvertDim,false,nil);
end;
procedure TPCDrawBox.MoveDetailArea(dx, dy: Double);
begin
FDetailLeft := FDetailLeft+dx;
FDetailTop := FDetailTop+dy;
Refresh;
end;
procedure TPCDrawBox.DrawTrace;
begin
//
end;
procedure TPCDrawBox.SurfaceWheel(Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint);
var z,dx,dy: Double;
ar:Boolean;
delta: Integer;
zs: Double;
begin
ZoomPointFlag := False;
ar := AutoRefresh;
dx := MousePos.x;
dy := MousePos.y;
DeConvertXY(dx,dy,z);
ZoomPoint := DoublePoint(dx,dy);
if DetailActive then begin
AutoRefresh := False;
if wheelDelta > 0 then
DetailScale := DetailScale+10
else
DetailScale := DetailScale-10;
AutoRefresh := ar;
ZoomDetailPoint(zoomdp);
end else begin
delta := Round((((wheelDelta/120)*20)/100)*ZoomScale);
if delta = 0 then delta := 1;
DoZoomDelta(delta);
//PrintMessage(inttostr(wheelDelta)+':'+inttostr(ZoomScale));
end;
ZoomPointFlag := False;
end;
procedure TPCDrawBox.SurfaceWheelPull(Shift: TShiftState; X, Y: Integer);
begin
end;
procedure TPCDrawBox.SurfaceWheelPush(Shift: TShiftState; X, Y: Integer);
begin
end;
procedure TPCDrawBox.SurfaceMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
//IGOR -- 12/04/2016 --
{
// TODO <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> - <20><> 2.3.0 <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><> <20><><EFBFBD><EFBFBD> Handled := false;
//Handled := True;
//DoSurfaceWheel(DelphiSetToOleShift(Shift),WheelDelta,MousePos.x,MousePos.y);
}
Handled := false;
end;
procedure TPCDrawBox.SurfaceMiddleDblClick(Sender: TObject);
begin
if self.name = 'PCad' then
begin
if ToolIdx = TPCTool(toFigure) then
begin
GIsMousePressed := GIsMousePressed;
exit;
end;
if FSCS_Main.aExpertMode.Checked then
begin
FSCS_Main.tbPanExpert.Down := True;
end
else
begin
FSCS_Main.tbPanNoob.Down := True;
end;
FSCS_Main.aToolPan.Execute;
exit;
end
else
begin
if DetailActive then begin
DetailScale := 100;
ZoomDetailPoint(ZoomDp);
end
else
begin
FitToWindow;
end;
end;
end;
procedure TPCDrawBox.CadMouseWheel(Sender: TObject; Shift: TShiftState;
WheelDelta: Integer; MousePos: TPoint; var Handled: Boolean);
begin
//MousePos := Self.ClientToScreen(MousePos);
MousePos := Surface.ScreenToClient(MousePos);
SurfaceMouseWheel(Sender,Shift,WheelDelta,MousePos,Handled);
end;
procedure TPCDrawBox.ZoomIn;
begin
DoZoomIn;
end;
procedure TPCDrawBox.ZoomOut;
begin
DoZoomOut;
end;
procedure TPCDrawBox.DoZoomDelta(Delta: Integer);
begin
ZoomScale := ZoomScale + Delta;
end;
procedure TPCDrawBox.setPageborder(const Value: Boolean);
begin
FDrawPageBorder := Value;
if autorefresh then DoSurfacePaint(Surface);
end;
procedure TPCDrawBox.GotFocus(Sender: TObject);
begin
if not Self.Focused then Self.SetFocus;
end;
procedure TPCDrawBox.SimulateTrace(x, y: Double);
var z: Double;
begin
z := 0;
ConvertXY(x,y,z);
SurfaceMove(Self,[],round(x),round(y));
end;
procedure TPCDrawBox.SimulateDown(x, y: Double);
var z: Double;
begin
z := 0;
ConvertXY(x,y,z);
SurfacePush(Self,mbLeft,[],round(x),round(y));
end;
procedure TPCDrawBox.SimulateUp(x, y: Double);
var z: Double;
begin
z := 0;
ConvertXY(x,y,z);
SurfacePull(Self,mbLeft,[],round(x),round(y));
end;
procedure TPCDrawBox.SetDrawInCursor(const Value: Boolean);
begin
FdrawInCursor := Value;
Refresh;
end;
procedure TPCDrawBox.SimulateRightClick(x, y: Double);
var z: Double;
begin
z := 0;
ConvertXY(x,y,z);
//SurfacePush(Self,mbRight,[],round(x),round(y));
SurfacePull(Self,mbRight,[],round(x),round(y));
end;
Procedure TPCDrawBox.SnapToGrid(var x,y:Double); //01.10.2013
begin
CalculateSnapPoint(x,y);
end;
procedure TPCDrawBox.SurfacePaint; //07.08.2012
begin
DoSurfacePaint(Surface);
end;
procedure TPCDrawBox.SurfaceMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
SurfaceMOve(Sender,Shift,x,y);
end;
procedure TPCDrawBox.setPageGuide(const Value: Boolean);
begin
FPageGuide := Value;
Refresh;
end;
procedure TPCDrawBox.SaveScroll;
begin
scHorzPosSave := scHorzPos;
scVertPosSave := scVertPos;
end;
procedure TPCDrawBox.RestoreScroll;
begin
scHorzPos := scHorzPosSave;
scVertPos := scVertPosSave;
Refresh;
end;
procedure TPCDrawBox.SetDpmOrig(const Value: Double);
begin
FDpmOrig := Value;
Refresh;
end;
procedure TPCDrawBox.GetPageRect(var left, top, right, bottom: Integer);
var xrect:TRect;
begin
xRect := GetPageRect;
left := xRect.left;
right := xrect.right;
top := xrect.Top;
bottom := xrect.Bottom;
end;
procedure TPCDrawBox.DoSurfaceWheel(Shift: Integer;
WheelDelta: Integer; x,y:Integer);
begin
SurfaceWheel(OleShiftToDelphiSet(shift),WheelDelta, point(x,y));
end;
procedure TPCDrawBox.DoSurfaceWheelPull(Shift: Integer; X, Y: Integer);
begin
SurfaceWheelPull(OleShiftToDelphiSet(shift), x,y);
end;
procedure TPCDrawBox.DoSurfaceWheelPush(Shift: Integer; X, Y: Integer);
begin
SurfaceWheelPush(OleShiftToDelphiSet(shift), x,y);
end;
function TPCDrawBox.GetToolData: Integer;
begin
result := FToolData;
end;
class function TGuideLine.CreateFromStream(Stream: TStream): TGuideLine;
var
xCode: Byte;
aType: TGuideType;
aCoord: Double;
intVal: Integer;
dblVal: Double;
xByte: Byte;
aautoCr: boolean;
begin
aautoCr := false;
repeat
Stream.Read(xCode, 1);
if xCode = 20 then
begin
Stream.Read(intVal, sizeof(intVal));
aType := TGuideType(intVal);
end;
if xCode = 220 then
begin
Stream.Read(dblVal, sizeof(dblVal));
aCoord := dblVal;
end;
if xCode = 221 then
begin
Stream.Read(xByte, sizeof(xByte));
if xByte = 1 then
aautoCr := True
else
aautoCr := False;
end;
until Stream.Position = Stream.Size;
// aType := gtHorz;
// aCoord := 100;
Result := Self.create(aType, aCoord, aautoCr);
end;
procedure TGuideLine.WriteToStream(Stream: TStream);
var
xInt: integer;
xDbl: double;
xByte: byte;
begin
xInt := Ord(Self.gType);
WriteField(20, Stream, xInt, sizeof(xInt));
xDbl := Self.coord;
if self.fautoCr then
xByte := 1
else
xByte := 0;
WriteField(220, Stream, xDbl, sizeof(xDbl));
WriteField(221, Stream, xByte, sizeof(xByte));
end;
function TPCDrawBox.CheckForExistGuide(x, y: double; guType:TGuideType): Boolean;
var g : TGuideLine;
gx,gy,z : Double;
a : Integer;
Begin
result := False;
z := 0;
CalculateSnapPoint(x,y);
Convertxy(x,y,z);
try
For a := 0 to Guides.Count -1 do
begin
g := TGuideLine(Guides[a]);
gx := g.coord;
gy := g.coord;
z := 0;
ConvertXY(gx,gy,z);
if guType = gtHorz then
if (g.gType = gtHorz) and (abs(y - gy) <= 6) then
begin
GuideYold := Round(gy);
result := true;
exit;
end;
if guType = gtVert then
if (g.gType = gtVert) and (abs(x - gx) <= 6) then
begin
GuideXold := Round(gx);
result := true;
exit;
end;
end;
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPCDrawBox.CheckGuideLine' + E.Message);
end;
end;
procedure TPCDrawBox.DestroyCreatedOnDropGuides;
var i: Integer;
GL: TGuideLine;
begin
Guides.Assign(GuidesCreatedOnDropCompon, laXor);
for i := 0 to GuidesCreatedOnDropCompon.Count - 1 do
begin
TGuideLIne(GuidesCreatedOnDropCompon[i]).free;
end;
GuidesCreatedOnDropCompon.Clear;
end;
function TPCDrawBox.CheckAndGetGuideDrop(X, Y: Integer;
var GuideLine: TGuideLine; autoCr: boolean = False): Boolean;
var gutype: TGuideType;
guidex: Double;
guidey,z: Double;
begin
result := false;
if (DragState = dsHRuler) or (DragState = dsVRuler) then
begin
if Assigned(GuideLine) then
GuideLine := nil;
result := true;
if DragState = dsHRuler then
guType := gtHorz
else
guType := gtVert;
GuideX := x; GuideY:= y;z :=0;
DeConvertXY(GuideX,GuideY,z);
if guType = gtHorz then
begin
GuideLine := TGuideLine.create(gtHorz,GuideY,autoCr);
Guides.Add(GuideLine);
guideYold := -5000;
end
else
begin
GuideLine := TGuideLine.create(gtVert,GuideX,autoCr);
Guides.Add(GuideLine);
guideXold := - 5000;
end;
end;
end;
end.
Reference in New Issue View Git Blame Copy Permalink