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 -- для внешнего вызова 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 цlь 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 - - этот кусок добавлен, потому что не было Шадоу трассы если начинать перемещать ранее не выделенный коннектор // для этого ставим 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 - защита от передергивания 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 - Если от начала выделения объекта прошло время, то позволяем Drag. //24.04.2012 Сделано чтобы небыло передергиваний на выделении объекта //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))+'°'; 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))+'°'; 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 //Были томоза при перемещении уже выделенного коннетора из-за постоянных рефрешей // потому сделаем так 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 -- если здесь 150 - сильно мышка дергается на объекте //if FDragOverTime < 150 then //21.06.2013 - защита от передергивания if FDragOverTime < 50 then //21.06.2013 - защита от передергивания // begin //21.06.2013 - взято из 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))+'°'; 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))+'°'; 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 -- запретить срабатывание таймера на 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 -- разрешить срабатывание таймера на 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 -- выставлен на закрытии/удалении формы //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 -- // пока не нужно, вроде как от GDI избавились, но на всяк случай пусть сидит здесь // если Win 10 то // проверить превышение или угрозу превышения количества 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 - -это пока сюда низзя, хотя очень хотелось, но поломается выборка объектов в дереве ПМ // куда засунуть - пока неизвестно, но хотелось адекватно отобразить кад в дереве, если выбираем мышкой регион (*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 -- для внешнего вызова 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 -- // подавить нажатие Ctrl ShiftStateAlt (на всякий), а то при нажатии CTRL+DEL вылазит форма типа спросить, а надо ли // удалять, после чего вследствие потери фокусе на КАДе, "зависает 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 -- // ОНО ТУТ ТАКИ НЕ НУЖНО, зачем Толян сюда его влепил не понятно //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.