admin/expertcad
1
0
Fork 0
mirror of http://gitlab.expertsoft.com.ua/git/expertcad synced 2026-01-12 00:45:40 +02:00
Code Issues Packages Projects Releases Wiki Activity
expertcad/POWERCAD30/UNITS/PowerCad.pas
ShevaIV 00e2ad8635 initial commit
2025-05-12 10:07:51 +03:00

3320 lines
105 KiB
ObjectPascal
Raw Blame History

unit PowerCad;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, PCPanel, PCDrawing,buttons,DrawObjects,PCTypesUtils,comctrls,
stdctrls,extdlgs,PaintboxExt,Menus,PCFileDlgs,PCDrawBox,
PCMsbar,GUIStrings,ShellAPI, {Tolik} Math;
type
TTraceState = ( tsSelect,tsLine,tsRect,tsEllipse,tsCircle,tsElpArc,
tsArc1,tsBezier,tsPolyLine,tsPolygon,tsCosCurve,tsText,tsKnife,tsRotate,tsZoom,tsNone);
TTraceLineState = (lsBoth,lsVert,lsHorz);
TPopStyle = (psStandart,psNone,psCancel);
TFileDropStyle = (dfsNone,dfsManual,dfsAutomatic);
TCustomCommandEvent = Procedure (Sender:Tobject; ComName: String) of Object;
TGetPopItemsEvent = Procedure(Sender: TObject; var PopItems:String) of Object;
TPopClickEvent = Procedure(Sender:TObject; MenuIndex: Integer) of Object;
TFigurePopClickEvent = Procedure(Sender:TObject;Figure:TFigure; MenuIndex: Integer) of Object;
TStatusMessages = Procedure(Sender:TObject; Status1,Status2,Status3,Status4: String) of Object;
TGUIEvent = Procedure (Sender:TObject;EventId:Integer;Numval:Integer;StrVal: String;DblVal:Double;CEnable:Boolean) of Object;
TMoveByArrowEvent = Procedure(Sender:TObject;dx,dy:Double; var CanMove:Boolean) of Object;
TKeyStrokeEvent = Procedure(Sender:TObject;Key:Word;Shift:TShiftState; var CanHandle:Boolean) of Object;
TKeyStrokeEventVB = Procedure(Sender:TObject;Key:Word;Shift:Integer; var CanHandle:Boolean) of Object;
TDropFilesEvent = procedure(Sender: TObject; FileList: String; dropX,dropY:Double) of object;
TFigureDrawInfoEvent = Procedure (Sender:TObject; Figure:TFigure; var Info:String) of Object;
(*vbclassexport begin*)
TPowerCad = class(TPCDrawing)
private
{ Private declarations }
info1: string;
info2: string;
info3: string;
TraceState : TTraceState;
PushPoint : TDoublePoint;
fMCommand: Boolean;
FPopStyle: TPopStyle;
FCustomCommand: TCustomCommandEvent;
FStandartMnIndex: Integer;
fPopClick: TPopClickEvent;
FFigurePopClick: TFigurePopClickEvent;
fFileChange: TNotifyEvent;
FOnStatus: TStatusMessages;
FGUIEvent: TGUIEvent;
BlockDirectory: String;
FActiveFile:String;
FCurrentColor: TColor;
FCurrentStyle: Byte;
FCurrentString: String;
FCurrentFlag: Boolean;
FCurrentValue: Double;
FCurrentFileName: String;
FCustomPop: String;
FOnRefresh: TNotifyEvent;
FOnTraceDraw: TFigureEvent;
FToolChanged: TNotifyEvent;
FOnMoveByArrows: TMoveByArrowEvent;
FMirrorStraight: Boolean;
FOnKeyStroke: TKeyStrokeEvent;
FOnKeyStrokeVB: TKeyStrokeEventVB;
FDrawingPop: Boolean;
FAcceptFiles: TFileDropStyle;
FOnDropFiles: TDropFilesEvent;
FExtension: String;
FOnDrawFigureInfo: TFigureDrawInfoEvent;
FMultiSelect: Boolean;
FSaveDialogFilter: String;
FOpenDialogFilter: String;
FSaveDialogTitle: String;
FOpenDialogTitle: String;
FBeforeEndTrace: TNotifyEvent;
procedure SetAcceptFiles(Value: TFileDropStyle);
procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
Procedure DoDropFiles(FileList:TStringList;DropPoint:TPoint);
Procedure SetGUIEvent(Value:TGUIEVENT);
Procedure RaiseOnStatus;
procedure MenuClicked(Sender: tobject);
Procedure StartModification;
Procedure TraceModification(x,y: Double);
Procedure EndModification(x,y: Double);
Function DocIdx:Integer;
Procedure SetFileChange(Value:TNotifyEvent);
protected
{ Protected declarations }
OpenPictureDialog : TOpenPictureDialog;
fPrintDialog: TPrintDialog;
fPrinterSetUp: TPrinterSetupDialog;
evInfo1: TEventengine;
evInfo2: TEventengine;
evInfo3: TEventengine;
Procedure DrawTrace;override;
Procedure RegisterSystemEvents;
Procedure UnRegisterSystemEvents;
Procedure KillTraceFigure;override;
Procedure SyncEnv;override;
Procedure CMFontChange(var Mes: TMessage);message CM_FONTCHANGED;
// mouse sensibility procs
Procedure MSPush(sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Double);override;
procedure MSTrace(Sender: TObject; Shift: TShiftState; X,Y: Double);override;
procedure MSPull(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double);override;
procedure MSDropDrag(Sender:Tobject; Source: Integer; X, Y: Double);override;
procedure MSDragOver(Sender:TObject; Source: Integer; X, Y: Double;State: TDragState; var Accept: Boolean);override;
procedure MSEndDrag(Sender, Target: TObject; X, Y: Double);override;
procedure MSStartDrag(Sender: TObject; var DragObject: TDragObject);override;
procedure MSClick(Sender: TObject);override;
procedure MSDblClick(Sender: TObject);override;
Procedure MSLeave(Sender: TObject);override;
Procedure DragTrace(x,y:Double);
Procedure DragDropped(x,y:Double);
Procedure DragStarted;override;
Procedure SelectPoint(ModPoint:TModPOint);
Function GetScreenPosition(pnt:TDoublePoint):TPoint;
Procedure RaiseSystemEvent(EventId: Integer; Numval:Integer;StrVal: String;
DblVal:Double;Enabled:Boolean);
//Procedure SetInterfaceHandle;override;
// Procedure EndTrace(Shift:TShiftState);
public
{ Public declarations }
ModPoint : TModPoint;
NeedRefresh: Boolean;
TraceDeltaX: Double;
TraceDeltaY : Double;
PopMenu : TPopUpMenu;
ModLock: Boolean;
//*** ToolBar Commands - Non Parametric Procedures ***//
//Tolik 28/08/2019 --
//FDragStartedTick: Cardinal; //24.04.2012
//FDragDragDroppedTick: Cardinal; //24.04.2012
//FDragOverTime: Cardinal; //24.04.2012
//FSelectTick: Cardinal; //24.04.2012
FDragStartedTick: DWord; //24.04.2012
FDragDragDroppedTick: DWord; //24.04.2012
FDragOverTime: DWord; //24.04.2012
FSelectTick: DWord;
//
//FStartDragTick: Cardinal; //21.06.2013
Function cNewDrawing:Boolean;(*vb*)
Procedure cOpenDrawing;(*vb*)
Procedure cOpenDrawingFile(fName:String);(*vb*)
Procedure cSaveDrawing;(*vb*)
Procedure cSaveAsDrawing;(*vb*)
Procedure cPrintDrawing;(*vb*)
Procedure cPrintDrawingAsWmf;(*vb*)
Procedure cTestPrinter;(*vb*)
Procedure cExportAs;(*vb*)
Procedure cImportDxf;(*vb*)
procedure _DrawTrace;
Procedure EndTrace(Shift:TShiftState);
Procedure DoPopUp(x,y:Double);(*vb*)
Procedure DoFigureModify(Figure:TFigure);
Function DoKeyStroke(ChCode:Integer;Shift:Integer):Boolean;override;(*vb*)
Procedure ResetActions;override;(*vb*)
Procedure CancelActions;override;(*vb*)
constructor create(aowner: Tcomponent);override;
destructor destroy;override;
Procedure ExecuteTBCommand(commandID: TTBCommand);override;(*vb*)
Procedure ExecuteCustomCommand(commandName: String);virtual;(*vb*)
Procedure ExecuteVerbalCommand(Command:String);virtual;(*vb*)
Procedure PrintMessage(Mes:String);override;(*vb*)
Function ExitApplication:Boolean;(*vb*)
Procedure SetTool(aToolIndex: TPCTool;aToolInfo:String;aToolData:Integer);overload;override;(*vb*)
Procedure SetTool(aToolIndex: TPCTool;aToolInfo:String);overload;
Function IsUnNamed:Boolean;(*vb*)
Procedure Refresh;override;(*vb*)
//Tolik -- 18/11/2015 -- <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> KillTraceFigure
procedure KillTraceFig(aRefresh: Boolean = True);
//
Property RPushPoint: TDoublePoint read PushPoint;
Property ActiveFile:String read FActiveFile write FActiveFile;(*vb*)(* default '' *)
Property CurrentColor: TColor read FCurrentColor write FCurrentColor default clWhite;(*vb*)
Property CurrentStyle: Byte read FCurrentStyle write FCurrentStyle;(*vb*) (* default 0 *)
Property CurrentString: String read FCurrentString write FCurrentString;(*vb*) (* default '' *)
Property CurrentFlag: Boolean read FCurrentFlag write FCurrentFlag default False;(*vb*)
Property CurrentFileName: String read FCurrentFileName write FCurrentFileName;(*vb*)(* default '' *)
Property CurrentValue: Double read FCurrentValue write FCurrentValue;(*vb*)(* default 0 *)
Property FileExtension:String read FExtension write FExtension;(*vb*)(* default 'pwd' *)
Property MultiSelect:Boolean read FMultiSelect write FMultiSelect default True;(*vb*)
Property OpenDialogTitle:String read FOpenDialogTitle write FOpenDialogTitle;(*vb*)(* default '' *)
Property OpenDialogFilter:String read FOpenDialogFilter write FOpenDialogFilter;(*vb*)(* default '' *)
Property SaveDialogTitle:String read FSaveDialogTitle write FSaveDialogTitle;(*vb*)(* default '' *)
Property SaveDialogFilter:String read FSaveDialogFilter write FSaveDialogFilter;(*vb*)(* default '' *)
property OnDrawFigureInfo: TFigureDrawInfoEvent read FOnDrawFigureInfo write FOnDrawFigureInfo;(*vb*)
published
property AcceptFiles: TFileDropStyle read FAcceptFiles write SetAcceptFiles default dfsNone;(*vb*)
Property MouseCommands:Boolean read fMCommand write fMCommand default True;(*vb*)
Property PopStyle:TPopStyle read FPopStyle write FPopStyle default psStandart;(*vb*)
Property CustomPopItems:String read FCustompop write fCustomPop;(*vb*)(* default '' *)
Property MirrorStraight:Boolean read FMirrorStraight write FMirrorStraight default False;(*vb*)
Property DrawingPop:Boolean read FDrawingPop write FDrawingPop default True;(*vb*)
Property OnCustomCommand: TCustomCommandEvent read FCustomCommand write FCustomCommand;(*vb*)
Property OnPopMenuClicked: TPopClickEvent read FPopClick write FPopClick;(*vb*)
Property OnFigurePopMenuClicked: TFigurePopClickEvent read FFigurePopClick write FFigurePopClick;(*vb*)
Property OnFileNameChange:TNotifyEvent read FFileChange write SetFileChange;(*vb*)
Property OnStatusMessages:TStatusMessages read FOnStatus write FOnStatus;(*vb*)
Property OnGUIEvent:TGUIEvent read FGUIEvent write SetGUIEvent;(*vb*)
Property OnRefresh:TNotifyEvent read FOnRefresh write FOnRefresh;(*vb*)
Property OnTraceDraw:TFigureEvent read FOnTraceDraw write fOnTraceDraw;(*vb*)
Property OnToolChanged:TNotifyEvent read FToolChanged write FToolChanged;(*vb*)
Property OnMoveByArrows:TMoveByArrowEvent read FOnMoveByArrows write FOnMoveByArrows;(*vb*)
Property OnKeyStroke:TKeyStrokeEvent read FOnKeyStroke write FOnKeyStroke;
Property OnKeyStrokeVB:TKeyStrokeEventVB read FOnKeyStrokeVB write FOnKeyStrokeVB;(*vb*)
property OnDropFiles: TDropFilesEvent read FOnDropFiles write FOnDropFiles;(*vb*)
property OnBeforeEndTrace: TNotifyEvent read FBeforeEndTrace write FBeforeEndTrace; //25.11.2011
end;
(*vbclassexport end*)
Procedure SystemEventCallback(Client:TObject; EventId: Integer; Numval:Integer;
StrVal: String; DblVal:Double;Enabled:Boolean);stdcall;
implementation
uses U_Common, U_BaseCommon, U_HouseClasses, U_ESCadClasess, {Tolik 30/11/2015} U_CAD, USCS_Main, U_BaseConstants, U_Main;
var
//LayersDlg: TPCLayerDlg=nil;
//MacroDlg: TPCMacroDialog=nil;
//BlockDlg: TPCBlockDlg=nil;
FirstDrag:Boolean=False;
DIdx : Integer;
{$R *.RES}
{$R *.DCR}
var
nbrPoint : integer;
basePoint : TPoint;
tracelinestate : TTraceLineState;
scalecenter : TPoint;
scalerect : TRect;
xAngle,Deltax,DeltaY,len,scalex,scaley,perxtot,perytot : integer;
px,py: integer;
//DragState: integer;
DblCLicked : Boolean;
SelRect : TDoubleRect;
LastX,LastY : Double;
FigClass : TFigureClass;
Procedure SystemEventCallback(Client:TObject; EventId: Integer; Numval:Integer;
StrVal: String; DblVal:Double;Enabled:Boolean);
begin
if Client is TPowercad then begin
TPowercad(Client).RaiseSystemEvent(EventId,NumVal,StrVal,DblVal,Enabled);
end;
end;
constructor TPowerCad.create(aowner: Tcomponent);
var a: integer;
begin
inherited create(aowner);
FMultiSelect := True;
FExtension := 'pwd';
ModLock := False;
NeedRefresh := False;
FDrawingPop := True;
evInfo1 := EventEngine(cInfoXY,0,'',0);
evInfo2 := EventEngine(cInfoDim,0,'',0);
evInfo3 := EventEngine(cInfoMes,0,'',0);
ActiveFile := asDrawing+inttostr(DocIdx);
if assigned(FFileChange) then FFileChange(self);
OpenPictureDialog := TOpenPicturedialog.Create(self);
fPrintDialog := TPrintDialog.Create(self);
fPrintDialog.Options := fPrintDialog.Options+ [poPrintToFile];
fPrinterSetup := TPrinterSetUpDialog.Create(Self);
PopMenu := TPopUpMenu.Create(self);
FOpenDialogTitle := titOpenPowerCADDrawing;
FOpenDialogFilter := fltPowerCADDrawings;
FSaveDialogTitle := titSavePowerCADDrawing;
FSaveDialogFilter := fltPowercadDrawings;
TraceState := tsNone;
ClickIndex := 0;
DragReady := false;
DblClicked := false;
fMCommand := True;
fPopStyle := psStandart;
FMirrorStraight := False;
//if FAutoGui then CreateGui;
RegisterSystemEvents;
AcceptFiles := dfsNone;
FDragStartedTick := 0; //24.04.2012
FDragDragDroppedTick := 0; //24.04.2012
FDragOverTime := 0; //24.04.2012
FSelectTick := 0; //24.04.2012
end;
Destructor TPowerCad.destroy;
var s: string;
begin
OpenPictureDialog.Free;
// OpenPictureDialog := Nil;
// s := OpenPictureDialog.DefaultExt;
fPrintDialog.Free;
PopMenu.Free;
fPrinterSetup.Free;
UnregisterSystemEvents;
inherited destroy;
end;
Procedure TPowercad.ResetActions;
Begin
TraceState := tsNone;
ClickIndex := 0;
end;
Procedure TPowercad.CancelActions;
begin
DrawTrace;
KillTraceFigure;
CancelDrag;
CurrentShift := [];
DragState := dsNone;
TraceState := tsNone;
isDragging := false;
if ClickIndex = 0 then begin
SetTool(toSelect,'');
end;
ClickIndex := 0;
Refresh;
end;
Procedure TPowercad.MSPush(Sender: TObject;Button: TMouseButton; Shift: TShiftState; X, Y: Double);
var popP: TPoint;
a,b,c,d,e:integer;
mnItem,subItem: TMenuItem;
snp: Boolean;
mnIndex: integer;
cnt,lncnt,p,i: integer;
mdP: Tpoint;
pixX,pixY: Double;
popItems,pItem,blankS:String;
done:Boolean;
ModPointList: TList;
Fig_ID: Integer; //Tolik
function HasConnectedOrthoLines(aObj: TConnectorObject):Boolean;
var i: integer;
begin
Result := False;
if aObj.ConnectorType = ct_Clear then
begin
if aObj.JoinedOrthoLinesList.Count > 0 then
Result := True;
end
else
if aObj.ConnectorType = ct_NB then
begin
for i := 0 to aObj.JoinedConnectorsList.Count - 1 do
begin
if TConnectorObject(aObj.JoinedConnectorsList[i]).JoinedOrthoLinesList.Count > 0 then
begin
Result := True;
break;
end;
end;
end;
end;
begin
if CustomWnd <> 0 then
Windows.SetFocus(CustomWnd)
else
if Self.Visible and (assigned(self.parent)) then
SetFocus;
if Button = mbLeft then
shift := shift+[ssLeft];
if Button = mbRight then
shift := shift+[ssRight];
if not fMCommand then
exit;
CurrentShift := Shift;
LastX := x;
LastY := y;
if DblClicked then
begin
DblClicked := false;exit;
end;
SetDefaultEngine;
If (ToolIdx = toSelect) or (ToolIdx = toDelete) then
begin
if clickIndex = 0 then
begin
if not modLock then
begin
(* SDM <20>l<EFBFBD> modpoint d<>zeltmesi 26.04 *)
if assigned(CurrentModPoint) and (ModPoints.IndexOf(CurrentModPoint) <> -1) then
(* ENDSDM *)
ModPoint := CurrentModPoint
else
ModPoint := HitTestModPoint(x,y);
end;
if (ModPoint <> nil) then
begin
//Tolik -- 27/11/2021 - -
if ((ssLeft in Shift) and ((ssCtrl in shift) or (ssShift in Shift))) then
begin
if Assigned(ModPoint.Figure) then
begin
if not ModPoint.Figure.Deleted then
begin
if ((TFigure(ModPoint.Figure) is TConnectorObject) or (TFigure(ModPoint.Figure) is TOrthoLine)) then
begin
Fig_ID := TFigure(ModPoint.Figure).ID;
TConnectorObject(ModPoint.Figure).deselect;
DeSelectSCSFigureInPM(Fig_ID);
RefreshSelection;
end;
end;
end;
end
else
begin
//
try
if Assigned(FGetModPointToSelect) then
FGetModPointToSelect(Self, Modpoint, x, y);
x := ModPoint.CoordX;
y := ModPoint.CoordY;
FToolInfo := ModPoint.Figure.ClassName;
mdp := GetScreenPosition(DoublePoint(x,y));
//SetCursorPos(MdP.X,MdP.Y);
if assigned(ModPoint.Figure) then
begin
SelectPoint(ModPoint);
RedrawSelectionPoints;
end;
If (ModPoint.PType <> ptUndefined) then
begin
if button = mbLeft then
begin
if assigned(ModPoint.Figure) and TFigure(ModPoint.Figure).LockModify then
begin
exit;
end;
//SetDragCursor(crDrag);
DragStartX := x;
DragStartY := y;
DragOldX := x;
DragOldY := y;
DragReady := true;
DragState := dsMod;
FSelectTick := GetTickCount; //24.04.2012
exit;
end;
end;
except
ModPoint := HitTestModPoint(x,y);
end;
end;
end
else
begin
if assigned(CurrentIsoFigure) then
begin
SelectByFigure(ActiveLayer,CurrentIsoFigure.Handle,((ssShift in shift) or (ssCtrl in Shift)) and FMultiSelect);
if (Selection.Count = 1) then
begin
FToolInfo := TFigure(Selection[0]).ClassName;
end;
end
else
if selectbypoint(ActiveLayer,x,y,((ssShift in shift) or (ssCtrl in Shift) {or (Button = mbRight)}) and FMultiSelect) then
begin
if (button = mbLeft) and (toolIdx = toDelete) then begin
RemoveSelection;
Refresh;
end
else
if button = mbLeft then
begin
if (ModLock) or ((Selection.Count > 0) and TFigure(Selection[0]).LockMove) then
begin
exit;
end;
//SetDragCursor(crDrag);
//CalculateSnapPoint(x,y);
//mdp := GetScreenPosition(DoublePoint(x,y));
//SetCursorPos(MdP.X,MdP.Y);
DragStartX := x;
DragStartY := y;
DragOldX := x;
DragOldY := y;
DragReady := true;
// Tolik 06/08/2018 - - <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> DragState := dsMod;
if (Selection.Count = 1) then
//if TFigure(Selection[0]).ClassName = 'TConnectorObject' then
if ((TFigure(Selection[0]).ClassName = 'TConnectorObject') and (HasConnectedOrthoLines(TConnectorObject(Selection[0])) = true)) then
begin
ModPoint := HitTestModPoint(x,y);
if ModPoint = nil then
begin
//ModPointList := TList.Create;
//TConnectorObject(Selection[0]).GetModPoints(ModPointList);
//if ModPointList.Count > 0 then
// ModPoint := TModPoint(ModPointList[0]);
//ModPointList.Free;
if TConnectorObject(Selection[0]).GetselPoints.Count > 0 then
ModPoint := TModPoint(TConnectorObject(Selection[0]).GetselPoints[0]);
end;
if (ModPoint <> nil) then
begin
try
if Assigned(FGetModPointToSelect) then
FGetModPointToSelect(Self, Modpoint, x, y);
x := ModPoint.CoordX;
y := ModPoint.CoordY;
FToolInfo := ModPoint.Figure.ClassName;
mdp := GetScreenPosition(DoublePoint(x,y));
//SetCursorPos(MdP.X,MdP.Y);
if assigned(ModPoint.Figure) then
begin
SelectPoint(ModPoint);
RedrawSelectionPoints;
end;
If (ModPoint.PType <> ptUndefined) then
begin
if button = mbLeft then
begin
if assigned(ModPoint.Figure) and TFigure(ModPoint.Figure).LockModify then
begin
exit;
end;
//SetDragCursor(crDrag);
DragStartX := x;
DragStartY := y;
DragOldX := x;
DragOldY := y;
DragReady := true;
DragState := dsMod;
FSelectTick := GetTickCount; //24.04.2012
exit;
end;
end;
except
ModPoint := HitTestModPoint(x,y);
end;
end;
end;
//
DragState := dsMove;
FSelectTick := GetTickCount; //24.04.2012
if (Selection.Count = 1) then
begin
FToolInfo := TFigure(Selection[0]).ClassName;
end;
end;
end
else
begin
if not (CheckGuideLine(x,y)) and (button = mbLeft) then
begin
clickIndex := 1;
PushPoint := DoublePoint(x,y);
TraceState := tsRect;
KillTraceFigure;
TraceFigure := TRectangle.create(x,y,x,y,1,1,clLime,1,clWhite,0,dsTrace,self);
DrawTrace;
end;
end;
end;
end;
end
else
if (ToolIdx = toLocate) then
begin
DragStartX := x;
DragStartY := y;
DragOldX := x;
DragOldY := y;
DragReady := true;
DragState := dsLocate;
FSelectTick := GetTickCount; //24.04.2012
end;
if (Button = mbright) and (ToolIdx = toSelect) then
begin
DoPopUp(x,y);
exit;
end;
If (ToolIdx=toZoom) or (ToolIdx = toDetailZoom) then
begin
clickIndex := 1;
PushPoint := DoublePoint(x,y);
TraceState := tsrect;
KillTraceFigure;
TraceFigure := TRectangle.create(x,y,x,y,1,1,clLime,1,clWhite,0,dsTrace,self);
DrawTrace;
end;
end;
procedure TPowercad.MSTrace(Sender: TObject; Shift: TShiftState; X,Y:Double);
var x1,y1,rad,perx,pery,dx,dy: Double;
ix,a: integer;
len,tanD,a1,a2,a3 : real;
clName: string;
p1,p2,p3: TDoublePoint;
infox,infoy: string;
FTraceTime, FTraceTick: cardinal;
begin
if not fMCommand then
exit;
CurrentShift := shift;
SetDefaultEngine;
//////////
FTraceTick := GetTickCount; //24.04.2012
FTraceTime := Abs(FTraceTick - FSelectTick);
if FTraceTime < 50 then //16.03.2021 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
begin
dragStartx := x;
dragStarty := y;
end;
///////////
dx := abs(x - dragStartx);
dy := abs(y - dragStarty);
ConvertDim(dx);
ConvertDim(dy);
//if DragReady and ((dx > 0) or (dy>0)) then
if DragReady and ((dx > 5) or (dy > 5)) then
begin
DragReady := false;
//24.04.2012 - <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Drag.
//24.04.2012 <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//21.06.2013
//if Abs(GetTickCount - FSelectTick) > 50 then
// DragStarted;
DragStarted; //21.06.2013
Exit;
end
else
if isDragging then
begin
if ssshift in shift then
DragTrace(x,y)
else
DragTrace(x,y);
Exit;
end;
if (TraceFigure <> nil) and (ssctrl in shift) and (ClickIndex > 0) then
begin
x1 := TraceFigure.ActualPoints[clickIndex].x;
y1 := TraceFigure.ActualPoints[clickIndex].y;
dx := abs(x-x1);
dy := abs(y-y1);
if dy < dx then y := y1
else x := x1;
end;
if (TraceFigure <> nil) and (ClickIndex <> 0) then
begin
Drawtrace;
TraceFigure.Shift := Shift;
TraceFigure.ShadowTrace(ClickIndex,x,y);
DrawTrace;
end;
if RulerSystem = rsMetric then
begin
infox := ' x: '+ floattostrf(x,ffFixed,16,2);
infoy := ' y: '+ floattostrf(y,ffFixed,16,2);
end
else
begin
infox := ' x: '+ floattostrf(((x/10)/2.54),ffFixed,16,2);
infoy := ' y: '+ floattostrf(((y/10)/2.54),ffFixed,16,2);
end;
info1 := infox+' '+infoy;
evInfo1.RaiseEvent(info1);
if (TraceFigure <> nil) and (ClickIndex > 0) then
begin
x1 := TraceFigure.ActualPoints[clickIndex].x;
y1 := TraceFigure.ActualPoints[clickIndex].y;
dx := abs(x-x1);
dy := abs(y-y1);
len := sqrt(dx*dx+dy*dy);
info2 := ' L: ('+ floattostrf(len,ffFixed,16,2)+ ') '+ floattostrf(len*MapScale,ffFixed,16,2);
evInfo2.RaiseEvent(info2);
len := GetRadOfLine(TraceFigure.ActualPoints[clickIndex],DoublePoint(x,y));
if (len > 0) and (verticalzero = vzTop) then len := 2 * pi - len;
if TraceFigure is TRotate then
begin
len := Trotate(TraceFigure).GetAngle;
end;
info3 := ' <: '+Inttostr(Round(((len)/pi)*180))+'<27>';
evInfo3.RaiseEvent(info3);
if (Tracefigure is TPolyline) and (ClickIndex > 1) then
begin
p1 := TraceFigure.ActualPoints[clickIndex-1];
p2 := TraceFigure.ActualPoints[clickIndex];
p3 := DoublePoint(x,y);
a1 := GetRadOfLine(p2,p1);
a2 := GetRadOfLine(p2,p3);
a3 := abs(a2-a1);
info3 := ' <<: '+Inttostr(Round((a3/pi)*180))+'<27>';
evInfo3.RaiseEvent(info3);
end;
end;
RaiseOnStatus;
end;
procedure TPowercad.MSPull(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Double);
var row,ix,a : integer;
x1,y1,dx,dy: Double;
Lines: TstringList;
tmpx,tmpY: Double;
ap1,ap2: TDoublePoint;
Fnished: Boolean;
NewFigure: TFigure;
clname: string;
oneline: boolean;
insertState: TInsertState;
OpenDialog: TOpenDialog;
begin
// if DDragging then exit;
if not fMCommand then exit;
if Button = mbLeft then shift := shift+[ssLeft];
if Button = mbRight then shift := shift+[ssRight];
info2 := '';
if assigned(evInfo2) then evInfo2.RaiseEvent(info2);
info3 := '';
if assigned(evInfo3) then evInfo3.RaiseEvent(info3);
RaiseOnStatus;
if isDragging then begin
DragDropped(x,y);
exit;
end;
DragReady := False;
isDragging := False;
DragState := dsNone;
if (ssctrl in shift) and (ClickIndex > 0) then begin
x1 := TraceFigure.ActualPoints[clickIndex].x;
y1 := TraceFigure.ActualPoints[clickIndex].y;
dx := abs(x-x1);
dy := abs(y-y1);
if dy < dx then y := y1
else x := x1;
end;
if ToolIdx = toLocate then exit;
if ToolIdx = toDelete then exit;
inc(ClickIndex);
/// Select
if ToolIdx = toSelect then
begin
DragReady := false;
if (TraceFigure <> nil) and (ClickIndex = 2) then
begin
TraceState := tsNone;
with TraceFigure do
begin
DrawTrace;
// select the inner area
if not((pushpoint.x = x) or (pushpoint.y = y)) then
begin
if ZoomRect then
begin
ZoomArea(DoubleRect( actualpoints[1].x,
actualpoints[1].y,
actualpoints[3].x,
actualpoints[3].y));
end
else
begin
selectwithinArea (ActiveLayer,
DoubleRect( actualpoints[1].x,
actualpoints[1].y,
actualpoints[3].x,
actualpoints[3].y),
((ssShift in shift) or (ssCtrl in Shift)) and FMultiSelect );
end;
end;
end;
end;
ClickIndex := 0;
KillTraceFigure;
exit;
end
else if (ToolIdx = toMWand) then
begin
DoMagicWand(ActiveLayer,x,y);
end else if (ToolIdx = toZoom) or (ToolIdx = toDetailZoom) then
begin
if (TraceFigure <> nil) and (ClickIndex = 2) then
begin
TraceState := tsNone;
with TraceFigure do
begin
DrawTrace;
if not((pushpoint.x = x) or (pushpoint.y = y)) then
begin
with TraceFigure do
begin
DrawTrace;
if not ((x = actualpoints[1].x) and (y = actualpoints[1].y)) then
begin
if (ToolIdx = toZoom) then
ZoomArea(DoubleRect(actualpoints[1].x,actualpoints[1].y,actualpoints[3].x,actualpoints[3].y))
else
begin
FDetail := True;
ZoomDetailArea(DoubleRect(actualpoints[1].x,actualpoints[1].y,actualpoints[3].x,actualpoints[3].y));
end;
end;
end;
TraceState := tsNone;
refresh;
end;
end;
end;
ClickIndex := 0;
KillTraceFigure;
end
else if ToolIdx = toInsertBlock then
begin
if Button = mbRight then
begin
ResetActions;
Exit;
end;
RegRead('BlockDir',BlockDirectory);
OpenDialog := TOpenDialog.Create(self);
OpenDialog.InitialDir := BlockDirectory;
OpenDialog.Filter := stBlockFilter;
if not (((ssShift in shift) or (ssCtrl in Shift)) and FMultiSelect) then deselectall(0);
if OpenDialog.Execute then
begin
NewFigure := TFigure(InsertBlockWithFileName(ActiveLayer,OpenDialog.FileName,x,y));
if assigned(newFigure) then RecordInsertUndo(NewFigure);
Updated := True;
end;
ClickIndex := 0;
OpenDialog.Free;
end
else if ToolIdx = toInsertCurrentBlock then
begin
if Button = mbRight then
begin
ResetActions;
Exit;
end;
if not (((ssShift in shift) or (ssCtrl in Shift)) and FMultiSelect) then deselectall(0);
NewFigure := TFigure(InsertBlockWithFileName(ActiveLayer,ToolInfo,x,y));
if assigned(newFigure) then RecordInsertUndo(NewFigure);
Updated := True;
ClickIndex := 0;
end
else if ToolIdx = toInsertUserPicture then
begin
if Button = mbRight then
begin
ResetActions;
Exit;
end;
NewFigure := nil;
if not (((ssShift in shift) or (ssCtrl in Shift)) and FMultiSelect) then deselectall(0);
if ToolInfo <> '' then begin
NewFigure := TFigure(InsertBitmap(ActiveLayer,x,y,ToolInfo,false,true));
end else if (ToolData <> 0) then begin
NewFigure := TFigure(InsertBitmapHandle(ActiveLayer,x,y,TBitmap(ToolData),false,true));
end;
if assigned(newFigure) then RecordInsertUndo(NewFigure);
Updated := True;
ClickIndex := 0;
end
else
begin
figClass := nil;
for a := 0 to FigureClasses.Count -1 do
begin
clName := TFigureClass(FigureClasses[a]).ClassName;
if uppercase(clName) = uppercase(ToolInfo) then
FigClass := TFigureClass(FigureClasses[a]);
end;
Fnished := false;
If ClickIndex = 1 then
begin
KillTraceFigure;
if assigned(FigClass) then TraceFigure := FigClass.createShadow(x,y);
if assigned(TraceFigure) then begin
if FigClass = TMirror then begin
TMirror(TraceFigure).Straight := FMirrorStraight;
SnapInfo := 'TMirror';
end;
TraceFigure.vertZero := ord(VerticalZero);
TraceFigure.horzZero := ord(HorizontalZero);
if FigClass.IsOneClick then Fnished := true;
end else begin
ClickIndex := 0;
end;
end;
if (not fnished) and assigned(TraceFigure) then begin
TraceFigure.Shift := Shift;
if ClickIndex > 1 then DrawTrace;
Fnished := TraceFigure.ShadowClick(ClickIndex,x,y);
DrawTrace;
end;
if Button = mbRight then Fnished := true;
if Fnished and assigned(TraceFigure) then begin
EndTrace(Shift);
end;
end;
end;
procedure TPowercad.MSDropDrag(Sender: TObject;Source:Integer; X, Y:Double);
var BBox : TPaintBox;
fHandle: TFigHandle;
begin
if not fMCommand then exit;
if Source = oleDs_BlockBox then
begin
if not fileexists(FBlockDrop) then exit;
fhandle := InsertBlockWithFileName(ActiveLayer,FBlockDrop,x,y);
if fHandle <> 0 then RecordInsertUndo(TFigure(fhandle));
end;
DragState := dsNone;
end;
Procedure TPowercad.DragStarted;
begin
inherited;
FirstDrag := True;
SnapLocked := false;
DragDeltaX := 0;
DragDeltaY := 0;
If DragState = dsMove then
begin
SetCursor(crDrag);
If (Selection.Count = 1) and (not(TFigure(Selection[0]) is TFigureGrp)) then
begin
KillTraceFigure;
TFigure(Selection[0]).TracePoint := nil;
TraceFigure := TFigure(Selection[0]).CreateModification;
if assigned(TraceFigure) then
begin
TraceFigure.vertZero := ord(VerticalZero);
TraceFigure.horzZero := ord(HorizontalZero);
SnapInfo := TraceFigure.Cname;
end;
end
{
else
If (Selection.Count = 2) and ((TFigure(Selection[0]).ClassName = 'TFigureGrpMod') or (TFigure(Selection[1]).className = 'TFigureGrpMod'))
and ((TFigure(Selection[0]).ClassName = 'TConnectorObject') or (TFigure(Selection[1]).className = 'TConnectorObject')) then
begin
KillTraceFigure;
if TFigure(Selection[0]).ClassName = 'TConnectorObject' then
begin
TFigure(Selection[0]).TracePoint := nil;
TraceFigure := TFigure(Selection[0]).CreateModification;
end
else
if TFigure(Selection[1]).ClassName = 'TConnectorObject' then
begin
TFigure(Selection[1]).TracePoint := nil;
TraceFigure := TFigure(Selection[1]).CreateModification;
end;
if assigned(TraceFigure) then
begin
TraceFigure.vertZero := ord(VerticalZero);
TraceFigure.horzZero := ord(HorizontalZero);
SnapInfo := TraceFigure.Cname;
end;
end
}
else
begin
KillTraceFigure;
SelRect := GetSelectionRect;
with SelRect do
begin
TraceFigure := TRectangle.create(Left,Top,Right,Bottom,1,1,clLime,1,clWhite,0,dsTrace,self);
end;
end;
end
else
if DragState = dsMod then
begin
SetCursor(crDrag);
StartModification;
end
else
if DragSTate = dsLocate then
begin
KillTraceFigure;
SelRect := GetDrawingRect;
TraceFigure := TRectangle.create(SelRect.Left,SelRect.Top,SelRect.Right,SelRect.Bottom,1,1,clLime,1,clWhite,0,dsTrace,self);
end;
FDragStartedTick := GetTickCount; //24.04.2012
end;
Procedure TPowercad.DragDropped(x,y:Double);
var
fig:Tfigure;
i:Integer;
SaveGCadRefreshFlag: boolean;
begin
//<2F><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>-<2D><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>
SaveGCadRefreshFlag := GCanRefreshCad;
GCanRefreshCad := false;
try
FDragDragDroppedTick := GetTickCount; //24.04.2012
FDragOverTime := Abs(FDragDragDroppedTick - FDragStartedTick);
IsDragging := False;
if ToolIdx = toSelect then
SetCursor(crDefault)
else
if ToolIdx = toLocate then
SetCursor(crLocate);
CalculateSnapPoint(x,y);
DrawTrace;
If DragState = dsMove then
begin
for i := 0 to Selection.Count - 1 do
TFigure(Selection[i]).DragMove := True;
if Selection.Count = 1 then
fig := TFigure(Selection[0]);
if assigned(OnBeforeMove) then
OnBeforeMove(Self, fig, x - DragStartX + dragDeltaX, y - DragStartY + dragDeltaY);
MoveSelection(x - DragStartX + dragDeltaX, y - DragStartY + dragDeltaY);
for i := 0 to Selection.Count - 1 do
TFigure(Selection[i]).DragMove := False;
Updated := True;
GCanRefreshCad := SaveGCadRefreshFlag;
KillTraceFigure;
FToolInfo := '';
end
else
if DragState = dsMod then
begin
// Tolik 17/03/2021 -- <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> 150 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//if FDragOverTime < 150 then //21.06.2013 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
if FDragOverTime < 50 then //21.06.2013 - <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//
begin
//21.06.2013 - <20><><EFBFBD><EFBFBD><EFBFBD> <20><> EndModification
CurrentShift := [];
DragState := dsNone;
GCanRefreshCad := SaveGCadRefreshFlag;
KillTraceFigure;
end
else
begin
if assigned(OnBeforeMove) then
OnBeforeMove(Self, fig, x - DragStartX + dragDeltaX, y - DragStartY + dragDeltaY);
EndModification(x, y);
FToolInfo := '';
Updated := True;
end;
end
else
if DragState = dsLocate then
begin
MoveAll(x - DragStartX + dragDeltaX, y - DragStartY + dragDeltaY);
GCanRefreshCad := SaveGCadRefreshFlag;
KillTraceFigure;
Updated := True;
FToolInfo := '';
end;
except
end;
GCanRefreshCad := SaveGCadRefreshFlag;
refresh;
DragState := dsNone;
end;
Procedure TPowercad.DragTrace(x,y:Double);
var guType:TGuideType;
xSource: Integer;
dist: Integer;
xCanvas: TCanvas;
begin
SetDefaultEngine;
if firstdrag then
firstDrag := false
else
DrawTrace;
TraceDeltaX := x-DragOldX;
TraceDeltaY := y-DragOldy;
if (DragState = dsMove) or (DragState = dsLocate) then
begin
if assigned(TraceFigure) then TraceFigure.move(x-DragOldX,y-DragOldY);
DrawTrace;
end
else
if DragState = dsMod then
begin
TraceModification(x,y);
DrawTrace;
end;
DragOldX := x;
DragOldY := y;
end;
procedure TPowercad.MSDragOver(Sender: TObject;Source:Integer; X, Y: Double;State: TDragState; var Accept: Boolean);
var BBox: TPaintBox;
sDist: Double;
begin
if not fMCommand then exit;
if Source = oleDs_BlockBox then
begin
Accept := True;
end;
end;
procedure TPowercad.MSEndDrag(Sender, Target: TObject; X, Y:Double);
begin
CancelActions;
end;
procedure TPowercad.MSStartDrag(Sender: TObject; var DragObject: TDragObject);
begin
end;
(*
Procedure TPowerCad.StartModification;
var
err: boolean;
Begin
try
If ModPoint = nil then
exit;
SnapLocked := false;
KillTraceFigure;
ModPoint.Figure.TracePoint := ModPoint;
TraceFigure := ModPoint.Figure.CreateModification;
if assigned(TraceFigure) then
begin
SnapInfo := TraceFigure.Cname;
TraceFigure.vertZero := ord(VerticalZero);
TraceFigure.horzZero := ord(HorizontalZero);
end;
except
err := true;
// ShowMessage('TPowerCad.StartModification');
end;
End;
*)
Procedure TPowerCad.StartModification;
Begin
If ModPoint = nil then
exit;
try
if ModPoint.ClassName <> 'TModPoint' then
ModPoint := nil
else
begin
if (ModPoint.Tag <> 0) or (ModPoint.Obj1 <> 0) or (ModPoint.Obj2 <> 0) or (ModPoint.Obj3 <> 0) or (ModPoint.Obj4 <> 0) then
ModPoint := nil
end;
except
ModPoint := nil;
end;
try
If ModPoint <> nil then
begin
SnapLocked := false;
KillTraceFigure;
if assigned(ModPoint.Figure) and (not ModPoint.Figure.Deleted) then
begin
ModPoint.Figure.TracePoint := ModPoint;
TraceFigure := ModPoint.Figure.CreateModification;
if assigned(TraceFigure) then
begin
SnapInfo := TraceFigure.Cname;
TraceFigure.vertZero := ord(VerticalZero);
TraceFigure.horzZero := ord(HorizontalZero);
end;
end;
end;
except
// ShowMessage('TPowerCad.StartModification');
end;
End;
Procedure TPowerCad.TraceModification(x,y: Double);
var
index,idx: Integer;
a1,a2,a3,x1,y1,dx,dy,len: Double;
p1,p2,p3: TDoublePoint;
Begin
If ModPoint = nil then
exit;
try
if (ModPoints.IndexOf(ModPoint) = -1) then
begin
ModPoint := nil;
exit;
end;
if ModPoint.PType in [ptRotPoint,ptRotCenter] then
(ModPoint.Figure).TraceRotate(Self,ModPoint,TraceFigure,x,y,CurrentShift)
else
begin
(ModPoint.Figure).TraceModification(Self,ModPoint,TraceFigure,x,y,CurrentShift);
if (TraceFigure is TCircle) or (TraceFigure is TLine) or (TraceFigure is TPolyline) then
begin
Index := ModPoint.SeqNbr;
Idx := 0;
if Index-1 > 0 then
idx := Index-1
else
if Index < TraceFigure.PointCount then
idx := Index+1;
if idx > 0 then
begin
x1 := TraceFigure.ActualPoints[Idx].x;
y1 := TraceFigure.ActualPoints[Idx].y;
dx := abs(x-x1);
dy := abs(y-y1);
len := sqrt(dx*dx+dy*dy);
info2 := ' L: ('+ floattostrf(len,ffFixed,16,2)+ ') '+ floattostrf(len*MapScale,ffFixed,16,2);
evInfo2.raiseEvent(info2);
len := GetRadOfLine(TraceFigure.ActualPoints[Idx],DoublePoint(x,y));
if (len > 0) and (verticalzero = vzTop) then
len := 2*pi-len;
info3 := ' <: '+Inttostr(Round((len/pi)*180))+'<27>';
evInfo3.raiseEvent(info3);
if (Tracefigure is TPolyline) then
begin
idx := 0;
if (Index = 1) and (TraceFigure.PointCount > 2 ) then
begin
p1 := TraceFigure.ActualPoints[Index];
p2 := TraceFigure.ActualPoints[Index+1];
p3 := TraceFigure.ActualPoints[Index+2];
idx := 1;
end
else
if (Index > 1) and (Index < TraceFigure.PointCount) then
begin
p1 := TraceFigure.ActualPoints[Index-1];
p2 := TraceFigure.ActualPoints[Index];
p3 := TraceFigure.ActualPoints[Index+1];
idx := 1;
end
else
if (Index = TraceFigure.PointCount) and (TraceFigure.PointCount > 2) then
begin
p1 := TraceFigure.ActualPoints[Index-2];
p2 := TraceFigure.ActualPoints[Index-1];
p3 := TraceFigure.ActualPoints[Index];
idx := 1;
end;
if idx = 1 then
begin
a1 := GetRadOfLine(p2,p1);
a2 := GetRadOfLine(p2,p3);
a3 := abs(a2-a1);
info3 := ' <<: '+Inttostr(Round((a3/pi)*180))+'<27>';
evInfo3.raiseEvent(info3);
end;
end;
end;
end;
end;
RaiseOnStatus;
except
// ShowMessage('TPowerCad.TraceModification');
end
End;
Procedure TPowerCad.EndModification(x,y:Double);
var
CountMP: Integer;
SelFigure: TFigure;
LastModPoint: TModPoint;
Begin
If ModPoint = nil then
begin
exit;
end;
try
if (ModPoints.IndexOf(ModPoint) = -1) then
begin
ModPoint := nil;
CountMP := ModPoints.Count;
LastModPoint := TModPoint(ModPoints[CountMP - 1]);
if LastModPoint <> nil then
begin
if Self.SelectedCount = 1 then
begin
SelFigure := TFigure(Self.Selection[0]);
if SelFigure <> nil then
if SelFigure = LastModPoint.Figure then
ModPoint := LastModPoint;
end;
end;
if ModPoint = nil then
exit;
end;
// Tolik -- 30/11/2015 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> REFRESH
TF_CAD(TPowerCad(Self).Owner).InGUIEvent := True;
FSCS_Main.TimerRefresh.Enabled := False;
//
if assigned(OnBeforeModify) then
OnBeforeModify(Self,ModPoint.Figure);
RecordModifyUndo(ModPoint.Figure);
if ModPoint.PType in [ptRotPoint, ptRotCenter] then
(ModPoint.Figure).EndRotate(Self,ModPoint,TraceFigure,x,y,CurrentShift)
else
begin
ModPoint.Figure.EndModification(Self,ModPoint,TraceFigure,x,y,CurrentShift);
if ModPoint <> nil then
begin
try
// Tolik --30/11/2015 --
if Assigned(ModPoint) then
//
ModPoint.Figure.RefreshHatch;
except
// ShowMessage('TPowerCad.EndModification');
end;
end;
end;
try
// Tolik --30/11/20115 --
if Assigned(ModPoint) then
//
ModPoint.Figure.OnFigureModified;
except
// ShowMessage('TPowerCad.EndModification');
end;
//if assigned(OnFigureModify) then OnFigureModify(Self,ModPoint.Figure);
CurrentShift := [];
DragState := dsNone;
KillTraceFigure;
Updated := True;
// Tolik -- 30/11/2015 -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> REFRESH
TF_CAD(Self.Owner).InGuiEvent := False;
FSCS_Main.TimerRefresh.Enabled := True;
//
except
// ShowMessage('TPowerCad.EndModification');
end;
End;
procedure TPowercad.MSClick(Sender: TObject);
begin
end;
procedure TPowercad.MSDblClick(Sender: TObject);
var
a: integer;
Sel: TList;
EnterStr : String;
Figure: TFigure;
begin
if (not fMCommand) or (modLock) then exit;
Sel := Selection;
DblClicked := true;
If sel = nil then exit;
Figure := nil;
For a := 0 to Sel.Count -1 do
begin
if detailactive then begin
if TFigure(sel[a]).ispointinint(DetailHitPoint.x,DetailHitPoint.y) then
figure := TFigure(sel[a]);
end
else
begin
if TFigure(sel[a]).ispointin(LastX,LastY) then figure := TFigure(sel[a]);
end;
if assigned(figure) then break;
end;
if assigned(figure) then begin
if detailactive then begin
Figure.EditX := DetailHitPoint.x;
Figure.EditY := DetailHitPoint.y;
end else begin
Figure.EditX := LastX;
Figure.EditY := LastY;
end;
if assigned(OnBeforeModify) then OnBeforeModify(Self,Tfigure(Sel[a]));
if assigned(FOnFigureEdit) then begin
FOnFigureEdit(Self,Figure);
end else begin
if Figure.Edit then Refresh;
end;
end;
end;
Procedure TPowercad.MSLeave(Sender: TObject);
begin
end;
Procedure TPowercad.RegisterSystemEvents;
var i: Integer;
Engine: TEventEngine;
EventId: Integer;
begin
For i := 0 to FeventEngines.Count - 1 do
begin
Engine := TEventEngine(FeventEngines[i]);
EventId := Engine.EventId;
RegisterEvent(EventId,Self,SystemEventCallback);
end;
end;
Procedure TPowercad.UnRegisterSystemEvents;
var i: Integer;
Engine: TEventEngine;
EventId: Integer;
begin
For i := 0 to FeventEngines.Count - 1 do
begin
Engine := TEventEngine(FeventEngines[i]);
EventId := Engine.EventId;
UnRegisterEvent(EventId,Self);
end;
end;
Procedure TPowercad.RaiseSystemEvent(EventId: Integer; Numval:Integer;StrVal: String;
DblVal:Double;Enabled:Boolean);
begin
if assigned(FGUIEvent) then FGUIEvent(Self,EventId,Numval,StrVal,DblVal,Enabled);
end;
Procedure TPowercad.SetGUIEvent(Value:TGUIEVENT);
var i: Integer;
Engine: TEventEngine;
EventId: Integer;
begin
FGUIEvent := Value;
if assigned(FGUIEvent) then begin
For i := 0 to FeventEngines.Count - 1 do
begin
Engine := TEventEngine(FEventEngines[i]);
EventId := Engine.EventId;
FGUIEvent(Self,EventId,Engine.Numval,Engine.StrVal,Engine.DblVal,Engine.Enabled);
end;
end;
end;
Procedure TPowercad.SyncEnv;
begin
Inherited SyncEnv;
end;
Procedure TPowercad.KillTraceFigure;
begin
// DrawShadowCrossPoints; // Tolik 17/01/2022 --
if assigned(TraceFigure) then
TraceFigure.Free;
TraceFigure := nil;
end;
Procedure TPowercad.CMFontChange(Var Mes: TMessage);
Begin
SyncEnv;
end;
procedure TPowerCad.MenuClicked(Sender: tobject);
var idx: integer;
mnItem : TMenuItem;
f:Tfigure;
begin
mnItem := TMenuItem(Sender);
idx := mnItem.Tag;
if idx >= 500 then
begin
if assigned(FpopClick) then FPopClick(Self,mnItem.Tag-500);
end else
begin
case idx of
1: ;//ShowCustomizeDlg;
3: OrderSelection(osFront);
4: OrderSelection(osBack);
5: OrderSelection(osFward);
6: OrderSelection(osBward);
7: GroupSelection;
8: if Selection.Count > 0 then begin
f := TFigure(Selection[Selection.Count-1]);
f.RotateSelect;
end;
9: begin
LockSelectionToMove(True);
LockSelectionToModify(True);
end;
10: begin
LockSelectionToMove(False);
LockSelectionToModify(False);
end;
11: WeldIntoPolyline;
12: DoZoomIn;
13: DoZoomOut;
14: ActualSize;
15: FitToWindow;
16: ZoomScale := 50;
17: ZoomScale := 200;
18: CreateDimLinesOfSelection;
19: ClearDimLinesOfSelection;
110..120: begin
if assigned(FFigurePopClick) then FFigurePopClick(Self,TFigure(Selection[0]),mnItem.tag - 110);
end;
else begin
if idx < FStandartMnIndex then
begin
if Selection.Count > 0 then begin
RecordModifyUndo(TFigure(Selection[0]));
TFigure(Selection[0]).MenuClicked(idx);
end;
end else begin
if assigned(FpopClick) then FPopClick(Self,mnItem.tag - 500);
end;
end;
end;
end;
refresh;
end;
Function TPowerCad.DocIdx:Integer;
begin
DIdx := dIdx+1;
result := dIdx;
end;
Procedure TPowerCad.SetFileChange(Value:TNotifyEvent);
begin
FFileChange := Value;
if assigned(FFileChange) then FFileChange(self);
end;
Procedure TPowerCad.Refresh;
var i, ResCount: Integer;
ShiftState: TShiftState;
SCSFiguresSelected_Count: Integer;
FirstNode: Boolean;
// Tolik 22/03/2017 --
TreeCatalogChange_Event: TTVChangedEvent;
LastSelectedFigure: TFigure;
SelList: TList;
// Tolik - -13/05/2017 --
CurrKeyboardState: TShiftState;
KeyState: TKeyboardState;
wasRefr: boolean;
//
procedure ShowGdiMessage(aMess: integer);
var PausedProgress: Boolean;
begin
PausedProgress := False;
try
if GIsProgress or (GIsProgressCount > 0) then
begin
PauseProgress(True);
PausedProgress := True;
end;
case aMess of
1: ShowMessage(GetGdiMess('GdiMess_1'));
2: ShowMessage(GetGdiMess('GdiMess_2'));
end;
GWin10GDIMessage := True;
except
on E: Exception do AddExceptionToLog('TPowerCad.Refresh.ShowGdiMessage' + E.Message);
end;
if PausedProgress then
PauseProgress(False);
end;
begin
GisCadRefresh := true;
try
//Tolik 30/01/2017 - - FCadClose -- <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>/<2F><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
//if TF_CAD(Owner).FCadClose then
if (Owner <> nil) and ((TF_CAD(Owner).ClassName <> 'TF_MasterCompl') and TF_CAD(Owner).FCadClose) then
Exit;
// Tolik -- 29/10/2016
//if GCanRefreshCad then
if GCanRefreshCad or ((Owner <> nil) and (TF_CAD(Owner).ClassName = 'TF_MasterCompl')) then
begin
// Tolik -- 12/01/2017 --
// <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><> GDI <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>
// <20><><EFBFBD><EFBFBD> Win 10 <20><>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> GDI
{ if isWin10 and (not GWin10GDIMessage) then
begin
ResCount := GetGuiResources(GetCurrentProcess,0);
if ResCount > 10000 then
ShowGdiMessage(1)
else
if ResCount > 9000 then
ShowGdiMessage(2);
end;
}
//Tolik 15/03/2017 --
{if (Owner <> nil) then
begin
TF_CAD(Owner).mProtocol.Lines.BeginUpdate;
TF_CAD(Owner).mProtocol.Lines.EndUpdate;
end;}
GetKeyboardState(KeyState);
CurrKeyBoardState := KeyboardStateToShiftState(KeyState);
if GetMemInUsePercentage >= 95 then
begin
Showmessage(MemUsage_Msg1);
AddExceptionToLog('Warning! Out of memory ');
end;
wasRefr := false;
// Tolik -- 30/05/2017 --
if (GEndPoint <> nil) then
if (GEndPoint.Owner = Self) then
if GEndPoint.ClassName = 'TConnectorObject' then
if (Figures.Count > 0) then
if TFigure(Figures[Figures.Count - 1]) <> GEndPoint then
begin
OrderFigureToFront(TConnectorObject(GEndPoint));
wasrefr := true;
end;
if Not wasRefr then
inherited;
if NeedRefresh then
begin
NeedRefresh := False;
inherited;
end;
if assigned(TraceFigure) then
begin
//KillTraceFigure;
//EndTrace([]);
end;
if assigned(FOnRefresh) then
FOnRefresh(Self);
end;
// Tolik -- 16/05/2017 - -<2D><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><>
// <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> - <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD> <20> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
(*if TF_CAD(Owner) = GCadForm then
begin
ShiftState := [];
SCSFiguresSelected_Count := 0;
for i := 0 to GCadForm.FSCSFigures.Count - 1 do
begin
if TFigure(GCadForm.FSCSFigures[i]).Selected then
begin
inc(SCSFiguresSelected_Count);
LastSelectedFigure := TFigure(GCadForm.FSCSFigures[i]);
end;
end;
try
F_ProjMan.LockTreeAndGrid(True);
TreeCatalogChange_Event := F_ProjMan.Tree_Catalog.OnChange;
F_ProjMan.Tree_Catalog.OnChange := nil;
if SCSFiguresSelected_Count > 0 then
begin
if ((SCSFiguresSelected_Count > 1) and (not ((ssShift in CurrKeyBoardState) or (ssCTRL in CurrKeyBoardState)))) then
CurrKeyBoardState := [ssShift];
firstNode := True;
SelList := TList.Create;
for i := 0 to GCadForm.FSCSFigures.Count - 1 do
begin
if TFigure(GCadForm.FSCSFigures[i]).Selected then
begin
{ if TFigure(GCadForm.FSCSFigures[i]).Id = LastSelectedFigure.ID then
F_ProjMan.Tree_Catalog.OnChange := TreeCatalogChange_Event;}
//SelectFigureInTree(TFigure(GCadForm.FSCSFigures[i]), ShiftState, firstNode);
if ((TFigure(GCadForm.FSCSFigures[i]) is TOrthoLine) or
(TFigure(GCadForm.FSCSFigures[i]) is TConnectorObject)) then
if SelList.IndexOf(TFigure(GCadForm.FSCSFigures[i])) = -1 then
SelList.Add(TFigure(GCadForm.FSCSFigures[i]));
end;
end;
if SelList.Count > 0 then
Select_Figures_In_Tree(SelList, CurrKeyBoardState);
SelList.Free;
end
else
F_ProjMan.Tree_Catalog.ClearSelection;
F_ProjMan.Tree_Catalog.OnChange := TreeCatalogChange_Event;
F_ProjMan.LockTreeAndGrid(False);
except
on E: Exception do
begin
F_ProjMan.LockTreeAndGrid(False);
AddExceptionToLog('TPowerCad.Refresh on TreeNodes Selection' + E.Message);
F_ProjMan.Tree_Catalog.OnChange := TreeCatalogChange_Event;
end;
end;
end;
*)
except
// on E: Exception do AddExceptionToLog(CPowerCadMessage + 'TPowerCad.Refresh' + E.Message);
end;
GisCadRefresh := False;
end;
// Tolik -- 18/11/2015 -- <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> KillTraceFigure
procedure TPowerCad.KillTraceFig(aRefresh: Boolean = True);
begin
KillTraceFigure;
if aRefresh then
Refresh;
end;
//
Function TPowerCad.IsUnNamed:Boolean;
begin
result := (Copy(ActiveFile,1,Length(asDrawing)) = asDrawing) or (ActiveFile = '');
end;
Function TPowerCad.cNewDrawing:Boolean;
var ResWord: Word;
FSaveDialog: TPCSaveDialog;
begin
result := true;
if Updated then begin
ResWord := messagedlg
(Format(cmSaveChanges,[ExtractFileName(ActiveFile)]),mtConfirmation,mbYesNoCancel,0);
If ResWord = mrYes then
begin
if IsUnNamed then
begin
fSaveDialog := TPCSaveDialog.Create(self);
fSaveDialog.FileName := ActiveFile;
fSaveDialog.Title := fSaveDialogTitle;
fSaveDialog.Filter := fSaveDialogFilter;
if fSaveDialog.Execute then
begin
ActiveFile := fSaveDialog.filename;
if ExtractFileExt(activeFile) = '' then
ActiveFile := ActiveFile+'.'+FExtension;
SaveToFile(0,ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end
else begin
result := false;
fSaveDialog.Free;
exit;
end;
fSaveDialog.Free;
end
else
SaveToFile(0,ActiveFile);
end;
If ResWord = MrCancel then begin
result := false;
Exit;
end;
end;
Clear(0);
DeleteAllUserLayers;
if assigned(CustomStream) then CustomStream.free;
CustomStream := nil;
ActiveFile := asDrawing+inttostr(DocIdx);
if assigned(FFileChange) then FFileChange(self);
Updated := False;
end;
procedure TPowerCad.cOpenDrawing;
var isText: Boolean;
FOpenDialog: TPCOpenDialog;
FSaveDialog: TPCSaveDialog;
ResWord: Word;
begin
if Updated then begin
ResWord := messagedlg
(Format(cmSaveChanges,[ExtractFileName(ActiveFile)]),mtConfirmation,mbYesNoCancel,0);
If ResWord = mrYes then
begin
if IsUnNamed then
begin
fSaveDialog := TPCSaveDialog.Create(self);
fSaveDialog.FileName := ActiveFile;
fSaveDialog.Title := fSaveDialogTitle;
fSaveDialog.Filter := fSaveDialogFilter;
if fSaveDialog.Execute then
begin
ActiveFile := fSaveDialog.filename;
if ExtractFileExt(activeFile) = '' then
ActiveFile := ActiveFile+'.'+FExtension;
SaveToFile(0,ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end
else
begin
fSaveDialog.free;
exit;
end;
fSaveDialog.free;
end
else
SaveToFile(0,ActiveFile);
end;
If ResWord = MrCancel then Exit;
end;
FOpenDialog := TPCOpenDialog.Create(self);
FOpenDialog.Title := FOpenDialogTitle;
FOpenDialog.Filter := FOpenDialogFilter;
if FOpenDialog.execute then
begin
ActiveFile := FOpenDialog.filename;
LoadFromFile(ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end;
Updated := False;
end;
procedure TPowerCad.cSaveDrawing;
var xFile: String;
resWord: Word;
FSaveDialog: TPCSaveDialog;
begin
if IsUnNamed then
begin
fSaveDialog := TPCSaveDialog.Create(self);
fSaveDialog.FileName := ActiveFile;
fSaveDialog.Title := fSaveDialogTitle;
fSaveDialog.Filter := fSaveDialogFilter;
if fSaveDialog.Execute then
begin
xFile := fSaveDialog.filename;
if ExtractFileExt(xFile) = '' then
xFile := xFile+'.'+FExtension;
resWord := mrYes;
if fileexists(xFile) then begin
ResWord := messagedlg
(Format(cmAlreadyExists,[ExtractFileName(xFile)]),mtConfirmation,[mbYes, mbNo],0);
end;
if ResWord = mrYes then begin
ActiveFile := xFile;
SaveToFile(0,ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end;
end;
fSaveDialog.Free;
end
else
SaveToFile(0,ActiveFile);
Updated := False;
end;
procedure TPowerCad.cSaveAsDrawing;
var xFile: String;
resWord: Word;
fSaveDialog: TPCSaveDialog;
begin
fSaveDialog := TPCSaveDialog.Create(self);
fSaveDialog.FileName := ActiveFile;
fSaveDialog.Title := fSaveDialogTitle;
fSaveDialog.Filter := fSaveDialogFilter;
fSaveDialog.FileName := ActiveFile;
if fSaveDialog.Execute then
begin
xFile := fSaveDialog.filename;
if ExtractFileExt(xFile) = '' then
xFile := xFile+'.'+FExtension;
resWord := mrYes;
if fileexists(xFile) then begin
ResWord := messagedlg
(Format(cmAlreadyExists,[ExtractFileName(xFile)]),mtConfirmation,[mbYes, mbNo],0);
end;
if ResWord = mrYes then begin
ActiveFile := xFile;
SaveToFile(0,ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end;
end;
Updated := False;
fSaveDialog.Free;
end;
procedure TPowerCad.cPrintDrawing;
begin
if fPrintDialog.execute then
begin
PrintDrawing(ActiveFile);
end;
end;
procedure TPowerCad.cExportAs;
var exportname : string;
ext: string;
fSaveDialog : TSaveDialog;
begin
fSaveDialog := TSaveDialog.Create(self);
fSaveDialog.Filter := stExportFilter;
if fSavedialog.Execute then
begin
exportname := fSavedialog.filename;
ext := LowerCase(ExtractFileExt(fSavedialog.filename));
if fSavedialog.FilterIndex = 1 then
begin
if lowercase(ext) <> '.wmf' then exportname := exportname + '.wmf';
ExportAsWmf(exportname);
end
else if fSavedialog.FilterIndex = 2 then
begin
if lowercase(ext) <> '.bmp' then exportname := exportname + '.bmp';
SaveAsBitmap(exportname);
end
else if fSavedialog.FilterIndex = 3 then
begin
if lowercase(ext) <> '.dxf' then exportname := exportname + '.dxf';
ExportAsDxf(exportname);
end;
end;
fSaveDialog.free;
end;
procedure TPowerCad.cImportDxf;
var OpenDialog: TOpenDialog;
begin
OpenDialog := TOpenDialog.Create(Self);
OpenDialog.Filter := stImportDXFFilter;
if OpenDialog.Execute then
begin
if OpenDialog.FilterIndex = 1 then
begin
ImportDrawing(Activelayer,0,0,OpenDialog.filename,false);
end
else if OpenDialog.FilterIndex = 2 then
begin
ImportDXF(OpenDialog.filename,false,false);
end;
end;
OpenDialog.Free;
end;
Procedure TPowerCad.PrintMessage(Mes:String);
begin
info3 := mes;
if assigned(evInfo3) then evInfo3.RaiseEvent(Mes);
RaiseOnStatus;
end;
Procedure TPowerCad.ExecuteVerbalCommand(Command:String);
var
pCount: integer;
Parsed: TStringArray;
k,i : integer;
root: string;
p: array of Double;
p1,p2,p3,p4,p5: Double;
points: TDoublePointArr;
pointcount : integer;
r: TDoubleRect;
myX,myY: Double;
dSign: integer;
oldCx,oldCy: Double;
a1,a2: Double;
closed: Boolean;
Function NA(v:Double):Double; //NormalizePoint
begin
if (AngularMode = 1) then
result := v * (PI/180)
else result :=v;
end;
Function NP(v:Double):Double; // Normalize Angle
var factor: Integer;
begin
if MetricMode = 0 then factor := 1 else factor := 10;
if realscale then v := v/MapScale;
result := v*factor;
end;
begin
pCount := ParseCommand(Command,parsed);
dSign := 0;
if pCount = -1 then exit;
root := parsed[0];
oldcX := CurrentX;
oldcY := CurrentY;
SetLength(P,pcount+1);
for k := 1 to pcount do
begin
if parsed[k][1] = '>' then begin dSign := 1; parsed[k] := copy(parsed[k],2,length(parsed[k])-1);end
else if parsed[k][1] = '<' then begin dSign := -1; parsed[k] := copy(parsed[k],2,length(parsed[k])-1);end;
try
p[k] := StrToFloat_My(parsed[k]);
except
parsed[k] := StringReplace(parsed[k],'.',',',[]);
try p[k] := StrToFloat_My(parsed[k]); except end;
end;
if dSign = -1 then begin
if odd(k) then
begin
CurrentX := CurrentX - p[k];
p[k] := CurrentX;
end
else begin
CurrentY := CurrentY - p[k];
p[k] := CurrentY;
end;
end
else if dSign = 1 then begin
if odd(k) then
begin
CurrentX := CurrentX + p[k];
p[k] := CurrentX;
end
else begin
CurrentY := CurrentY + p[k];
p[k] := CurrentY;
end;
end
else begin
if odd(k) then CurrentX := p[k] else CurrentY := p[k];
end;
end;
if uppercase(root) = cmdLine then begin
// LINE IMPLEMETING
if pCount = 4 then begin
p1 := NP(p[1]);
p2 := NP(p[2]);
p3 := NP(p[3]);
p4 := NP(p[4]);
CurrentX := p[3];
CurrentY := p[4];
end
else if pCount = 2 then begin
p1 := NP(oldCX);
p2 := NP(oldCY);
p3 := NP(p[1]);
p4 := NP(p[2]);
CurrentX := p[1];
CurrentY := p[2];
end;
if (pCount = 2) or (pCount = 4) then begin
Line(activelayer,p1,p2,p3,p4,
DefaultPenWidth,
Ord(DefaultPenStyle),
DefaultPenColor,
Ord(DefaultRowStyle),True);
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdRectangle) or (uppercase(root) = cmdRectangleAbv) then begin
// RECTANGLE IMPLEMENTING
if pCount = 4 then begin
p1 := NP(p[1]);
p2 := NP(p[2]);
p3 := NP(p[3]);
p4 := NP(p[4]);
Rectangle(activelayer,p1,p2,p3,p4,
DefaultPenWidth,
Ord(DefaultPenStyle),
DefaultPenColor,
ord(defaultBrushStyle),
defaultBrushColor,True);
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdPolyline) or
(uppercase(root) = cmdPolygon) then begin
// POLYLINE IMPLEMENTING
if (pCount >= 2) or not(odd(pcount)) then begin
pointCount := 0;
SetLength(points,pCount div 2);
for i := 1 to pcount do
begin
if not odd(i) then begin
inc(pointCount);
points[pointcount-1] := DoublePoint(NP(p[i-1]),NP(p[i]));
end;
end;
closed := (uppercase(root) = cmdPolygon);
PolyLine(activelayer,points,
DefaultPenWidth,
Ord(DefaultPenStyle),
DefaultPenColor,
Ord(DefaultRowStyle),
ord(defaultBrushStyle),
defaultBrushColor,closed,true);
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdCircle) or (uppercase(root) = cmdCircleAbv) then begin
// CIRCLE IMPLEMENTING
if pCount = 3 then begin
Circle(activeLayer,NP(p[1]),NP(p[2]),NP(p[3]),
DefaultPenWidth,
Ord(DefaultPenStyle),
DefaultPenColor,
ord(defaultBrushStyle),
defaultBrushColor,True);
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdEllipse) or (uppercase(root) = cmdEllipseAbv ) then begin
// ELLIPSE IMPLEMENTING
if pCount = 4 then begin
Ellipse(activeLayer,NP(p[1]),NP(p[2]),NP(p[3]),NP(p[4]),0,
DefaultPenWidth,
Ord(DefaultPenStyle),
DefaultPenColor,
ord(defaultBrushStyle),
defaultBrushColor,True);
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdArc) then begin
// ARC IMPLEMENTING
try
a1 := StrToFloat_My(parsed[4]);
except
parsed[4] := StringReplace(parsed[4],'.',',',[]);
try
a1 := StrToFloat_My(parsed[4]);
except
ShowMessage(emWrongParameter);
end;
end;
a2 := 0;
if pcount =5 then
begin
try
a2 := StrToFloat_My(parsed[5]);
except
parsed[5] := StringReplace(parsed[5],'.',',',[]);
try
a2 := StrToFloat_My(parsed[5]);
except
ShowMessage(emWrongParameter);
end;
end;
end;
if pCount = 4 then begin
a1 := NA(a1);
a2 := a1; a1 := 0;
end else if pCount = 5 then begin
a1 := NA(a1);
a2 := NA(a2);
end;
if (pCount = 4) or (pCount = 5 ) then begin
Arc(ActiveLayer,NP(p[1]),NP(p[2]),NP(p[3]),a1,a2,
DefaultPenWidth,
Ord(DefaultPenStyle),
DefaultPenColor,
ord(defaultBrushStyle),
defaultBrushColor,0,true);
end else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdRotate) or (uppercase(root) = cmdRotateAbv) then begin
//ROTATE IMPLEMENTING
if (pCount = 1) then begin
try
p[1] := round(StrToFloat_My(parsed[1]));
except
parsed[1] := StringReplace(parsed[1],'.',',',[]);
try
p[1] := round(StrToFloat_My(parsed[1]));
except
ShowMessage(emWrongParameter);
end;
end;
r := GetSelectionRect;
myX := (r.left + r.right)/2;
myY := (r.top + r.bottom)/2;
p1 := NA(p[1]);
RotateSelection(p1,DoublePoint(myX,myY));
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdMove) then begin
//MOVE IMPLEMENTING
if (pCount = 2) then begin
MoveSelection(NP(p[1]),NP(p[2]));
end
else
ShowMessage(emWrongPCount);
end else if (uppercase(root) = cmdSelectAll) or (uppercase(root) = cmdSelectAllAbv) then begin
//SelectAll IMPLEMENTING
if (pCount = 0) then begin
SelectAll(ActiveLayer);
end
else
ShowMessage(emWrongPCount);
end else if ((uppercase(root) = cmdSetMM) or (uppercase(root) = cmdSetMMAbv)) then begin
MetricMode := 0;
end else if ((uppercase(root) = cmdSetCM) or (uppercase(root) = cmdSetCMAbv)) then begin
MetricMode := 1;
end else if ((uppercase(root) = cmdSetDEG) or (uppercase(root) = cmdSetDegAbv)) then begin
AngularMode := 1;
end else if ((uppercase(root) = cmdSetRAD) or (uppercase(root) = cmdSetRadAbv)) then begin
AngularMode := 0;
end else if ((uppercase(root) = cmdPageScale) or (uppercase(root) = cmdPageScaleAbv)) then begin
RealScale := false;
end else if (uppercase(root) = cmdRealScale) or (uppercase(root) = cmdRealScaleAbv) then begin
if pCount = 0 then
RealScale := true
else if pCount = 1 then
begin
RealScale := true;
MapScale := StrToFloat_My(parsed[1]);
end
else
ShowMessage(emWrongPCount);
end else begin
ShowMessage(emUnKnownCommand);
end; ;
refresh;
end; // procedure
Procedure TPowerCad.ExecuteCustomCommand(commandName: String);
begin
if assigned(FCustomCommand) then FCustomCommand(Self,CommandName);
end;
procedure TPowerCad.ExecuteTBCommand(commandID: integer);
var blname: string;
cid:integer;
plIdx,vIdx: Integer;
ValD: Double;
Val: Integer;
ValDbl: Double;
begin
case CommandID of
cNew :cNewDrawing;
cOpen :cOpenDrawing;
cSave :cSaveDrawing;
cSaveAs :cSaveAsDrawing;
cPrint :cPrintDrawing;
cPrintPreview :PrintPreview;
cPrinterSetup :fPrinterSetup.Execute;
cExportDrawing :CExportAs;
cImportDrawing :cImportDxf;
cSelectTool :SetTool(toSelect,'',0);
cLine :SetTool(toFigure,'TLine',0);
cRectangle :SetTool(toFigure,'TRectangle',0);
cCircle :SetTool(toFigure,'TCircle',0);
cEllipse :SetTool(toFigure,'TEllipse',0);
cArc :SetTool(toFigure,'TArc',0);
cElpArc :SetTool(toFigure,'TElpArc',0);
cPolyline :SetTool(toFigure,'TPolyline',0);
cFreeHand :SetTool(toFigure,'TFreehand',0);
cPoint :SetTool(toFigure,'TVertex',0);
cText :SetTool(toFigure,'TText',0);
cRichText :SetTool(toFigure,'TRichText',0);
cOleObject :SetTool(toFigure,'TOleObject',0);
cMathGraph :SetTool(toFigure,'TMathGraph',0);
cHorzDim :SetTool(toFigure,'THDimLine',0);
cVertDim :SetTool(toFigure,'TVDimLine',0);
cAlignedDim :SetTool(toFigure,'TADimLine',0);
cRadiusDim :SetTool(toFigure,'TCDimLine',0);
cAngleDim :SetTool(toFigure,'TArcDimLine',0);
cUndo :Undo;
cRedo :Redo;
cCut :CutToClipBoard;
cCopy :CopyToClipBoard;
cPaste :PasteFromClipboard(ActiveLayer);
cDelete :RemoveSelection;
cClear :Clear(0,True);
cMove :SetTool(toOperation,'TMove',0);
cDuplicate :SetTool(toOperation,'TDuplicate',0);
cDuplicateAsBezier :SetTool(toOperation,'TDuplicateAsBezier',0);
cKnife : SetTool(toOperation,'TKnife');
cOffset : begin
valD := 3;
if InputDouble(csOffset,csEnterMm,ValD) then
OffsetSelection(Vald);
end;
cRotate :SetTool(toOperation,'TRotate',0);
cMirror :SetTool(toOperation,'TMirror',0);
cArrayPolar :SetTool(toOperation,'TArrayPol',0);
cArrayRectangular :SetTool(toOperation,'TArrayRect',0);
cZoomArea :SetTool(toZoom,'',0);
cGroup :GroupSelection;
cUnGroup :UngroupSelection;
cBringToFront :OrderSelection(osFront);
cSendToBack :OrderSelection(osBack);
cBringForward :OrderSelection(osFWard);
cSendBackward :OrderSelection(osBWard);
cInvertArc :InvertArcsOfSelection;
cArcStyle :SetArcStyle(TarcStyle(CurrentStyle));
cArcStyleOpen :ArrangeArcStyleOfSelection(asOpen);
cArcStylePie :ArrangeArcStyleOfSelection(asPie);
cArcStyleChord :ArrangeArcStyleOfSelection(asChord);
cFlipImageHorizontal :FlipImagesOfSelection(fmHorz);
cFlipImageVertical :FlipImagesOfSelection(fmVert);
cTransparentImage :setTransparentOfSelection(CurrentFlag);
cClipImage :if CurrentFlag then
ClipSelBitmapToSelFigure
else UnClipSelBitmap;
cBoundLine :if CurrentFlag then
BoundSelectedLine
else UnBoundLine;
cWeldIntoPolyLine :WeldIntoPolyline;
cConvertBeziertoPolyLine :ConvertPLToPolyline;
cConvertPolyLinetoBezier :ConvertPLToBezier;
cPolyLineClosed :SetPLineClosed(CurrentFlag);
cInsertPicture :SetTool(toFigure,'TBmpObject',0);
cInsertBlock :SetTool(toInsertBlock,'TBmpObject',0);
cInsertCurrentBlock :SetTool(toInsertCurrentBlock,CurrentFileName,0);
cMakeBlock :
begin
RegRead('BlockDir',BlockDirectory);
if InputQuery(csMakeBlock, csBlockName, blname) then
MakeSelectionBlock(BlockDirectory+blname+'.pwb');
end;
cAlignTops :AlignSelection(haTop,vaNoChange);
cAlignBottoms :AlignSelection(haBottom,vaNoChange);
cAlignYCenters :AlignSelection(haCenter,vaNoChange);
cAlignLefts :AlignSelection(haNoChange,vaLeft);
cAlignRights :AlignSelection(haNoChange,vaRight);
cAlignXCenters :AlignSelection(haNoChange,vaCenter);
cDistrubuteHorizontal :AlignSelection(haDistHorz,vaNoChange);
cDistrubuteVertical :AlignSelection(haNoChange,vaDistVert);
cActualSize :ActualSize;
cFitToPage :FitToWindow;
cZoom50 :ZoomScale := 50;
cZoom75 :ZoomScale := 75;
cZoom25 :ZoomScale := 25;
cZoom150 :ZoomScale := 150;
cZoom200 :ZoomScale := 200;
cZoom125 :ZoomScale := 125;
cZoom175 :ZoomScale := 175;
cZoomIn :DoZoomIn;
cZoomOut :DoZoomOut;
cSelectAll :SelectAll(0);
cDeSelectAll :DeSelectAll(0);
cInvertSelection :InvertSelection;
cExit : ExitApplication;
//cCustomize : ShowCustomizeDlg;
cTextColor : ModifyTextandFont(mmFontColor,CurrentColor,'',[],True);
cPenColor : DefaultPenColor := CurrentColor;
cBrushColor : DefaultBrushColor := CurrentColor;
cPenStyle : DefaultPenStyle := TPenStyle(CurrentStyle);
cBrushStyle : DefaultBrushStyle := TBrushStyle(CurrentStyle);
cRowStyle : DefaultRowStyle := TRowStyle(CurrentStyle);
cPenWidth : DefaultPenWidth := CurrentStyle+1;
cFontName : ModifyTextAndFont(mmFontName,0,CurrentString,[],True);
cBold : ModifyTextandFont(mmFontBold,0,'',[],CurrentFlag);
cItalic : ModifyTextandFont(mmFontItalic,0,'',[],CurrentFlag);
cUnderline : ModifyTextandFont(mmFontUnderline,0,'',[],CurrentFlag);
cStrike : ModifyTextandFont(mmFontStrike,0,'',[],CurrentFlag);
cTextSize : DefaultTextHeight := CurrentValue;
cTextCharset : ModifyTextandFont(mmFontCs,csArray[CurrentStyle],'',[],True);
//cRunMacro : RunMacroByFileName(CurrentFileName);
cRulers : RulerVisible := not RulerVisible;
cGrids : Grids := not Grids;
cGridType : GridType := TGridType(CurrentStyle);
cGuides : GuidesVisible := not GuidesVisible;
cCenterGuides : CenterGuide := not CenterGuide;
cSnapGrid : SnapToGrids := not SnapToGrids;
cSnapGuides : SnapToGuides := not SnapToGuides;
cSnapObject : SnapToNearPoint := not SnapToNearPoint;
CGridColor : GridColor := CurrentColor;
CGuideColor : GuideColor := CurrentColor;
CBackColor : BackGround := CurrentColor;
CPageColor : PageColor := CurrentColor;
CAngularGuides : GuideTrace := TGuideTraces(CurrentStyle);
cRulerSystem : RulerSystem := TRulerSystem(CurrentStyle);
cRulerMode : RulerMode := TRulerMode(CurrentStyle);
cPageLo : PageLayout := TPageLayout(CurrentStyle);
cPageOr : PageOrient := TPageOrient(CurrentStyle);
cGridStep : begin
valD := GridStep;
if RulerSystem = rsWhitWorth then begin
if InputDouble(csSetGridStep,csEnterInch16,ValD) then
gridStep := ValD;
end else begin
if InputDouble(csSetGridStep,csEnterMm,ValD) then
gridStep := ValD;
end;
end;
cMapScale : begin
ValDbl := MapScale;
if InputDouble(csSetMapScale,csEnter1x,ValDbl) then
MapScale := ValDbl;
end;
cPageWidth : begin
valD := WorkWidth;
if RulerSystem = rsWhitWorth then begin
valD := vald/25.4;
if InputDouble(csPageWidth,csEnterInch,ValD) then
begin
WorkWidth := ValD*25.4;
end;
end else begin
if InputDouble(csPageWidth,csEnterMm,ValD) then
WorkWidth := ValD;
end;
end;
cPageHeight : begin
valD := WorkHeight;
if RulerSystem = rsWhitWorth then begin
valD := vald/25.4;
if InputDouble(csPageHeight,csEnterInch,ValD) then
begin
WorkHeight := ValD*25.4;
end;
end else begin
if InputDouble(csPageHeight,csEnterMm,ValD) then
WorkHeight := ValD;
end;
end;
cCommEdit : begin
ExecuteVerbalCommand(CurrentString);
end;
cConvertToBezier : begin
ConvertSelectionToBezier;
end;
cInterbreak : InterbreakSelection;
end;
end;
Procedure TPowerCad.DrawTrace;
begin
if not (DragState in [dsNone,dsMod,dsMove,dsHRuler,dsVRuler,dsLocate]) then exit;
SetForceDefaultEngine;
ClipToActiveRegion;
If (ModPoint <> nil) and (ModPoint.PType = ptRotCenter) then
begin
if assigned(TraceFigure) then
TraceFigure.DrawRotTrace(Dengine,false);
end
else
begin
if assigned(TraceFigure) then
begin
if (CheckFigureByClassName(TraceFigure, 'TOrthoLine'))then
begin
if not(TraceFigure.NotNeedToDraw) then
TraceFigure.draw(Dengine,false);
end
else
TraceFigure.draw(Dengine,false);
end;
end;
if assigned(TraceFigure) and assigned(FOnTraceDraw) then
FOnTraceDraw(Self,TraceFigure);
UnClip;
if DetailWindow then
begin
SetDetailEngine;
ClipToDetailRegion;
If (ModPoint <> nil) and (ModPoint.PType = ptRotCenter) then
begin
if assigned(TraceFigure) then
TraceFigure.DrawRotTrace(Dengine,false);
end
else
begin
if assigned(TraceFigure) then
TraceFigure.DrawDetail(Dengine,DetailStyle);
end;
UnClip;
end;
SetDefaultEngine;
end;
Function TPowerCad.GetScreenPosition(pnt:TDoublePoint):TPoint;
var Pixx,pixy,z:Double;
rpnt: TPoint;
begin
PixX := pnt.x;
PixY := pnt.y;
z := 0;
ConvertXY(PixX,PixY,z);
if CustomSurface <> nil then begin
rpnt := Point(Round(PixX),Round(PixY));
Windows.ClientToScreen(CustomWnd, rpnt);
result := rpnt;
end else begin
result := Self.Surface.ClientToScreen(Point(Round(PixX),Round(PixY)));
end;
end;
Procedure TPowerCad.DoFigureModify(Figure:TFigure);
begin
if assigned(OnFigureModify) then OnFigureModify(Self,Figure);
Updated := True;
end;
Function TPowerCad.DoKeyStroke(ChCode:Integer;Shift:Integer):Boolean;
var
ShiftState: TShiftState;
dx,dy: double;
blName:String;
CanMove: Boolean;
CanHandle:Boolean;
Fnished: Boolean;
aKeyBoardState: TKeyboardState;
SetDimLine: Boolean;
// Tolik -- 30/12/2016 --
function CtrlDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Control] and 128) <> 0);
end;
function ShiftDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Shift] and 128) <> 0);
end;
function AltDown : Boolean;
var
State : TKeyboardState;
begin
GetKeyboardState(State);
Result := ((State[vk_Menu] and 128) <> 0);
end;
//
begin
Result := False;
ShiftState := OleShiftToDelphiSet(shift);
if assigned(TraceFigure) then begin
Fnished := False;
DrawTrace;
result := TraceFigure.ShadowKeyStroke(ClickIndex,chCode,ShiftState,Fnished);
DrawTrace;
if Fnished then begin
EndTrace(ShiftState);
exit;
end;
if Result then begin
exit;
end;
end;
CanHandle := True;
if assigned(FOnKeyStroke) then begin
FOnKeyStroke(Self,chCode,ShiftState,CanHandle);
Result := True;
end;
if assigned(FOnKeyStrokeVB) then begin
FOnKeyStrokeVB(Self,chCode,Shift,CanHandle);
Result := True;
end;
if not CanHandle then exit;
if not KeyCommands then
begin
Result := False;
Exit;
end;
Result := True;
dx := 0;
dy := 0;
case chCode of
VK_LEFT..VK_DOWN :
Begin
// Tolik 24/07/2021 --
if ((ssCtrl in ShiftState) and (ssShift in ShiftState)) then
exit;
//
case chCode of
VK_DOWN : dy := -1;
VK_UP : dy := 1;
VK_LEFT : dx := -1;
VK_RIGHT : dx := 1;
end;
if ssCtrl in ShiftState then
begin
dx := 20 * dx;
dy := 20 * dy;
end;
if ssShift in ShiftState then
begin
dx := (1 * dx * MapScale / 1000) * 100 / ZoomScale;
dy := (1 * dy * MapScale / 1000) * 100 / ZoomScale;
end;
if VerticalZero = vzTop then dy := dy*-1;
if HorizontalZero = vzRight then dx := dx*-1;
CanMove := True;
if assigned(FOnMoveByArrows) then begin
FOnMoveByArrows(Self,dx,dy,CanMove);
end;
if CanMove then MoveSelection(dx,dy);
Refresh;
end;
{$ifdef dll}
VK_DELETE: RemoveSelection;
{$else}
VK_DELETE: if Self.Focused then RemoveSelection;
{$endif dll}
VK_ESCAPE:
begin
//Result := False;
//Result := True; // Tolik 06/09/2021 --
//Tolik 12/08/2021 --
if ToolInfo = 'TSCSHDimLine' then
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end
else
SetDimLine := ((ToolInfo = TBetweenFloorUpVertex.ClassName) and (GisUserDimLine = True));
//
if ActiveLayer <> 2 then
CancelActions;
if SetDimLine then
begin
GisUserDimLine := True;
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.00001) > 0 then
begin
FSCS_Main.tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end;
end;
ord('a'),ord('A'): if ssCtrl in ShiftState then
begin
SelectAll(ActiveLayer);
refresh;
end;
ord('c'),ord('C'): begin
if ssCtrl in ShiftState then CopyToClipBoard;
end;
ord('x'),ord('X'): if ssCtrl in ShiftState then CutToClipBoard;
ord('v'),ord('V'): if ssCtrl in ShiftState then PasteFromClipBoard(ActiveLayer);
ord('z'),ord('Z'): if ssCtrl in ShiftState then Undo;
ord('y'),ord('Y'): if ssCtrl in ShiftState then Redo;
// ord('g'),ord('G'): if ((ssCtrl in ShiftState) and (ssShift in ShiftState))
// then UnGroupSelection
// else if (ssCtrl in ShiftState) then GroupSelection;
// ord('f'),ord('F'): if ssCtrl in ShiftState then BringToFront;
// ord('b'),ord('B'): if ssCtrl in ShiftState then SendToBack;
// ord('w'),ord('W'): if ssCtrl in ShiftState then WeldIntoPolyline;
// ord('i'),ord('I'): if ssCtrl in ShiftState then InterBreakSelection;
// ord('m'),ord('M'): if ssCtrl in ShiftState then
// begin
// RegRead('BlockDir',BlockDirectory);
// if InputQuery(csMakeBlock, csBlockName, blname) then
// MakeSelectionBlock(BlockDirectory+blname+'.pwb');
// end;
// ord('n'),ord('N'): if ssCtrl in ShiftState then cNewDrawing;
// ord('o'),ord('O'): if ssCtrl in ShiftState then cOpenDrawing;
// ord('s'),ord('S'): if ssCtrl in ShiftState then cSaveDrawing;
// ord('p'),ord('P'): if ssCtrl in ShiftState then cPrintDrawing;
// ord('d'),ord('D'): if ssCtrl in ShiftState then ExecuteTbCommand(cOffset);
// ord('r'),ord('R'): if ssCtrl in ShiftState then ExecuteTbCommand(cConvertToBezier);
// ord('q'),ord('Q'): if ssCtrl in ShiftState then DetailWindow := not DetailWindow;
// ord('u'),ord('U'): if ssCtrl in ShiftState then SimplfySelectedPolyline;
// ord('l'),ord('L'): if ssCtrl in ShiftState then NameSelection;
// ord('0'): if ssCtrl in ShiftState then GuideTrace := gtNone;
// ord('3'): if ssCtrl in ShiftState then GuideTrace := gtThirty;
// ord('4'): if ssCtrl in ShiftState then GuideTrace := gtFortyFive;
// ord('6'): if ssCtrl in ShiftState then GuideTrace := gtSixty;
// ord('9'): if ssCtrl in ShiftState then GuideTrace := gtNinty;
else
Result := false;
end;
// Tolik -- 13/12/2016 --
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> Ctrl ShiftStateAlt (<28><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>), <20> <20><> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> CTRL+DEL <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20> <20><><EFBFBD><EFBFBD> <20><>
// <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD>, "<22><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> CTRL"
if Result then
begin
if (ssCtrl in ShiftState) or (ssShift in ShiftState) or (ssAlt in ShiftState) then
begin
//Application.ProcessMessages;
{
GetKeyboardState(aKeyBoardState);
if GetAsyncKeyState(VK_SHIFT) < 0 then
aKeyBoardState[VK_SHIFT] := 129
else
aKeyBoardState[VK_SHIFT] := 0;
if GetAsyncKeyState(VK_MENU) < 0 then//AltDown then
aKeyBoardState[VK_MENU] := 129
else
aKeyBoardState[VK_MENU] := 0;
if GetAsyncKeyState(VK_CONTROL) < 0 then//AltDown then
aKeyBoardState[VK_CONTROL] := 129
else
begin
aKeyBoardState[VK_CONTROL] := 0;
aKeyBoardState[VK_LCONTROL] := 0;
aKeyBoardState[VK_RCONTROL] := 0;
end;
}
//SetKeyboardState(aKeyBoardState);
if GetAsyncKeyState(VK_SHIFT) < 0 then
GGlobalShiftState := GGlobalShiftState + [ssShift]
else
GGlobalShiftState := GGlobalShiftState - [ssShift];
if GetAsyncKeyState(VK_MENU) < 0 then//AltDown then
GGlobalShiftState := GGlobalShiftState + [ssAlt]
else
GGlobalShiftState := GGlobalShiftState - [ssAlt];
if GetAsyncKeyState(VK_CONTROL) < 0 then//ControlDown then
GGlobalShiftState := GGlobalShiftState + [ssCtrl]
else
GGlobalShiftState := GGlobalShiftState - [ssCtrl];
end;
end;
end;
Procedure TPowerCad.RaiseOnStatus;
begin
if assigned(FOnStatus) then FOnStatus(Self,info1,info2,info3,'');
end;
Procedure TPowerCad.SetTool(aToolIndex: TPCTool;aToolInfo:String;aToolData:Integer);
begin
inherited;
SnapInfo := aToolInfo;
if assigned(FToolChanged) then FToolChanged(Self);
end;
Procedure TPowerCad.SetTool(aToolIndex: TPCTool;aToolInfo:String);
begin
//Tolik 12/08/2021--
if aToolInfo <> 'TSCSHDimLine' then
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
SetTool(aToolIndex,aToolInfo,0);
end;
Function TPowerCad.ExitApplication:Boolean;
var ResWord: Word;
fSaveDialog:TPCSaveDialog;
begin
if Updated then begin
ResWord := messagedlg
(Format(cmSaveChangesBE,[ExtractFileName(ActiveFile)]),mtConfirmation,mbYesNoCancel,0);
If ResWord = mrYes then
begin
if IsUnNamed then
begin
fSaveDialog := TPCSaveDialog.Create(self);
fSaveDialog.FileName := ActiveFile;
fSaveDialog.Title := fSaveDialogTitle;
fSaveDialog.Filter := fSaveDialogFilter;
if fSaveDialog.Execute then
begin
ActiveFile := fSaveDialog.filename;
if ExtractFileExt(activeFile) = '' then
ActiveFile := ActiveFile+'.'+FExtension;
SaveToFile(0,ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end else begin
Result := False;
fSaveDialog.Free;
Exit;
end;
end
else
SaveToFile(0,ActiveFile);
fSaveDialog.Free;
end;
If ResWord = MrCancel then begin
Result := False;
Exit;
end;
end;
Result := true;
Application.Terminate;
end;
(*
Procedure TPowerCad.SetInterfaceHandle;
begin
//SetControlForPlugins(Self);
//SetControlForScripting(Self);
end;
*)
procedure TPowerCad.SelectPoint(ModPoint: TModPOint);
var Figure: TFigure;
i: Integer;
mp: TModPOint;
begin
Figure := modPoint.Figure;
if assigned(Figure) then begin
for i := 0 to ModPoints.Count-1 do
begin
mp := TModPoint(ModPoints[i]);
if mp.Figure = figure then
Figure.DeselectPoint(mP);
end;
end;
Figure.SelectPoint(ModPoint);
end;
procedure TPowerCad.DoPopUp(x, y: Double);
var popP: TPoint;
a,b,c,d,e:integer;
mnItem,subItem,sepItem: TMenuItem;
snp: Boolean;
mnIndex: integer;
cnt,lncnt,p,i: integer;
mdP: Tpoint;
pixX,pixY: Double;
popItems,pItem,blankS:String;
done:Boolean;
s: TStringArray;
begin
mnIndex := 0;
if FPopStyle = psCancel then exit;
if FPopStyle = psStandart then
begin
for a := PopMenu.Items.Count -1 downto 0 do
begin
TMenuItem(PopMenu.Items[a]).Free;
end;
cnt := Selection.Count;
lncnt := 0;
for a := 0 to cnt -1 do begin
if (TFigure(Selection[a]) is TLine) and
(TFigure(Selection[a]).Selected) then lncnt := lncnt +1;
end;
if FDrawingPop then begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 0;
mnItem.Caption := csZoom;
PopMenu.Items.Add(mnItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 12;
SubItem.Caption := csZoomIn;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 13;
SubItem.Caption := csZoomOut;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 14;
SubItem.Caption := csActualSize;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 15;
SubItem.Caption := csFitToPage;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 16;
SubItem.Caption := csZoom50;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 17;
SubItem.Caption := csZoom200;
mnItem.Add(SubItem);
//mnItem := TMenuItem.Create(self);
//mnItem.Tag := 18;
//mnItem.Caption := csLayersDial;
//PopMenu.Items.Add(mnItem);
if (cnt > 0) and (Figures.Count > 1) then
begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 2;
mnItem.Caption := csOrder;
PopMenu.Items.Add(mnItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 3;
SubItem.Caption := csBtf;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 4;
SubItem.Caption := csStb;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 5;
SubItem.Caption := csBfw;
mnItem.Add(SubItem);
SubItem := TmenuItem.Create(self);
SubItem.Tag := 6;
SubItem.Caption := csSbw;
mnItem.Add(SubItem);
end;
if cnt > 1 then
begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 7;
mnItem.Caption := csGroup;
PopMenu.Items.Add(mnItem);
end;
if cnt > 0 then
begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 8;
mnItem.Caption := csRotate;
PopMenu.Items.Add(mnItem);
end;
if cnt > 0 then
begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 9;
mnItem.Caption := csLock;
PopMenu.Items.Add(mnItem);
end;
if cnt > 0 then
begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 10;
mnItem.Caption := csUnLock;
PopMenu.Items.Add(mnItem);
end;
if lncnt > 0 then
begin
mnItem := TMenuItem.Create(self);
mnItem.Tag := 11;
mnItem.Caption := csWeldIntoPolyLine;
PopMenu.Items.Add(mnItem);
end;
mnItem := TMenuItem.Create(self);
mnItem.Tag := 18;
mnItem.Caption := csCreateDimLines;
PopMenu.Items.Add(mnItem);
mnItem := TMenuItem.Create(self);
mnItem.Tag := 19;
mnItem.Caption := csClearDimLines;
PopMenu.Items.Add(mnItem);
end;
mnIndex := 20;
if Selection.Count = 1 then begin
mnItem := TMenuItem.Create(self);
mnItem.Caption := '-';
PopMenu.Items.Add(mnItem);
sepItem := mnItem;
if (TFigure(Selection[0]).PopStyle = fpsStandart) or
(TFigure(Selection[0]).PopStyle = fpsAppendCustom) then
begin
TFigure(Selection[0]).UpdateMenu(PopMenu,mnIndex);
end;
if (TFigure(Selection[0]).PopStyle = fpsAppendCustom) or
(TFigure(Selection[0]).PopStyle = fpsOnlyCustom) then
begin
PopItems := TFigure(Selection[0]).CustomPops;
SplitStr(PopItems,s,',');
for i:=0 to Length(s)-1 do begin
mnItem := TMenuItem.Create(self);
mnItem.Caption := Trim(s[i]);
mnItem.Tag := 110+i;
PopMenu.Items.Add(mnItem);
end;
end;
if mnIndex = 20 then begin
PopMenu.Items.Remove(sepItem);
end;
end;
end;
FStandartMnIndex := mnIndex;
PopItems := FCustomPop;
if (PopItems <> '') then
begin
// if (mnIndex > 20) then begin
mnItem := TMenuItem.Create(self);
mnItem.Caption := '-';
PopMenu.Items.Add(mnItem);
// end;
done := false;
i :=0 ;
repeat
p := pos(',',PopItems);
if p > 0 then begin
pItem := Copy(popItems,1,p-1);
popItems := Copy(popItems,p+1,length(PopItems)-p);
mnItem := TMenuItem.Create(self);
mnItem.Caption := pItem;
mnItem.Tag := 500+i;
i := i+1;
PopMenu.Items.Add(mnItem);
end else begin
if PopItems <> '' then begin
mnItem := TMenuItem.Create(self);
mnItem.Caption := PopItems;
mnItem.Tag := 500+i;
PopMenu.Items.Add(mnItem);
end;
done := true;
end;
until done;
end;
for a := 0 to PopMenu.Items.Count -1 do
begin
mnItem := TMenuItem(PopMenu.Items[a]);
mnItem.OnClick := MenuClicked;
for b := 0 to mnItem.Count -1 do
begin
subItem := (mnItem.Items[b]);
subItem.OnClick := MenuClicked;
for c := 0 to subItem.Count-1 do
begin
(subItem.Items[c]).OnClick := MenuClicked;
for d := 0 to (subItem.Items[c]).Count-1 do
begin
(subItem.Items[c]).Items[d].OnClick := MenuClicked;
end;
end;
end;
end;
if DetailHit then
PopP := Surface.ClientToScreen(DetailHitPoint)
else
PopP := GetScreenPosition(DoublePoint(x,y));
PopMenu.Popup(popP.x,popP.y);
end;
procedure TPowerCad.SetAcceptFiles(Value: TFileDropStyle);
begin
FAcceptFiles := Value;
//if not (csDesigning in ComponentState) then
// DragAcceptFiles(self.Handle,(Value <> dfsNone));
end;
procedure TPowerCad.WMDropFiles(var Msg: TWMDropFiles);
var
rc: UINT;
i, iBuffSize: integer;
lpszFile: PChar;
FileList: TStringList;
DropPoint: TPoint;
begin
FileList := TStringList.Create;
try
// Get count dropped files
rc := DragQueryFile(Msg.Drop,$FFFFFFFF,nil,0);
for i := 0 to rc-1 do
begin
// Get buffer size
iBuffSize := DragQueryFile(Msg.Drop,i,nil,0) + 1;
GetMem(lpszFile,iBuffSize);
try
// Get file name
DragQueryFile(Msg.Drop,i,lpszFile,iBuffSize);
FileList.Append(string(lpszFile));
finally
FreeMem(lpszFile);
end;
end;
// Get drop point
DragQueryPoint(Msg.Drop,DropPoint);
DoDropFiles(FileList,DropPoint);
finally
DragFinish(Msg.Drop);
FileList.Free;
end;
Msg.Result := 0;
end;
procedure TPowerCad.DoDropFiles(FileList: TStringList; DropPoint: TPoint);
var dPoint: TDoublePOint;
fName:String;
begin
if fileList.Count = 0 then exit;
dPoint := DoublePoint(DropPoint);
dPoint.z := 0;
Dengine.DeConvertCoord(dPoint.x,dPoint.y,dPoint.z);
if (FAcceptFiles = dfsManual) and (Assigned(FOnDropFiles)) then begin
FOnDropFiles(Self,FileList.Text,dPoint.x,dPoint.y);
end else begin
fName := FileList[0];
if lowercase(ExtractFileExt(fName)) = '.'+FExtension then begin
cOpenDrawingfile(fName);
end else if lowercase(ExtractFileExt(fName)) = '.pwb' then begin
InsertBlockWithFileName(ActiveLayer,fName,dPoint.x,dPoint.y);
end;
end;
end;
procedure TPowerCad.cOpenDrawingFile(fName: String);
var ResWord: Word;
fSaveDialog : TPCSaveDialog;
begin
if Updated then begin
ResWord := messagedlg
(Format(cmSaveChanges,[ExtractFileName(ActiveFile)]),mtConfirmation,mbYesNoCancel,0);
If ResWord = mrYes then
begin
if IsUnNamed then
begin
fSaveDialog := TPCSaveDialog.Create(self);
fSaveDialog.FileName := ActiveFile;
fSaveDialog.Title := fSaveDialogTitle;
fSaveDialog.Filter := fSaveDialogFilter;
if fSaveDialog.Execute then
begin
ActiveFile := fSaveDialog.filename;
if ExtractFileExt(activeFile) = '' then
ActiveFile := ActiveFile+'.'+FExtension;
SaveToFile(0,ActiveFile);
if assigned(FFileChange) then FFileChange(self);
end
else
begin
fSaveDialog.Free;
exit;
end;
fSaveDialog.free;
end
else
SaveToFile(0,ActiveFile);
end;
If ResWord = MrCancel then Exit;
end;
ActiveFile := FName;
LoadFromFile(ActiveFile);
if assigned(FFileChange) then FFileChange(self);
Updated := False;
end;
procedure TPowerCad.EndTrace(Shift:TShiftState);
var NewFigure: TFigure;
insertState: TInsertState;
SavedFlag: Boolean; //Tolik 12/08/2021 --
begin
SavedFlag := GisUserDimLine;
// Tolik 03/02/2017 --
// <20><><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD>, <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>
//if GCadForm.FCanSaveForUndo then
// GCadForm.SaveForUndo(uat_None, True, False);
//
if GTraceStatus then
exit;
DrawTrace;
NewFigure := nil;
if Assigned(FBeforeEndTrace) then
FBeforeEndTrace(Self);
if assigned(FigClass) then
NewFigure := FigClass.CreateFromShadow(Self,LongInt(Layers[ActiveLayer]),TraceFigure);
KillTraceFigure;
if newFigure <> nil then
begin
insertState := isInsert;
if assigned(FBeforeFigureInsert) then
begin
FBeforeFigureInsert(Self,newFigure,InsertState);
if inSertState = isDelete then
begin
NewFigure.Free;
NewFigure := nil;
end;
end;
if inSertState = isInsert then
begin
Figures.Add(NewFigure);
RecordInsertUndo(NewFigure);
if not (((ssShift in shift) or (ssCtrl in Shift)) and FMultiSelect) then
deselectall(0);
if AutoSelect then
begin
NewFigure.Select;
FAnySelected := true;
end;
if assigned(OnObjectInserted) then
OnObjectInserted(self,irCreate);
Updated := True;
end;
end;
ClickIndex := 0;
TraceState:= tsNone;
if FtoolIdx = toOperation then
begin
Settool(toSelect,'');
end;
// Tolik 12/08/2021 --
if ((SavedFlag = true) and (FigClass = TBetweenFloorUpVertex)) then
begin
GisUserDimLine := True;
GetUserScaleVal;
if CompareValue(GuserScaleVal, 0, 0.0001) > 0 then
begin
FSCS_Main.tbSCSHDimLineExpert.click;
ShowHintRzR(cCadClasses_Mes36_, 5000);
end
else
begin
GisUserDimLine := False;
GuserScaleVal := 0;
end;
end;
Refresh;
end;
procedure TPowerCad.cTestPrinter;
begin
if fPrintDialog.execute then
begin
TestPrinter;
end;
end;
procedure TPowerCad.cPrintDrawingAsWmf;
begin
if fPrintDialog.execute then
begin
PrintDrawingAsWmf(ActiveFile);
end;
end;
procedure TPowerCad._DrawTrace;
begin
DrawTrace
end;
initialization
{$ifdef demo}
if not delphiloaded then application.terminate;
{$endif demo}
//if not assigned(LayersDlg) then LayersDlg := TPCLayerDlg.Create(nil);
//if not assigned(MacroDlg) then MacroDlg := TPCMacroDialog.Create(nil);
//if not assigned(BlockDlg) then BlockDlg := TPCBlockDlg.Create(nil);
dIdx := 0;
end.
Reference in New Issue View Git Blame Copy Permalink